Use simplified callCliApp function of new version of Oclis

makefile

@@ -70,12 +70,37 @@ lint-js: | node_modules
 		--ignore-path .gitignore \
 		scripts
 
+
 .PHONY: test-spago
 test-spago: | node_modules
 	npx spago test
 
+
+.PHONY: test-cli
+test-cli: | node_modules
+	npx spago run -- \
+		balance examples/journal.yaml \
+		> /dev/null
+
+	npx spago run -- \
+		balance examples/journal.yaml examples/journal-only-transactions.yaml \
+		> /dev/null
+
+	npx spago run -- \
+		unused-files examples/receipts examples/journal.yaml \
+		2> /dev/null
+
+	npx spago run -- \
+		unused-files \
+			examples/receipts \
+			examples/journal.yaml \
+			examples/journal-only-transactions.yaml \
+		2> /dev/null
+
+
 .PHONY: test
-test: lint-js test-spago
+test: test-spago test-cli lint-js
+
 
 .PHONY: test-watch
 test-watch: | node_modules

src/Main.purs

@@ -18,9 +18,6 @@ import Prelude
 
 import Ansi.Codes (Color(..))
 import Ansi.Output (withGraphics, foreground)
-import Oclis (parseCliSpec, callCliApp)
-import Oclis.SpecEmbed as Oclis.SpecEmbed
-import Oclis.Types (CliArgPrim(..), CliArgument(..))
 import Data.Array (concat, cons, difference, filter, fold, null, zip)
 import Data.Eq ((==))
 import Data.Foldable (foldMap)
@@ -40,6 +37,9 @@ import Node.FS.Stats (isFile, isDirectory)
 import Node.FS.Sync as Sync
 import Node.Path as Path
 import Node.Process (cwd, setExitCode)
+
+import Oclis (ExecutorContext, callCliApp)
+import Oclis.Types (CliArgPrim(..), CliArgument(..))
 import Transity.Data.Config (ColorFlag(..), config)
 import Transity.Data.Ledger
   ( BalanceFilter(..)
@@ -217,51 +217,86 @@ buildRunExit currentDir journalPathRel extraJournalPaths callback = do
       Ok val -> pure $ Ok val
       Error msg -> errorAndExit config msg
 
-executor :: String -> String -> Array CliArgument -> Effect (Result String Unit)
-executor cmdName usageString args = do
-  case cmdName, args of
-    "unused-files",
+getAllFiles :: String -> Effect (Array String)
+getAllFiles directoryPath =
+  let
+    addFiles :: String -> Effect (Array String)
+    addFiles dirPath = do
+      entriesRel <- Sync.readdir dirPath
+      let
+        cleanEntriesRel = filter (_ /= ".DS_Store") entriesRel
+        entriesAbs = cleanEntriesRel <#> (\entry -> dirPath <> "/" <> entry)
+      statEntries <- sequence $ entriesAbs <#> Sync.stat
+
+      let
+        pathStatsTuples = zip entriesAbs statEntries
+        fileTuples = filter (\tuple -> isFile $ snd tuple) pathStatsTuples
+        dirTuples = filter (\tuple -> isDirectory $ snd tuple) pathStatsTuples
+        files = fileTuples <#> fst
+
+      if null dirTuples then
+        pure $ files
+      else do
+        filesNested <- sequence $ dirTuples
+          <#> (\(Tuple dir _) -> addFiles dir)
+        pure (concat $ cons files filesNested)
+  in
+    addFiles directoryPath
+
+checkUnusedFiles
+  :: String -> String -> Array CliArgPrim -> Effect (Result String Unit)
+checkUnusedFiles filesDirPath jourPathRel extraJournalPaths = do
+  currentDir <- cwd
+  buildRunExit currentDir jourPathRel extraJournalPaths $
+    \ledger@(Ledger { transactions }) -> do
+      let
+        journalDir =
+          if indexOf (Pattern "/dev/fd/") jourPathRel == Just 0 then
+            currentDir
+          else Path.dirname jourPathRel
+
+      _ <- checkFilePaths journalDir ledger
+
+      filesDir <- Path.resolve [] filesDirPath
+      foundFiles <- getAllFiles filesDir
+      let
+        ledgerFilesRel = foldMap
+          (\(Transaction tact) -> tact.files)
+          transactions
+      ledgerFilesAbs <- sequence $ ledgerFilesRel
+        <#> (\fileRel -> Path.resolve [ journalDir ] fileRel)
+
+      let
+        unusedFiles = difference foundFiles ledgerFilesAbs
+        makeGreen = withGraphics (foreground Green)
+        makeYellow = withGraphics (foreground Yellow)
+
+      if null unusedFiles then
+        log $ makeGreen $ "No unused files found in " <> filesDir
+      else do
+        warn $ makeYellow $ "Warning: "
+          <> "Following files are not referenced in the journal"
+
+        for_ unusedFiles $ \filePathAbs ->
+          warn $ makeYellow $ "- " <> filePathAbs
+
+      pure $ Ok unit
+
+executor :: ExecutorContext -> Effect (Result String Unit)
+executor context = do
+  case context.command, context.arguments of
+    Just "unused-files",
     [ ValArg (TextArg filesDirPath)
     , ValArg (TextArg jourPathRel)
     , ValArgList extraJournalPaths
-    ] -> do
-      currentDir <- cwd
-      buildRunExit currentDir jourPathRel extraJournalPaths $
-        \ledger@(Ledger { transactions }) -> do
-          let
-            journalDir =
-              if indexOf (Pattern "/dev/fd/") jourPathRel == Just 0 then
-                currentDir
-              else Path.dirname jourPathRel
-
-          _ <- checkFilePaths journalDir ledger
-
-          filesDir <- Path.resolve [] filesDirPath
-          foundFiles <- getAllFiles filesDir
-          let
-            ledgerFilesRel = foldMap
-              (\(Transaction tact) -> tact.files)
-              transactions
-          ledgerFilesAbs <- sequence $ ledgerFilesRel
-            <#> (\fileRel -> Path.resolve [ journalDir ] fileRel)
-
-          let
-            unusedFiles = difference foundFiles ledgerFilesAbs
-            makeGreen = withGraphics (foreground Green)
-            makeYellow = withGraphics (foreground Yellow)
-
-          if null unusedFiles then
-            log $ makeGreen $ "No unused files found in " <> filesDir
-          else do
-            warn $ makeYellow $ "Warning: "
-              <> "Following files are not referenced in the journal"
-
-            for_ unusedFiles $ \filePathAbs ->
-              log $ makeYellow $ "- " <> filePathAbs
-
-          pure $ Ok unit
+    ] -> checkUnusedFiles filesDirPath jourPathRel extraJournalPaths
 
