add `LIMIT`, `ORDER BY` clausesmain

6 files changed, 92 insertions, 19 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 945bfc9..3b7f59d 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Main
   ( main,
   )
@@ -9,6 +11,7 @@ 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 Data.Vector qualified as V
 import Network.HTTP.Types.Method qualified as W
 import Network.HTTP.Types.Status qualified as W
 import Network.Wai qualified as W
@@ -63,7 +66,12 @@ main = do
       R.evalRepl
         (const . pure $ ">>> ")
         ( liftIO
-            . (mapM_ (LB.putStrLn . J.encode) =<<)
+            . ( ( \case
+                    J.Array xs -> mapM_ (LB.putStrLn . J.encode) (V.toList xs)
+                    x -> LB.putStrLn (J.encode x)
+                )
+                  =<<
+              )
             . Q.withStore root ref
             . Q.query
             . fromString
@@ -77,12 +85,12 @@ main = do
     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 <- liftIO $ Q.withStore root ref (Q.query q)
-                respond . W.responseLBS W.status200 [] $
-                  J.encode r
-            | otherwise ->
-                respond $ W.responseLBS W.status200 [] "OK"
+          | W.requestMethod req == W.methodPost -> do
+              q <-
+                fromString @Q.Query . LB.toString
+                  <$> W.lazyRequestBody req
+              r <- liftIO $ Q.withStore root ref (Q.query q)
+              respond . W.responseLBS W.status200 [] $
+                J.encode r
+          | otherwise ->
+              respond $ W.responseLBS W.status200 [] "OK"
diff --git a/astore.cabal b/astore.cabal
index a59eb0f..601192f 100644
--- a/astore.cabal
+++ b/astore.cabal
@@ -74,5 +74,6 @@ executable astore
         optparse-applicative,
         repline,
         utf8-string,
+        vector,
         wai,
         warp
diff --git a/src/Store/Query.hs b/src/Store/Query.hs
index 091aae7..4c0f829 100644
--- a/src/Store/Query.hs
+++ b/src/Store/Query.hs
@@ -16,6 +16,7 @@ import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Text qualified as T
 import Data.Vector qualified as V
+import GHC.Generics (Generic)
 import Store.Exception (DecodeException (DecodeException), MissingFileName (MissingFileName))
 import Store.Query.Parser ()
 import Store.Query.Printer ()
@@ -24,7 +25,17 @@ import Store.Query.Type
 import Store.Store qualified as S
 import System.FilePath ((</>))
 
-query :: Query -> S.StoreM [J.Value]
+data Paginated = Paginated
+  { count :: Int,
+    data_ :: [J.Value]
+  }
+  deriving (Show, Generic)
+
+instance J.ToJSON Paginated
+
+instance J.FromJSON Paginated
+
+query :: Query -> S.StoreM J.Value
 query (Delete c w) = do
   c' <-
     mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile c $ fn)
@@ -33,7 +44,7 @@ query (Delete c w) = do
   lift $ print fps
   mapM_ S.deleteFile (map (c </>) fps)
   S.commit
-  pure []
+  pure (J.toJSON ([] @()))
 query (Insert vs c) = do
   let vs' = map (\v -> ((c, fileName v), v)) vs
 
@@ -43,8 +54,8 @@ query (Insert vs c) = do
           _ -> throw (MissingFileName v)
   mapM_ (\((c, fn), v) -> encodeFile c fn v) vs'
   S.commit
-  pure []
-query (Select fs c js es w) = do
+  pure (J.toJSON ([] @()))
+query (Select fs c js es w l o) = do
   c' <-
     mapM (\fn -> fromValue c <$> decodeFile c fn)
       =<< S.listFiles c
@@ -64,7 +75,18 @@ query (Select fs c js es w) = do
             =<< S.listFiles c
       )
       es
-  pure $ map (Store.Query.select fs) $ where_ w $ embeds es' $ joins js' c'
+  let rs =
+        map (Store.Query.select fs)
+          . where_ w
+          . embeds es'
+          . joins js'
+          $ c'
+      rs' =
+        case l >> o >> pure () of
+          (Just _) ->
+            J.toJSON (Paginated (length rs) . applyLimit l . applyOffset o $ rs)
+          _ -> J.toJSON rs
+  pure rs'
 query (Update c v w) = do
   c' <-
     mapM (\fn -> fmap (((c, fn),) . fromValue c) . decodeFile c $ fn)
@@ -76,7 +98,15 @@ query (Update c v w) = do
     )
     c''
   S.commit
