From 950eea3ba04e94cf3d5797f9b5d32b2621c89b55 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 13 Feb 2024 02:07:20 +0100
Subject: refactor library

---
 app/Query.hs | 134 -----------------------------------------------------------
 1 file changed, 134 deletions(-)
 delete mode 100644 app/Query.hs

(limited to 'app/Query.hs')

diff --git a/app/Query.hs b/app/Query.hs
deleted file mode 100644
index 140d0f1..0000000
--- a/app/Query.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-module Query
-  ( module Query.Type,
-    query,
-  )
-where
-
-import Control.Exception (throw)
-import Data.Aeson qualified as J
-import Data.Aeson.Key qualified as JK
-import Data.Aeson.KeyMap qualified as JM
-import Data.List (foldl', isSuffixOf)
-import Data.List.NonEmpty qualified as N
-import Data.Maybe (fromMaybe)
-import Data.Vector qualified as V
-import Exception (DecodeException (DecodeException))
-import Query.Parser ()
-import Query.Printer ()
-import Query.Record
-import Query.Type
-import Store qualified as S
-import System.FilePath ((</>))
-
-query :: Query -> IO [J.Value]
-query (Select fs c js es w) = do
-  c' <-
-    mapM (fmap (fromValue c) . decodeFile . (c </>)) =<< ls c
-  js' <-
-    mapM
-      ( \(JoinClause t c w) ->
-          fmap (\j' -> JoinClause t (map (fromValue c) j') w) . mapM (decodeFile . (c </>))
-            =<< ls c
-      )
-      js
-  es' <-
-    mapM
-      ( \(EmbedClause c w) ->
-          fmap (\e' -> EmbedClause (fromValue c e') w) . mapM (decodeFile . (c </>))
-            =<< ls c
-      )
-      es
-  pure $ map (Query.select fs) $ where_ w $ embeds es' $ joins js' c'
-  where
-    ls c =
-      filter (not . (isSuffixOf "/"))
-        <$> S.withStore "." "HEAD" do
-          S.listDirectory c
-
-embeds ::
-  EmbedClauses (Record [J.Value]) ->
-  [Records J.Value] ->
-  [Records J.Value]
-embeds = flip (foldl' embed)
-
-embed ::
-  [Records J.Value] ->
-  EmbedClause (Record [J.Value]) ->
-  [Records J.Value]
-embed vss (EmbedClause (Record c es) w) =
-  map
-    ( \vs ->
-        vs
-          ++ [ fromValue
-                 c
-                 ( J.Object
-                     ( JM.singleton
-                         (JK.fromString c)
-                         ( J.Array
-                             ( V.fromList
-                                 [ e
-                                   | e <- es,
-                                     satisfies w (vs ++ [Record c e])
-                                 ]
-                             )
-                         )
-                     )
-                 )
-             ]
-    )
-    vss
-
-joins ::
-  JoinClauses (Records J.Value) ->
-  [Record J.Value] ->
-  [Records J.Value]
-joins js (map (: []) -> vss) = foldl' join vss js
-
-join ::
-  [Records J.Value] ->
-  JoinClause (Records J.Value) ->
-  [Records J.Value]
-join vss (JoinClause JoinLeft js w) =
-  concatMap
-    ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
-        [] -> [vs]
-        vs' -> vs'
-    )
-    vss
-join vss (JoinClause JoinRight js w) =
-  concatMap
-    ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
-        [] -> [[j]]
-        vs' -> vs'
-    )
-    js
-join vss (JoinClause JoinFull js w) =
-  concatMap
-    ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
-        [] -> [vs]
-        vs' -> vs'
-    )
-    vss
-    ++ concatMap
-      ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
-          [] -> [[j]]
-          _ -> []
-      )
-      js
-
-select :: FieldSelector -> Records J.Value -> J.Value
-select All vs = disjointUnions (map toValue vs)
-select (Only fs) vs = Query.Record.select (N.toList fs) vs
-
-where_ :: Maybe WhereClause -> [Records J.Value] -> [Records J.Value]
-where_ w = filter (satisfies w)
-
-satisfies :: Maybe WhereClause -> Records J.Value -> Bool
-satisfies Nothing _ = True
-satisfies (Just (And ws)) vs = all (\w -> satisfies (Just w) vs) ws
-satisfies (Just (Or ws)) vs = any (\w -> satisfies (Just w) vs) ws
-satisfies (Just (Where (Eq f g))) vs = lookups f vs == lookups g vs
-
-decodeFile :: J.FromJSON a => Collection -> IO a
-decodeFile fp = S.withStore "." "HEAD" do
-  fromMaybe (throw DecodeException) . J.decode <$> S.readFile fp
-- 
cgit v1.2.3