-    _,
+    Just "unused-files",
+    [ ValArg (TextArg filesDirPath)
+    , ValArg (TextArg jourPathRel)
+    ] -> checkUnusedFiles filesDirPath jourPathRel []
+
+    Just cmdName,
     [ ValArg (TextArg journalPathRel) ] -> do
       currentDir <- cwd
       result <- loadAndExec currentDir [ cmdName, journalPathRel ]
@@ -276,7 +311,7 @@ executor cmdName usageString args = do
         Error message ->
           errorAndExit config message
 
-    _,
+    Just cmdName,
     [ ValArg (TextArg jourPathRel)
     , ValArgList extraJournalPaths
     ] -> do
@@ -298,40 +333,10 @@ executor cmdName usageString args = do
 
     _,
     _ -> do
-      log usageString
+      log context.usageString
       setExitCode 1
       pure $ Ok unit
 
-getAllFiles :: String -> Effect (Array String)
-getAllFiles directoryPath =
-  let
-    addFiles :: String -> Effect (Array String)
-    addFiles dirPath = do
-      entriesRel <- Sync.readdir dirPath
-      let
-        cleanEntriesRel = filter (_ /= ".DS_Store") entriesRel
-        entriesAbs = cleanEntriesRel <#> (\entry -> dirPath <> "/" <> entry)
-      statEntries <- sequence $ entriesAbs <#> Sync.stat
-
-      let
-        pathStatsTuples = zip entriesAbs statEntries
-        fileTuples = filter (\tuple -> isFile $ snd tuple) pathStatsTuples
-        dirTuples = filter (\tuple -> isDirectory $ snd tuple) pathStatsTuples
-        files = fileTuples <#> fst
-
-      if null dirTuples then
-        pure $ files
-      else do
-        filesNested <- sequence $ dirTuples
-          <#> (\(Tuple dir _) -> addFiles dir)
-        pure (concat $ cons files filesNested)
-  in
-    addFiles directoryPath
-
 main :: Effect Unit
 main = do
-  _ <- case parseCliSpec Oclis.SpecEmbed.fileContent of
-    Error msg -> errorAndExit config msg
-    Ok cliSpec -> callCliApp cliSpec executor
-
-  pure unit
+  callCliApp executor

src/Oclis/Executor.purs

@@ -4,14 +4,10 @@
 
 module Oclis where
 