-  pure []
+  pure (J.toJSON ([] @()))
+
+applyLimit :: Maybe LimitClause -> [a] -> [a]
+applyLimit Nothing = id
+applyLimit (Just (Limit n)) = take n
+
+applyOffset :: Maybe OffsetClause -> [a] -> [a]
+applyOffset Nothing = id
+applyOffset (Just (Offset n)) = drop n
 
 embeds ::
   EmbedClauses (Record [J.Value]) ->
diff --git a/src/Store/Query/Parser.hs b/src/Store/Query/Parser.hs
index 99ddc79..5b7bc1b 100644
--- a/src/Store/Query/Parser.hs
+++ b/src/Store/Query/Parser.hs
@@ -51,7 +51,11 @@ instance IsString Query where
               w <- P.optional do
                 where_
                 whereClause
-              pure $ Select fs c js es w,
+              l <- P.optional do
+                limitClause
+              o <- P.optional do
+                offsetClause
+              pure $ Select fs c js es w l o,
             do
               update
               c <- collection
@@ -83,6 +87,8 @@ instance IsString Query where
       or = void $ lexeme (P.string "OR")
       select = void $ lexeme (P.string "SELECT")
       where_ = void $ lexeme (P.string "WHERE")
+      offset_ = void $ lexeme (P.string "OFFSET")
+      limit_ = void $ lexeme (P.string "LIMIT")
 
       collection = lexeme $ P.takeWhile1P (Just "collection") (not . isSpace)
 
@@ -119,6 +125,14 @@ instance IsString Query where
         b <- P.choice [Left <$> value, Right <$> field]
         pure $ Eq a b
 
+      offsetClause = do
+        offset_
+        Offset <$> lexeme P.decimal
+
+      limitClause = do
+        limit_
+        Limit <$> lexeme P.decimal
+
       fieldSelector =
         lexeme $
           P.choice
diff --git a/src/Store/Query/Printer.hs b/src/Store/Query/Printer.hs
index cff543f..ecde378 100644
--- a/src/Store/Query/Printer.hs
+++ b/src/Store/Query/Printer.hs
@@ -26,7 +26,7 @@ instance Show Query where
         Just "INTO",
         Just (showCollection c)
       ]
-  show (Select fs c js es w) =
+  show (Select fs c js es w l o) =
     intercalate " " . catMaybes $
       [ Just "SELECT",
         Just (showFieldSelector fs),
@@ -34,7 +34,9 @@ instance Show Query where
         Just (showCollection c),
         showJoinClauses js,
         showEmbedClauses es,
-        showWhereClause w
+        showWhereClause w,
+        showLimitClause l,
+        showOffsetClause o
       ]
   show (Update c v w) =
     intercalate " " . catMaybes $
@@ -106,6 +108,14 @@ showComparison (Eq a b) = intercalate " " [showArg a, "==", showArg b]
   where
     showArg = either showValue showField
 
+showOffsetClause :: Maybe OffsetClause -> Maybe String
+showOffsetClause (Just (Offset n)) = Just (" OFFSET %d" <> show n)
+showOffsetClause Nothing = Nothing
+
+showLimitClause :: Maybe LimitClause -> Maybe String
+showLimitClause (Just (Limit n)) = Just (" LIMIT %d" <> show n)
+showLimitClause Nothing = Nothing
+
 showValues :: [J.Value] -> Maybe String
 showValues [] = Nothing
 showValues vs = Just (intercalate ", " (map showValue vs))
diff --git a/src/Store/Query/Type.hs b/src/Store/Query/Type.hs
index 912d020..2f1f5ec 100644
--- a/src/Store/Query/Type.hs
+++ b/src/Store/Query/Type.hs
@@ -11,6 +11,8 @@ module Store.Query.Type
     JoinType (..),
     Query (..),
     WhereClause (..),
+    LimitClause (..),
+    OffsetClause (..),
   )
 where
 
@@ -28,6 +30,8 @@ data Query
       (JoinClauses FilePath)
       (EmbedClauses FilePath)
       (Maybe WhereClause)
+      (Maybe LimitClause)
+      (Maybe OffsetClause)
   | Update Collection J.Value (Maybe WhereClause)
 
 data FieldSelector
@@ -64,3 +68,9 @@ data WhereClause
 data Comparison
   = Eq (Either J.Value Field) (Either J.Value Field)
   deriving (Show)
+
+data LimitClause = Limit Int
+  deriving (Show)
+
+data OffsetClause = Offset Int
+  deriving (Show)