diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 44 |
1 files changed, 25 insertions, 19 deletions
diff --git a/app/Main.hs b/app/Main.hs index 5bb783e..8622317 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,7 +7,12 @@ import Control.Applicative ((<**>)) import Control.Monad.Trans (liftIO) import Data.Aeson qualified as J import Data.ByteString.Lazy.Char8 qualified as LB +import Data.ByteString.Lazy.UTF8 qualified as LB import Data.String (IsString (fromString)) +import Network.HTTP.Types.Method qualified as W +import Network.HTTP.Types.Status qualified as W +import Network.Wai qualified as W +import Network.Wai.Handler.Warp qualified as W import Options.Applicative qualified as A import Store qualified as Q import System.Console.Repline qualified as R @@ -24,39 +29,28 @@ args = data Cmd = Repl + | Serve cmd_ :: A.Parser Cmd cmd_ = A.hsubparser . mconcat $ [ A.command "repl" . A.info replCmd $ - A.progDesc "Interactively execute statements" + A.progDesc "Interactively execute statements", + A.command "serve" . A.info serveCmd $ + A.progDesc "Run webserver" ] -replCmd :: A.Parser Cmd +replCmd, serveCmd :: A.Parser Cmd replCmd = pure Repl +serveCmd = + pure Serve main :: IO () main = do + setCurrentDirectory "./data" 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 @@ -73,6 +67,18 @@ main = do (R.Word (\_ -> pure ["SELECT"])) (pure ()) (pure R.Exit) + Args {cmd = Serve} -> do + W.runEnv 8080 $ \req respond -> do + if + | W.requestMethod req == W.methodPost -> do + q <- + fromString @Q.Query . LB.toString + <$> W.lazyRequestBody req + r <- Q.query q + respond . W.responseLBS W.status200 [] $ + J.encode r + | otherwise -> + respond $ W.responseLBS W.status200 [] "OK" query' :: Q.Query -> IO () query' q = mapM_ (LB.putStrLn . J.encode) =<< Q.query q |