Add bild --test

This argument will run the tests for an output after building. It's active in
'ci' so running that will ensure tests are passing. This way testing a
namespace and building a namespace are as close together as possible, so
presumably it will be that much easier to write good tests.

1 files changed, 27 insertions, 6 deletions

diff --git a/Biz/Que/Site.hs b/Biz/Que/Site.hs
index 99486a4..c4a6e0d 100644
--- a/Biz/Que/Site.hs
+++ b/Biz/Que/Site.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -8,16 +9,22 @@
 -- : out que-website
 --
 -- : dep async
+-- : dep docopt
 -- : dep config-ini
 -- : dep process
 -- : dep protolude
 -- : dep req
+-- : dep tasty
+-- : dep tasty-hunit
 module Biz.Que.Site
   ( main,
   )
 where
 
 import Alpha
+import qualified Biz.Cli as Cli
+import Biz.Test ((@=?))
+import qualified Biz.Test as Test
 import qualified Control.Concurrent.Async as Async
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Ini.Config as Config
@@ -32,12 +39,11 @@ import System.FilePath ((</>))
 import qualified System.Process as Process
 
 main :: IO ()
-main = do
-  (src, ns) <-
-    Environment.getArgs >>= \case
-      [src] -> return (src, "_") -- default to _ ns which is special
-      [src, ns] -> return (src, Text.pack ns)
-      _ -> Exit.die "usage: que-website <srcdir> [namespace]"
+main = Cli.main <| Cli.Plan help move test
+
+move :: Cli.Arguments -> IO ()
+move args = do
+  let (Just src, Just ns) = (getArg "src", Text.pack </ getArg "ns")
   mKey <- getKey ns
   putText <| "serving " <> Text.pack src <> " at " <> ns
   run mKey ns
@@ -49,6 +55,21 @@ main = do
         apidocs = src </> "Apidocs.md",
         tutorial = src </> "Tutorial.md"
       }
+  where
+    getArg = Cli.getArg args <. Cli.argument
+
+help :: Cli.Docopt
+help =
+  [Cli.docopt|
+que-website
+
+Usage:
+  que-website <src> <ns>
+  que-website test
+|]
+
+test :: Test.Tree
+test = Test.group "Biz.Que.Site" [Test.unit "id" <| 1 @=? (1 :: Integer)]
 
 getKey :: Namespace -> IO (Maybe Key)
 getKey ns = do