{-# 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 (..)) import Debug.Trace 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 { collection :: Collection, itemFileName :: T.Text } instance Read CollectionItem where readPrec = R.lift do (Collection . T.pack -> collection) <- R.munch (/= '/') _ <- R.string "/" (T.pack -> itemFileName) <- do itemFileName <- R.munch (liftA2 (&&) (/= '.') (/= '/')) fileExt <- R.string ".json" pure (itemFileName <> fileExt) pure CollectionItem {..} instance Show CollectionItem where show (CollectionItem {collection = Collection cn, itemFileName}) = show (cn <> "/" <> itemFileName) collectionCmd :: O.Parser Cmd collectionCmd = do fmap CollectionCmd . O.hsubparser . mconcat $ [ O.command "add" . O.info (CollectionAdd <$> collectionArg) $ O.progDesc "Add an entity", O.command "view" . O.info (CollectionView <$> collectionItemArg) $ O.progDesc "View an entity", O.command "edit" . O.info (CollectionEdit <$> collectionItemArg) $ O.progDesc "Edit an entity", O.command "delete" . O.info (CollectionDelete <$> collectionItemArg) $ O.progDesc "Delete an entity", -- O.command "schema" . O.info (CollectionSchema <$> collectionArg) $ O.progDesc "Show the collection's schema" ] collectionItemArg :: O.Parser CollectionItem collectionItemArg = O.argument O.auto (O.metavar "COLLECTION_PATH") collectionArg :: O.Parser Collection collectionArg = 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 LB.putStr . J.encodePretty =<< ACMS.API.REST.Collection.create cn =<< J.throwDecode =<< LB.getContents CollectionView CollectionItem {collection = Collection cn, itemFileName} -> LB.putStr . J.encodePretty =<< ACMS.API.REST.Collection.read cn itemFileName CollectionDelete CollectionItem {collection = Collection cn, itemFileName} -> LB.putStr . J.encodePretty =<< ACMS.API.REST.Collection.delete cn itemFileName CollectionEdit CollectionItem {collection = Collection cn, itemFileName} -> LB.putStr . J.encodePretty =<< ACMS.API.REST.Collection.update cn itemFileName =<< J.throwDecode =<< LB.getContents CollectionSchema (Collection cn) -> LB.putStr . J.encodePretty @J.Value =<< ACMS.API.REST.Collection.schema cn