aboutsummaryrefslogtreecommitdiffstats
path: root/cli/app/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'cli/app/Main.hs')
-rw-r--r--cli/app/Main.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/cli/app/Main.hs b/cli/app/Main.hs
new file mode 100644
index 0000000..6006e7c
--- /dev/null
+++ b/cli/app/Main.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE NoFieldSelectors #-}
+
+module Main where
+
+import API.Collection qualified
+import Control.Applicative ((<**>))
+import Data.Aeson qualified as J
+import Data.ByteString.Lazy qualified as LB
+import Data.Text qualified as T
+import Options.Applicative qualified as O
+import Text.ParserCombinators.ReadP qualified as R
+import Text.ParserCombinators.ReadPrec qualified as R
+import Text.Read (Read (..))
+
+data Args = Args
+ { cmd :: Cmd
+ }
+
+args :: O.Parser Args
+args = Args <$> cmd_
+
+data Cmd = Collection CollectionCmd
+
+cmd_ :: O.Parser Cmd
+cmd_ =
+ O.hsubparser . mconcat $
+ [ O.command "collection" . O.info collectionCmd $
+ O.progDesc "Manage content collections"
+ ]
+
+data CollectionCmd = CollectionInsert
+ { filePath :: CollectionPath
+ }
+
+data CollectionPath = CollectionPath
+ { collectionName :: T.Text,
+ fileName :: T.Text
+ }
+
+instance Read CollectionPath where
+ readPrec = R.lift do
+ (T.pack -> collectionName) <- R.munch (/= '/')
+ _ <- R.string "/"
+ (T.pack -> fileName) <- do
+ fileName <- R.munch (liftA2 (&&) (/= '.') (/= '/'))
+ fileExt <- R.string ".json"
+ pure (fileName <> fileExt)
+ pure CollectionPath {..}
+
+instance Show CollectionPath where
+ show (CollectionPath {collectionName, fileName}) =
+ show (collectionName <> "/" <> fileName)
+
+collectionCmd :: O.Parser Cmd
+collectionCmd =
+ fmap Collection . O.hsubparser . mconcat $
+ [ O.command "insert" . O.info collectionInsertCmd $
+ O.progDesc "Insert an entity"
+ ]
+
+collectionInsertCmd :: O.Parser CollectionCmd
+collectionInsertCmd =
+ CollectionInsert
+ <$> collectionPathArg
+
+collectionPathArg :: O.Parser CollectionPath
+collectionPathArg =
+ O.argument O.auto (O.metavar "COLLECTION_PATH")
+
+main :: IO ()
+main = do
+ O.execParser (O.info (args <**> O.helper) O.idm) >>= \case
+ Args
+ { cmd =
+ Collection
+ CollectionInsert
+ { filePath = CollectionPath {collectionName, fileName}
+ }
+ } ->
+ print
+ =<< API.Collection.insert collectionName fileName
+ =<< J.throwDecode
+ =<< LB.getContents