{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE NoFieldSelectors #-} module Main where import ACMS.API.REST.Collection qualified import Control.Applicative ((<**>)) import Data.Aeson qualified as J import Data.Aeson.Encode.Pretty 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 = CollectionCmd CollectionCmd cmd_ :: O.Parser Cmd cmd_ = O.hsubparser . mconcat $ [ O.command "collection" . O.info collectionCmd $ O.progDesc "Manage content collections" ] data CollectionCmd = CollectionAdd Collection | CollectionView CollectionItem | CollectionEdit CollectionItem | CollectionDelete CollectionItem | -- CollectionSchema Collection newtype Collection = Collection T.Text deriving (Read) data CollectionItem = CollectionItem { collectionName :: Collection, fileName :: T.Text } instance Read CollectionItem where readPrec = R.lift do (Collection . T.pack -> collectionName) <- R.munch (/= '/') _ <- R.string "/" (T.pack -> fileName) <- do fileName <- R.munch (liftA2 (&&) (/= '.') (/= '/')) fileExt <- R.string ".json" pure (fileName <> fileExt) pure CollectionItem {..} instance Show CollectionItem where show (CollectionItem {collectionName = Collection cn, fileName}) = show (cn <> "/" <> fileName) collectionCmd :: O.Parser Cmd collectionCmd = do fmap CollectionCmd . O.hsubparser . mconcat $ [ O.command "add" . O.info (CollectionAdd <$> collectionNameArg) $ O.progDesc "Add an entity", O.command "view" . O.info (CollectionView <$> collectionPathArg) $ O.progDesc "View an entity", O.command "edit" . O.info (CollectionEdit <$> collectionPathArg) $ O.progDesc "Edit an entity", O.command "delete" . O.info (CollectionDelete <$> collectionPathArg) $ O.progDesc "Delete an entity", -- O.command "schema" . O.info (CollectionSchema <$> collectionNameArg) $ O.progDesc "Show the collection's schema" ] collectionPathArg :: O.Parser CollectionItem collectionPathArg = O.argument O.auto (O.metavar "COLLECTION_PATH") collectionNameArg :: O.Parser Collection collectionNameArg = Collection . T.pack <$> O.strArgument (O.metavar "COLLECTION_NAME") main :: IO () main = O.execParser (O.info (args <**> O.helper) O.idm) >>= \case Args { cmd = CollectionCmd cmd } -> case cmd of CollectionAdd (Collection cn) -> do print =<< ACMS.API.REST.Collection.create cn =<< J.throwDecode =<< LB.getContents CollectionView CollectionItem {collectionName = Collection cn, fileName} -> print =<< ACMS.API.REST.Collection.read cn fileName CollectionDelete CollectionItem {collectionName = Collection cn, fileName} -> print =<< ACMS.API.REST.Collection.delete cn fileName CollectionEdit CollectionItem {collectionName = Collection cn, fileName} -> print =<< ACMS.API.REST.Collection.update cn fileName =<< J.throwDecode =<< LB.getContents CollectionSchema (Collection cn) -> LB.putStr . J.encodePretty @J.Value =<< ACMS.API.REST.Collection.schema cn