From 0c86cb5623df1053d302175505ad834a623ed0a4 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 13 Feb 2024 02:29:24 +0100
Subject: add `repl` command

---
 .gitignore   |  1 +
 app/Main.hs  | 76 +++++++++++++++++++++++++++++++++++++++++++++++++-----------
 astore.cabal | 17 +++++++++-----
 3 files changed, 74 insertions(+), 20 deletions(-)

diff --git a/.gitignore b/.gitignore
index 8075013..1dfaddf 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,2 @@
 /dist-newstyle
+data/.history
diff --git a/app/Main.hs b/app/Main.hs
index 5574afa..5bb783e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -3,28 +3,76 @@ module Main
   )
 where
 
+import Control.Applicative ((<**>))
+import Control.Monad.Trans (liftIO)
 import Data.Aeson qualified as J
 import Data.ByteString.Lazy.Char8 qualified as LB
+import Data.String (IsString (fromString))
+import Options.Applicative qualified as A
 import Store qualified as Q
+import System.Console.Repline qualified as R
 import System.Directory (setCurrentDirectory)
 import Text.Printf (printf)
 
+data Args = Args
+  { cmd :: Cmd
+  }
+
+args :: A.Parser Args
+args =
+  Args <$> cmd_
+
+data Cmd
+  = Repl
+
+cmd_ :: A.Parser Cmd
+cmd_ =
+  A.hsubparser . mconcat $
+    [ A.command "repl" . A.info replCmd $
+        A.progDesc "Interactively execute statements"
+    ]
+
+replCmd :: A.Parser Cmd
+replCmd =
+  pure Repl
+
 main :: IO ()
 main = do
-  setCurrentDirectory "./data"
-
-  mapM_
-    ( \q -> do
-        printf "> %s\n" (show q)
-        query' q
-    )
-    [ "SELECT * FROM c",
-      "SELECT * FROM j",
-      "SELECT c.id, j.id, is_j FROM c LEFT JOIN j ON j.id == c.j_id",
-      "SELECT c.id, j.id FROM c RIGHT JOIN j ON j.id == c.j_id",
-      "SELECT c.id, j.id FROM c FULL JOIN j ON j.id == c.j_id",
-      "SELECT c.id, j FROM c EMBED j ON j.id == c.j_id"
-    ]
+  A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
+    Args {cmd = Repl} -> do
+      setCurrentDirectory "./data"
+
+      {-
+      mapM_
+        ( \q -> do
+            printf "> %s\n" (show q)
+            query' q
+        )
+        [ "SELECT * FROM c",
+          "SELECT * FROM j",
+          "SELECT c.id, j.id, is_j FROM c LEFT JOIN j ON j.id == c.j_id",
+          "SELECT c.id, j.id FROM c RIGHT JOIN j ON j.id == c.j_id",
+          "SELECT c.id, j.id FROM c FULL JOIN j ON j.id == c.j_id",
+          "SELECT c.id, j FROM c EMBED j ON j.id == c.j_id"
+        ]
+        -}
+
+      -- TODO Catch `ParseError` exception
+      --
+      -- @topic repl
+
+      -- TODO Add query auto-completion
+      --
+      -- @topic repl
+      R.evalRepl
+        (const . pure $ ">>> ")
+        (liftIO . query' . fromString)
+        ([])
+        (Just ':')
+        (Just "paste")
+        (R.Word (\_ -> pure ["SELECT"]))
+        (pure ())
+        (pure R.Exit)
 
 query' :: Q.Query -> IO ()
 query' q = mapM_ (LB.putStrLn . J.encode) =<< Q.query q
diff --git a/astore.cabal b/astore.cabal
index fa9b4ea..568bb41 100644
--- a/astore.cabal
+++ b/astore.cabal
@@ -9,11 +9,10 @@ build-type:      Simple
 extra-doc-files: CHANGELOG.md
 
 library
-    exposed-modules:
-        Store
-
+    exposed-modules:    Store
     hs-source-dirs:     src
-    other-modules:      Store.Debug
+    other-modules:
+        Store.Debug
         Store.Exception
         Store.Query
         Store.Query.Field
@@ -22,6 +21,7 @@ library
         Store.Query.Record
         Store.Query.Type
         Store.Store
+
     default-language:   GHC2021
     default-extensions:
         AllowAmbiguousTypes BlockArguments GeneralizedNewtypeDeriving
@@ -55,10 +55,15 @@ executable astore
     main-is:            Main.hs
     hs-source-dirs:     app
     default-language:   GHC2021
-    default-extensions: OverloadedStrings
+    default-extensions:
+        LambdaCase NoFieldSelectors OverloadedRecordDot OverloadedStrings
+
     build-depends:
         aeson,
         astore,
         base,
         bytestring,
-        directory
+        directory,
+        mtl,
+        optparse-applicative,
+        repline
-- 
cgit v1.2.3