{-# 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.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 = CollectionAdd { 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 "add" . O.info collectionAddCmd $ O.progDesc "Add an entity" ] collectionAddCmd :: O.Parser CollectionCmd collectionAddCmd = CollectionAdd <$> 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 CollectionAdd { filePath = CollectionPath {collectionName, fileName} } } -> print =<< ACMS.API.REST.Collection.create collectionName fileName =<< J.throwDecode =<< LB.getContents