aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLibravatar Alexander Foremny <aforemny@posteo.de>2024-02-13 02:29:24 +0100
committerLibravatar Alexander Foremny <aforemny@posteo.de>2024-02-13 06:38:01 +0100
commit0c86cb5623df1053d302175505ad834a623ed0a4 (patch)
tree9a26bd2f0b2f99dceb01b3396ac0da221f3ae444
parent950eea3ba04e94cf3d5797f9b5d32b2621c89b55 (diff)
add `repl` command
-rw-r--r--.gitignore1
-rw-r--r--app/Main.hs76
-rw-r--r--astore.cabal17
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