add CLI draft

cli/app/API/Collection.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module API.Collection where
+
+import Data.Aeson qualified as A
+import Data.Aeson.KeyMap qualified as AM
+import Data.Text qualified as T
+import Process.Shell (Quotable (..), sh)
+import Debug.Trace
+
+insert :: T.Text -> T.Text -> A.Object -> IO T.Text
+insert
+  collectionName
+  fileName
+  ( traceShowId -> AM.insert "$fileName" (A.String fileName) -> traceShowId ->
+      A.Object -> traceShowId -> contents
+    ) =
+    {- TODO REST/ CRUD API
+    [sh|
+      curl -fsS http://localhost:8081/collections/#{collectionName}/#{filePath} \
+        --data #{contents}
+    \|]-}
+    [sh|
+    set -efux
+    curl -fsS http://localhost:8081 \
+      --data "INSERT "'#{contents}'" INTO #{collectionName}"
+  |]
+
+-- TODO sh
+instance Quotable A.Value where
+  toString = toString . A.encode

cli/app/Main.hs

@@ -0,0 +1,88 @@
+{-# 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