diff options
Diffstat (limited to 'cli/app/Main.hs')
-rw-r--r-- | cli/app/Main.hs | 88 |
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 |