summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2021-02-05 21:56:20 -0500
committerBen Sima <ben@bsima.me>2021-02-05 21:56:20 -0500
commit753cdfe8c18b470da4a4807815d0aaade53f1d16 (patch)
tree1194557e0e0ab2e825c2786bf4bcccc33e86da27
parent1c75a8ee4c9914c7d482b38195b813b12ef4f834 (diff)
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.
-rw-r--r--Biz/Bild.hs2
-rw-r--r--Biz/Cli.hs7
-rw-r--r--Biz/Devalloc.hs5
-rw-r--r--Biz/Lint.hs2
-rw-r--r--Biz/Pie.hs2
-rw-r--r--Biz/Que/Host.hs2
-rw-r--r--Biz/Que/Site.hs2
-rw-r--r--Hero/Host.hs2
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 =