From 7bb2775667386659402ebb7559c7bc4af46ec268 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 15 Jan 2021 19:12:19 -0500
Subject: Implement Biz.Cli

Wraps docopt rather nicely. It's much nicer than optparse-applicative and runs
tests with the --test argument automatically. Next I just need to implement a
test framework.
---
 Biz/Lint.hs | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

(limited to 'Biz/Lint.hs')

diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index acf59c8..bad0806 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -9,12 +9,12 @@
 module Biz.Lint (main) where
 
 import Alpha
+import qualified Biz.Cli as Cli
 import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import qualified Control.Concurrent.Async as Async
 import qualified Data.String as String
 import qualified Data.Text as Text
-import qualified System.Console.Docopt as Docopt
 import qualified System.Directory as Directory
 import qualified System.Environment as Environment
 import qualified System.Exit as Exit
@@ -22,21 +22,25 @@ import System.FilePath ((</>))
 import qualified System.Process as Process
 
 main :: IO ()
-main =
-  Environment.getArgs
-    >>= Docopt.parseArgsOrExit help
-    >>= (\args -> return <| Docopt.getAllArgs args (Docopt.argument "file"))
+main = Cli.main <| Cli.Plan help move test
+
+move :: Cli.Arguments -> IO ()
+move args =
+  (return <| Cli.getAllArgs args (Cli.argument "file"))
     >>= \case
       [] -> changedFiles >>= run >>= mapM printResult >>= exit
       files -> run (filter notcab files) >>= mapM printResult >>= exit
 
+test :: Cli.Arguments -> IO ()
+test _ = Exit.exitSuccess
+
 notcab :: FilePath -> Bool
 notcab ('_' : _) = False
 notcab _ = True
 
-help :: Docopt.Docopt
+help :: Cli.Docopt
 help =
-  [Docopt.docopt|
+  [Cli.docopt|
 lint
 
 Usage:
@@ -53,7 +57,7 @@ exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitS
 
 printResult :: Result -> IO Result
 -- printResult r@(Error err) = (putText <| "lint: error: " <> err) >> pure r
-printResult r@(Error err) = pure r
+printResult r@(Error _) = pure r
 printResult r@(Ok path_ linter_ (Bad err)) =
   (putText <| "lint: badd: " <> Text.pack linter_ <> ": " <> Text.pack path_)
     >> if err == "" then pure r else putText (Text.pack err) >> pure r
-- 
cgit v1.2.3