{-# 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