diff options
author | Ben Sima <ben@bsima.me> | 2021-02-05 21:56:20 -0500 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2021-02-05 21:56:20 -0500 |
commit | 753cdfe8c18b470da4a4807815d0aaade53f1d16 (patch) | |
tree | 1194557e0e0ab2e825c2786bf4bcccc33e86da27 /Biz | |
parent | 1c75a8ee4c9914c7d482b38195b813b12ef4f834 (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.
Diffstat (limited to 'Biz')
-rw-r--r-- | Biz/Bild.hs | 2 | ||||
-rw-r--r-- | Biz/Cli.hs | 7 | ||||
-rw-r--r-- | Biz/Devalloc.hs | 5 | ||||
-rw-r--r-- | Biz/Lint.hs | 2 | ||||
-rw-r--r-- | Biz/Pie.hs | 2 | ||||
-rw-r--r-- | Biz/Que/Host.hs | 2 | ||||
-rw-r--r-- | Biz/Que/Site.hs | 2 |
7 files changed, 13 insertions, 9 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 @@ -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 @@ -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 |