-import Oclis.Types
-
 import Prelude (Unit, bind, discard, pure, unit, (#), ($), (-), (<>), (>), (||))
 
 import Ansi.Codes (Color(..))
 import Ansi.Output (withGraphics, foreground)
-import Oclis.Parser (tokensToCliArguments)
-import Oclis.Tokenizer (tokenizeCliArguments)
 import Data.Argonaut.Decode (decodeJson)
 import Data.Argonaut.Decode.Error (printJsonDecodeError)
 import Data.Argonaut.Parser (jsonParser)
@@ -25,6 +21,11 @@ import Effect (Effect)
 import Effect.Class.Console (log, error)
 import Node.Process (argv, setExitCode)
 
+import Oclis.Parser (tokensToCliArguments)
+import Oclis.SpecEmbed (fileContent)
+import Oclis.Tokenizer (tokenizeCliArguments)
+import Oclis.Types
+
 -- TODO: Automatically disable colors if not supported
 makeRed :: String -> String
 makeRed str =
@@ -52,11 +53,17 @@ parseCliSpec cliSpecJsonStr = do
         # (lmap printJsonDecodeError)
         # fromEither
 
+type ExecutorContext =
+  { usageString :: String
+  , command :: Maybe String
+  , arguments :: Array CliArgument
+  }
+
 callCommand
   :: Oclis
   -> String
   -> Array CliArgument
-  -> (String -> String -> Array CliArgument -> Effect (Result String Unit))
+  -> (ExecutorContext -> Effect (Result String Unit))
   -> Effect (Result String Unit)
 callCommand (Oclis cliSpec) usageString args executor = do
   case args # head of
@@ -116,17 +123,17 @@ callCommand (Oclis cliSpec) usageString args executor = do
               pure (Error errStr)
 
             Just (Oclis _command) -> do
-              executor cmdName usageString providedArgs
-
-        Just arg -> do
-          let
-            errMsg =
-              "ERROR: First argument must be a command and not \""
-                <> cliArgToString arg
-                <> "\"\n\n"
-          log $ makeRed $ errMsg <> usageString
-          setExitCode 1
-          pure $ Error errMsg
+              executor
+                { command: Just cmdName
+                , usageString
+                , arguments: providedArgs
+                }
+
+        Just _ -> executor
+          { command: Nothing
+          , usageString
+          , arguments: args # drop 1
+          }
 
         Nothing -> do
           log usageString
@@ -138,11 +145,34 @@ repeatString :: String -> Int -> String
 repeatString str n =
   fold $ replicate n str
 
-callCliApp
+-- | Convenience function to call the CLI app with the default spec and args.
+-- | Use `callCliAppWith`` if you want to provide your own values.
+callCliApp :: (ExecutorContext -> Effect (Result String Unit)) -> Effect Unit
+callCliApp executor =
+  case parseCliSpec fileContent of
+    Error errMsg -> do
+      error $
+        "ERROR:\n"
+          <> "The auto-generated CLI specification in SpecEmbed.purs "
+          <> "could not be parsed.\n"
+          <> "This should not be possible!\n"
+          <> "Please make sure you didn't accidentally modify any Oclis files\n"
+          <> "and report following error at "
+          <> "https://github.com/Airsequel/Oclis/issues/new:\n"
+          <> "\n"
+          <> errMsg
+      setExitCode 1
+    Ok cliSpec -> do
+      arguments <- argv
+      _ <- callCliAppWith cliSpec executor arguments
+      pure unit
+
+callCliAppWith
   :: Oclis
-  -> (String -> String -> Array CliArgument -> Effect (Result String Unit))
+  -> (ExecutorContext -> Effect (Result String Unit))
+  -> Array String
   -> Effect (Result String Unit)
-callCliApp cliSpec@(Oclis cliSpecRaw) executor = do
+callCliAppWith cliSpec@(Oclis cliSpecRaw) executor arguments = do
   let
     lengthLongestCmd :: Int
     lengthLongestCmd =
@@ -178,8 +208,6 @@ callCliApp cliSpec@(Oclis cliSpecRaw) executor = do
                   )
           )
 
-  arguments <- argv
-
   let
     argsNoInterpreter = arguments # drop 1 -- Drop "node"
     cliArgsMb =

src/Oclis/Types.purs

@@ -50,6 +50,7 @@ data CliArgument
   | ValArgList (Array CliArgPrim)
 
 -- TODO: Add support for the following list types
+--       (All entries must be of the same type)
 -- | ValArgList (Array String)
 -- | ValArgListInt (Array Int)
 -- | ValArgListNumber (Array Number)