108 lines
3.3 KiB
Haskell
108 lines
3.3 KiB
Haskell
{-# LANGUAGE BlockArguments #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
{-# LANGUAGE NoFieldSelectors #-}
|
|
{-# LANGUAGE ApplicativeDo #-}
|
|
|
|
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 CollectionName
|
|
| CollectionView CollectionPath
|
|
| CollectionEdit CollectionPath
|
|
| CollectionDelete CollectionPath
|
|
|
|
newtype CollectionName = CollectionName T.Text
|
|
deriving (Read)
|
|
|
|
data CollectionPath = CollectionPath
|
|
{ collectionName :: CollectionName,
|
|
fileName :: T.Text
|
|
}
|
|
|
|
instance Read CollectionPath where
|
|
readPrec = R.lift do
|
|
(CollectionName . 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 = CollectionName cn, fileName}) =
|
|
show (cn <> "/" <> fileName)
|
|
|
|
collectionCmd :: O.Parser Cmd
|
|
collectionCmd = do
|
|
fmap Collection . 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"
|
|
]
|
|
|
|
collectionPathArg :: O.Parser CollectionPath
|
|
collectionPathArg =
|
|
O.argument O.auto (O.metavar "COLLECTION_PATH")
|
|
|
|
collectionNameArg :: O.Parser CollectionName
|
|
collectionNameArg =
|
|
CollectionName . T.pack <$> O.strArgument (O.metavar "COLLECTION_NAME")
|
|
|
|
main :: IO ()
|
|
main =
|
|
O.execParser (O.info (args <**> O.helper) O.idm) >>= \case
|
|
Args
|
|
{ cmd = Collection cmd
|
|
} -> case cmd of
|
|
CollectionAdd (CollectionName cn) -> do
|
|
print
|
|
=<< ACMS.API.REST.Collection.create cn
|
|
=<< J.throwDecode
|
|
=<< LB.getContents
|
|
CollectionView CollectionPath {collectionName = CollectionName cn, fileName} ->
|
|
print
|
|
=<< ACMS.API.REST.Collection.read cn fileName
|
|
CollectionDelete CollectionPath {collectionName = CollectionName cn, fileName}->
|
|
print
|
|
=<< ACMS.API.REST.Collection.delete cn fileName
|
|
CollectionEdit CollectionPath {collectionName = CollectionName cn, fileName}->
|
|
print
|
|
=<< ACMS.API.REST.Collection.update cn fileName
|
|
=<< J.throwDecode
|
|
=<< LB.getContents
|