From 753cdfe8c18b470da4a4807815d0aaade53f1d16 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 5 Feb 2021 21:56:20 -0500
Subject: Add 'tidy' to Plan

This is supposed to be how to cleanup the database and any other local files.
Should only be used before/after test, so maybe I can find a way to enforce this
constraint somehow in the code.
---
 Biz/Bild.hs     | 2 +-
 Biz/Cli.hs      | 7 ++++---
 Biz/Devalloc.hs | 5 ++++-
 Biz/Lint.hs     | 2 +-
 Biz/Pie.hs      | 2 +-
 Biz/Que/Host.hs | 2 +-
 Biz/Que/Site.hs | 2 +-
 Hero/Host.hs    | 2 +-
 8 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index b621797..9da11ac 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -144,7 +144,7 @@ import qualified Text.Regex.Applicative as Regex
 import qualified Prelude
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test pure
   where
     test =
       Test.group
diff --git a/Biz/Cli.hs b/Biz/Cli.hs
index 8398399..c144a72 100644
--- a/Biz/Cli.hs
+++ b/Biz/Cli.hs
@@ -24,13 +24,14 @@ import qualified System.Environment as Environment
 import qualified Test.Tasty as Tasty
 import qualified Test.Tasty.Runners as Tasty
 
-data Plan = Plan
+data Plan cfg = Plan
   { help :: Docopt.Docopt,
     move :: Docopt.Arguments -> IO (),
-    test :: Tasty.TestTree
+    test :: Tasty.TestTree,
+    tidy :: cfg -> IO ()
   }
 
-main :: Plan -> IO ()
+main :: Plan cfg -> IO ()
 main Plan {..} =
   Environment.getArgs
     +> Docopt.parseArgsOrExit help
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index bdb958f..9bc8bd0 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -397,7 +397,7 @@ init =
 -- * main and test
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test tidy
 
 help :: Cli.Docopt
 help =
@@ -435,6 +435,9 @@ startup = do
 shutdown :: (Config, Application, Acid.AcidState Keep) -> IO ()
 shutdown (_, _, kp) = Acid.closeAcidState kp
 
+tidy :: Config -> IO ()
+tidy Config {..} = Directory.removeDirectoryRecursive keep
+
 run :: (Config, Wai.Application, Acid.AcidState Keep) -> IO ()
 run (cfg, app, _) = Warp.run (port cfg) (logStdout app)
 
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index bd71835..2fc8522 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -24,7 +24,7 @@ import System.FilePath ((</>))
 import qualified System.Process as Process
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test pure
 
 move :: Cli.Arguments -> IO ()
 move args = case Cli.getAllArgs args (Cli.argument "file") of
diff --git a/Biz/Pie.hs b/Biz/Pie.hs
index 446e756..9c78258 100644
--- a/Biz/Pie.hs
+++ b/Biz/Pie.hs
@@ -63,7 +63,7 @@ import qualified Text.Parsec as Parsec
 import qualified Text.Parsec.String as Parsec
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test pure
 
 test :: Test.Tree
 test = Test.group "Biz.Pie" [Test.unit "id" <| 1 @=? (1 :: Integer)]
diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs
index e40b2e0..57507ae 100644
--- a/Biz/Que/Host.hs
+++ b/Biz/Que/Host.hs
@@ -57,7 +57,7 @@ import qualified Prelude
 {-# ANN module ("HLint: ignore Reduce duplication" :: Prelude.String) #-}
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test pure
 
 move :: Cli.Arguments -> IO ()
 move _ = Exception.bracket startup shutdown <| uncurry Warp.run
diff --git a/Biz/Que/Site.hs b/Biz/Que/Site.hs
index 0d89400..77498b4 100644
--- a/Biz/Que/Site.hs
+++ b/Biz/Que/Site.hs
@@ -40,7 +40,7 @@ import System.FilePath ((</>))
 import qualified System.Process as Process
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test pure
 
 move :: Cli.Arguments -> IO ()
 move args = do
diff --git a/Hero/Host.hs b/Hero/Host.hs
index 5496f27..af0e134 100644
--- a/Hero/Host.hs
+++ b/Hero/Host.hs
@@ -85,7 +85,7 @@ import qualified System.Exit as Exit
 import qualified System.IO as IO
 
 main :: IO ()
-main = Cli.main <| Cli.Plan help move test
+main = Cli.main <| Cli.Plan help move test pure
 
 help :: Cli.Docopt
 help =
-- 
cgit v1.2.3