aboutsummaryrefslogtreecommitdiffstats
path: root/cli/app/Main.hs
blob: 1fc3119f65ade0438d58ed416d04ab65912b9e98 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
{-# 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 = 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

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"
    ]

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