refactor library

5 files changed, 0 insertions, 360 deletions

diff --git a/app/Query/Field.hs b/app/Query/Field.hs
deleted file mode 100644
index cdb977a..0000000
--- a/app/Query/Field.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Query.Field
-  ( Field (..),
-    toString,
-    prefix,
-  )
-where
-
-import Data.Aeson qualified as J
-import Data.Aeson.Key qualified as JK
-import Data.Aeson.KeyMap qualified as JM
-import Data.List (intercalate)
-import Data.List.NonEmpty qualified as N
-import Data.Text qualified as T
-
-data Field
-  = Qualified Collection (N.NonEmpty T.Text)
-  | Unqualified (N.NonEmpty T.Text)
-  deriving (Show)
-
-toString :: Field -> String
-toString (Qualified c ks) = intercalate "." (c : map T.unpack (N.toList ks))
-toString (Unqualified ks) = intercalate "." (map T.unpack (N.toList ks))
-
-type Collection = FilePath
-
-prefix :: Field -> J.Value -> J.Value
-prefix (Qualified c ks) = prefix' (T.pack c : N.toList ks)
-prefix (Unqualified ks) = prefix' (N.toList ks)
-
-prefix' :: [T.Text] -> J.Value -> J.Value
-prefix' ks v =
-  foldr ((J.Object .) . JM.singleton) v (map JK.fromText ks)
diff --git a/app/Query/Parser.hs b/app/Query/Parser.hs
deleted file mode 100644
index f2012e2..0000000
--- a/app/Query/Parser.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Query.Parser () where
-
-import Control.Exception (throw)
-import Control.Monad (void)
-import Control.Monad.Combinators.NonEmpty qualified as PN
-import Data.Char (isSpace)
-import Data.List.NonEmpty qualified as N
-import Data.String (IsString (fromString))
-import Data.Text qualified as T
-import Data.Void (Void)
-import Exception (ParseError (ParseError))
-import Query.Type
-import Text.Megaparsec qualified as P
-import Text.Megaparsec.Char qualified as P
-import Text.Megaparsec.Char.Lexer qualified as P
-
-instance IsString Query where
-  fromString =
-    either (throw . ParseError . P.errorBundlePretty @String @Void) id
-      . P.parse parser ""
-    where
-      parser = do
-        void $ P.many P.space1
-        select
-        fs <- fieldSelector
-        from
-        c <- collection
-        js <- joinClauses
-        es <- embedClauses
-        w <- P.optional do
-          where_
-          whereClause
-        P.eof
-        pure $ Select fs c js es w
-
-      lexeme :: P.Parsec Void String a -> P.Parsec Void String a
-      lexeme = P.lexeme $ void $ P.takeWhileP Nothing isSpace
-
-      and = void $ lexeme (P.string "AND")
-      comma = void $ lexeme (P.string ",")
-      embed = void $ lexeme (P.string "EMBED")
-      eq = void $ lexeme (P.string "==")
-      from = void $ lexeme (P.string "FROM")
-      on = void $ lexeme (P.string "ON")
-      or = void $ lexeme (P.string "OR")
-      select = void $ lexeme (P.string "SELECT")
-      where_ = void $ lexeme (P.string "WHERE")
-
-      collection = lexeme $ P.takeWhile1P (Just "collection") (not . isSpace)
-
-      joinClauses = P.many joinClause
-
-      joinClause = do
-        t <- joinType
-        c <- collection
-        w <- P.optional do
-          on
-          whereClause
-        pure $ JoinClause t c w
-
-      embedClauses = P.many embedClause
-
-      embedClause = do
-        embed
-        c <- collection
-        w <- P.optional do
-          on
-          whereClause
-        pure $ EmbedClause c w
-
-      whereClause =
-        P.choice
-          [ P.try (And . map Where <$> P.sepBy1 comparison and),
-            P.try (Or . map Where <$> P.sepBy1 comparison or),
-            Where <$> comparison
-          ]
-
-      comparison = do
-        a <- field
-        eq
-        b <- field
-        pure $ Eq a b
-
-      fieldSelector =
-        P.choice
-          [ do
-              void $ lexeme $ P.string "*"
-              pure All,
-            do
-              Only <$> PN.sepBy1 field comma
-          ]
-
-      field :: P.Parsec Void String Field
-      field =
-        lexeme . P.choice $
-          [ P.try
-              do
-                Qualified
-                  <$> (fieldPart <* P.string ".")
-                  <*> (N.map T.pack <$> PN.sepBy1 fieldPart (P.string ".")),
-            do
-              Unqualified
-                <$> (N.map T.pack <$> PN.sepBy1 fieldPart (P.string "."))
-          ]
-
-      fieldPart :: P.Parsec Void String String
-      fieldPart = P.takeWhile1P Nothing (\c -> not (isSpace c) && c /= ',' && c /= '.')
-
-      joinType :: P.Parsec Void String JoinType
-      joinType =
-        P.choice
-          [ do
-              void $ lexeme (P.string "LEFT")
-              void $ lexeme (P.string "JOIN")
-              pure JoinLeft,
-            do
-              void $ lexeme (P.string "RIGHT")
-              void $ lexeme (P.string "JOIN")
-              pure JoinRight,
-            do
-              void $ lexeme (P.string "FULL")
-              void $ lexeme (P.string "JOIN")
-              pure JoinFull
-          ]
diff --git a/app/Query/Printer.hs b/app/Query/Printer.hs
deleted file mode 100644
index e43b7d0..0000000
--- a/app/Query/Printer.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Query.Printer () where
-
-import Data.List (intercalate)
-import Data.List.NonEmpty qualified as N
-import Data.Maybe (catMaybes, mapMaybe)
-import Query.Field
-import Query.Type
-
-instance Show Query where
-  show (Select fs c js es w) =
-    intercalate " " $
-      catMaybes $
-        [ Just "SELECT",
-          Just (showFieldSelector fs),
-          Just "FROM",
-          Just (showCollection c),
-          showJoinClauses js,
-          showEmbedClauses es,
-          showWhereClause w
-        ]
-    where
-      showFieldSelector All = "*"
-      showFieldSelector (Only (N.toList -> fs)) =
-        intercalate ", " (map showField fs)
-      showField = Query.Field.toString
-      showCollection c = c
-      showJoinClauses js = case map showJoinClause js of
-        [] -> Nothing
-        xs -> Just (intercalate " " xs)
-      showJoinClause (JoinClause t c w) =
-        intercalate " " $
-          catMaybes $
-            [ Just (showJoinType t),
-              Just (showCollection c),
-              Just "ON",
-              showWhereClause w
-            ]
-      showJoinType JoinLeft = "LEFT JOIN"
-      showJoinType JoinRight = "RIGHT JOIN"
-      showJoinType JoinFull = "FULL JOIN"
-      showEmbedClauses js = case map showEmbedClause js of
-        [] -> Nothing
-        xs -> Just (intercalate " " xs)
-      showEmbedClause (EmbedClause c w) =
-        intercalate " " $
-          catMaybes $
-            [ Just "EMBED",
-              Just (showCollection c),
-              Just "ON",
-              showWhereClause w
-            ]
-      showWhereClause = showWhereClauseWith id
-      showWhereClause' = showWhereClauseWith (\x -> "(" <> x <> ")")
-      showWhereClauseWith _ Nothing = Nothing
-      showWhereClauseWith wrap (Just (And ws)) = Just (wrap (intercalate "AND" (mapMaybe (showWhereClause' . Just) ws)))
-      showWhereClauseWith wrap (Just (Or ws)) = Just (wrap (intercalate "OR" (mapMaybe (showWhereClause' . Just) ws)))
-      showWhereClauseWith _ (Just (Where p)) = Just (showComparison p)
-      showComparison (Eq a b) = intercalate " " [showField a, "==", showField b]
diff --git a/app/Query/Record.hs b/app/Query/Record.hs
deleted file mode 100644
index b1b3329..0000000
--- a/app/Query/Record.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module Query.Record
-  ( Record (..),
-    fromValue,
-    toValue,
-    lookup,
-    Records,
-    lookups,
-    select,
-    disjointUnion,
-    disjointUnions,
-  )
-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')
-import Data.List.NonEmpty qualified as N
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Text qualified as T
-import Exception (DuplicateField (DuplicateField))
-import Query.Field
-import Prelude hiding (lookup)
-
-data Record a
-  = Record Collection a
-  deriving (Show, Eq)
-
-type Collection = FilePath
-
-fromValue :: Collection -> a -> Record a
-fromValue = Record
-
-toValue :: Record a -> a
-toValue (Record _ v) = v
-
-lookup :: Field -> Record J.Value -> Maybe J.Value
-lookup (Unqualified ks) (Record _ v) =
-  lookup' (N.toList ks) v
-lookup (Qualified c' ks) (Record c v)
-  | c' == c = lookup' (N.toList ks) v
-  | otherwise = Nothing
-
-lookup' :: [T.Text] -> J.Value -> Maybe J.Value
-lookup' [] v = Just v
-lookup' (k : ks) (J.Object kvs) =
-  lookup' ks =<< JM.lookup (JK.fromText k) kvs
-
-type Records a = [Record a]
-
-lookups :: Field -> Records J.Value -> Maybe J.Value
-lookups f rs =
-  case mapMaybe (lookup f) rs of
-    [] -> Nothing
-    [v] -> Just v
-    (_ : _) -> throw (DuplicateField (toString f))
-
-select :: [Field] -> Records J.Value -> J.Value
-select fs rs =
-  foldl'
-    union
-    (J.Object JM.empty)
-    (map (\f -> prefix f ((fromMaybe J.Null (lookups f rs)))) fs)
-
-union :: J.Value -> J.Value -> J.Value
-union (J.Object r) (J.Object s) = J.Object (JM.unionWith union r s)
-
-disjointUnion :: J.Value -> J.Value -> J.Value
-disjointUnion (J.Object r) (J.Object s) =
-  J.Object (JM.unionWithKey disjointUnion' r s)
-
-disjointUnion' :: JK.Key -> J.Value -> J.Value -> J.Value
-disjointUnion' _ (J.Object r) (J.Object s) =
-  J.Object (JM.unionWithKey disjointUnion' r s)
-disjointUnion' k _ _ =
-  throw (DuplicateField (JK.toString k))
-
-disjointUnions :: [J.Value] -> J.Value
-disjointUnions = foldl' disjointUnion (J.Object JM.empty)
diff --git a/app/Query/Type.hs b/app/Query/Type.hs
deleted file mode 100644
index d27106f..0000000
--- a/app/Query/Type.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module Query.Type
-  ( module Query.Field,
-    module Query.Record,
-    Collection,
-    Comparison (..),
-    EmbedClause (..),
-    EmbedClauses,
-    FieldSelector (..),
-    JoinClause (..),
-    JoinClauses,
-    JoinType (..),
-    Query (..),
-    WhereClause (..),
-  )
-where
-
-import Data.List.NonEmpty qualified as N
-import Query.Field
-import Query.Record
-
-data Query
-  = Select
-      FieldSelector
-      Collection
-      (JoinClauses FilePath)
-      (EmbedClauses FilePath)
-      (Maybe WhereClause)
-
-data FieldSelector
-  = All
-  | Only (N.NonEmpty Field)
-  deriving (Show)
-
-type Collection = FilePath
-
-type JoinClauses a = [JoinClause a]
-
-data JoinClause a
-  = JoinClause JoinType a (Maybe WhereClause)
-  deriving (Show)
-
-data JoinType
-  = JoinLeft
-  | JoinRight
-  | JoinFull
-  deriving (Show)
-
-type EmbedClauses a = [EmbedClause a]
-
-data EmbedClause a
-  = EmbedClause a (Maybe WhereClause)
-  deriving (Show)
-
-data WhereClause
-  = And [WhereClause]
-  | Or [WhereClause]
-  | Where Comparison
-  deriving (Show)
-
-data Comparison
-  = Eq Field Field
-  deriving (Show)