add Git store

1 files changed, 24 insertions, 13 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 493a807..47f0280 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
@@ -8,14 +9,17 @@ import Data.Aeson qualified as J
 import Data.Aeson.Key qualified as JK
 import Data.Aeson.KeyMap qualified as JM
 import Data.ByteString.Lazy.Char8 qualified as LB
-import Data.List (foldl')
+import Data.List (foldl', isSuffixOf)
 import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Set qualified as S
 import Data.String (IsString (fromString))
+import Data.Tagged (Tagged (Tagged))
 import Data.Text qualified as T
 import Debug.Trace (trace)
-import System.Directory (listDirectory, setCurrentDirectory)
-import System.FilePath (takeExtension, (</>))
+import Git
+import Store qualified as S
+import System.Directory (setCurrentDirectory)
+import System.FilePath ((</>))
 import Text.Megaparsec qualified as P
 import Text.Megaparsec.Char qualified as P
 import Text.Megaparsec.Char.Lexer qualified as P
@@ -121,20 +125,30 @@ instance IsString Query where
 
 query :: Query -> IO [J.Value]
 query (Select fs c js ws) = do
-  c' <- mapM (fmap (Record c) . decodeFile . (c </>)) =<< ls c
+  c' <-
+    mapM (fmap (Record c) . decodeFile . (c </>)) =<< ls c
   js' <-
     mapM
       ( \j ->
           case j of
             LeftJoin c ws ->
-              fmap (\j' -> LeftJoin (map (Record c) j') ws) . mapM (decodeFile . (c </>)) =<< ls c
+              fmap (\j' -> LeftJoin (map (Record c) j') ws) . mapM (decodeFile . (c </>))
+                =<< ls c
             RightJoin c ws ->
-              fmap (\j' -> RightJoin (map (Record c) j') ws) . mapM (decodeFile . (c </>)) =<< ls c
+              fmap (\j' -> RightJoin (map (Record c) j') ws) . mapM (decodeFile . (c </>))
+                =<< ls c
             FullJoin c ws ->
-              fmap (\j' -> FullJoin (map (Record c) j') ws) . mapM (decodeFile . (c </>)) =<< ls c
+              fmap (\j' -> FullJoin (map (Record c) j') ws) . mapM (decodeFile . (c </>))
+                =<< ls c
       )
       js
   pure $ map (select fs) $ where_ ws $ combine c' js'
+  where
+    ls c =
+      filter (not . (isSuffixOf "/"))
+        <$> S.withStore "." do
+          Just cid <- fmap Tagged <$> resolveReference "HEAD"
+          S.listDirectory cid c
 
 combine :: [Record J.Value] -> [Join [Record J.Value]] -> [[Record J.Value]]
 combine vs js = combine' (map (: []) vs) js
@@ -177,18 +191,15 @@ combine vs js = combine' (map (: []) vs) js
         )
         jss
 
-ls :: FilePath -> IO [FilePath]
-ls =
-  fmap (filter ((== ".json") . takeExtension)) . listDirectory
-
 data DecodeException = DecodeException
   deriving (Show)
 
 instance Exception DecodeException
 
 decodeFile :: J.FromJSON a => FilePath -> IO a
-decodeFile =
-  fmap (fromMaybe (throw DecodeException)) . J.decodeFileStrict
+decodeFile fp = S.withStore "." do
+  Just cid <- fmap Tagged <$> resolveReference "HEAD"
+  fromMaybe (throw DecodeException) . J.decode <$> S.readFile cid fp
 
 select :: FieldSelector -> [Record J.Value] -> J.Value
 select All vs =