aboutsummaryrefslogtreecommitdiffstats
path: root/app/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Main.hs')
-rw-r--r--app/Main.hs37
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 =