autogenerate collection item IDs
This commit is contained in:
@@ -41,6 +41,7 @@ library
|
||||
tagged,
|
||||
text,
|
||||
utf8-string,
|
||||
uuid,
|
||||
wai,
|
||||
warp
|
||||
|
||||
|
||||
@@ -8,6 +8,8 @@ import Data.Function ((&))
|
||||
import Data.Text qualified as T
|
||||
import Network.HTTP.Simple
|
||||
import Text.Printf (printf)
|
||||
import Data.UUID qualified as U
|
||||
import Data.UUID.V4 qualified as U
|
||||
|
||||
type CollectionName = T.Text
|
||||
|
||||
@@ -37,8 +39,10 @@ update c i o =
|
||||
& httpLBS
|
||||
>>= A.throwDecode . getResponseBody
|
||||
|
||||
create :: T.Text -> T.Text -> A.Object -> IO ()
|
||||
create c i o =
|
||||
create :: T.Text -> A.Object -> IO ()
|
||||
create c o = do
|
||||
uuid <- U.nextRandom
|
||||
let i = U.toText uuid <> ".json"
|
||||
"http://localhost:8081"
|
||||
& setRequestMethod "POST"
|
||||
& setRequestBodyLBS
|
||||
|
||||
@@ -25,10 +25,7 @@ data Args = Args
|
||||
args :: O.Parser Args
|
||||
args = Args <$> cmd_
|
||||
|
||||
data Cmd = Collection
|
||||
{ operation :: CollectionCmd
|
||||
, filePath :: CollectionPath
|
||||
}
|
||||
data Cmd = Collection CollectionCmd
|
||||
|
||||
cmd_ :: O.Parser Cmd
|
||||
cmd_ =
|
||||
@@ -37,16 +34,23 @@ cmd_ =
|
||||
O.progDesc "Manage content collections"
|
||||
]
|
||||
|
||||
data CollectionCmd = CollectionAdd | CollectionView | CollectionEdit | CollectionDelete
|
||||
data CollectionCmd
|
||||
= CollectionAdd CollectionName
|
||||
| CollectionView CollectionPath
|
||||
| CollectionEdit CollectionPath
|
||||
| CollectionDelete CollectionPath
|
||||
|
||||
newtype CollectionName = CollectionName T.Text
|
||||
deriving (Read)
|
||||
|
||||
data CollectionPath = CollectionPath
|
||||
{ collectionName :: T.Text,
|
||||
{ collectionName :: CollectionName,
|
||||
fileName :: T.Text
|
||||
}
|
||||
|
||||
instance Read CollectionPath where
|
||||
readPrec = R.lift do
|
||||
(T.pack -> collectionName) <- R.munch (/= '/')
|
||||
(CollectionName . T.pack -> collectionName) <- R.munch (/= '/')
|
||||
_ <- R.string "/"
|
||||
(T.pack -> fileName) <- do
|
||||
fileName <- R.munch (liftA2 (&&) (/= '.') (/= '/'))
|
||||
@@ -55,51 +59,49 @@ instance Read CollectionPath where
|
||||
pure CollectionPath {..}
|
||||
|
||||
instance Show CollectionPath where
|
||||
show (CollectionPath {collectionName, fileName}) =
|
||||
show (collectionName <> "/" <> fileName)
|
||||
show (CollectionPath {collectionName = CollectionName cn, fileName}) =
|
||||
show (cn <> "/" <> fileName)
|
||||
|
||||
collectionCmd :: O.Parser Cmd
|
||||
collectionCmd = do
|
||||
operation <- O.hsubparser $ mconcat $
|
||||
[ O.command "add" . O.info (pure CollectionAdd) $
|
||||
fmap Collection . O.hsubparser . mconcat $
|
||||
[ O.command "add" . O.info (CollectionAdd <$> collectionNameArg) $
|
||||
O.progDesc "Add an entity"
|
||||
, O.command "view" . O.info (pure CollectionView) $
|
||||
, O.command "view" . O.info (CollectionView <$> collectionPathArg) $
|
||||
O.progDesc "View an entity"
|
||||
, O.command "edit" . O.info (pure CollectionEdit) $
|
||||
, O.command "edit" . O.info (CollectionEdit <$> collectionPathArg) $
|
||||
O.progDesc "Edit an entity"
|
||||
, O.command "delete" . O.info (pure CollectionDelete) $
|
||||
, O.command "delete" . O.info (CollectionDelete <$> collectionPathArg) $
|
||||
O.progDesc "Delete an entity"
|
||||
]
|
||||
filePath <- collectionPathArg
|
||||
pure $ Collection {..}
|
||||
|
||||
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
|
||||
{ operation = operation
|
||||
, filePath = CollectionPath {collectionName, fileName}
|
||||
}
|
||||
} -> case operation of
|
||||
CollectionAdd ->
|
||||
{ cmd = Collection cmd
|
||||
} -> case cmd of
|
||||
CollectionAdd (CollectionName cn) -> do
|
||||
print
|
||||
=<< ACMS.API.REST.Collection.create collectionName fileName
|
||||
=<< ACMS.API.REST.Collection.create cn
|
||||
=<< J.throwDecode
|
||||
=<< LB.getContents
|
||||
CollectionView ->
|
||||
CollectionView CollectionPath {collectionName = CollectionName cn, fileName} ->
|
||||
print
|
||||
=<< ACMS.API.REST.Collection.read collectionName fileName
|
||||
CollectionDelete ->
|
||||
=<< ACMS.API.REST.Collection.read cn fileName
|
||||
CollectionDelete CollectionPath {collectionName = CollectionName cn, fileName}->
|
||||
print
|
||||
=<< ACMS.API.REST.Collection.delete collectionName fileName
|
||||
CollectionEdit ->
|
||||
=<< ACMS.API.REST.Collection.delete cn fileName
|
||||
CollectionEdit CollectionPath {collectionName = CollectionName cn, fileName}->
|
||||
print
|
||||
=<< ACMS.API.REST.Collection.update collectionName fileName
|
||||
=<< ACMS.API.REST.Collection.update cn fileName
|
||||
=<< J.throwDecode
|
||||
=<< LB.getContents
|
||||
|
||||
@@ -13,7 +13,7 @@ export ACMS_CONTENT=$PWD/content
|
||||
## Create a restaurant collection type
|
||||
|
||||
```console
|
||||
acms collection insert restaurant/1.json <<'EOF'
|
||||
acms collection add restaurant <<'EOF'
|
||||
{
|
||||
"name": "Biscotte Restaurant",
|
||||
"description": "Welcome to Biscotte restaurant! Restaurant Biscotte offers a cuisine based on fresh, quality products, often local, organic when possible, and always produced by passionate producers."
|
||||
@@ -24,7 +24,7 @@ EOF
|
||||
## Create a category collection type
|
||||
|
||||
```console
|
||||
acms collection insert category/1.json <<'EOF'
|
||||
acms collection add category <<'EOF'
|
||||
{
|
||||
"name": "French Food",
|
||||
"restaurant": "1.json"
|
||||
@@ -33,7 +33,7 @@ EOF
|
||||
```
|
||||
|
||||
```console
|
||||
acms collection insert category/2.json <<'EOF'
|
||||
acms collection add category <<'EOF'
|
||||
{
|
||||
"name": "Brunch",
|
||||
"restaurant": "1.json"
|
||||
|
||||
Reference in New Issue
Block a user