From 5b99f6683ff92621f5b98685b0d638ae2362348b Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Fri, 9 Feb 2024 15:57:00 +0100
Subject: refactor `WhereClauses`
---
app/Main.hs | 101 ++++++++++++++++++++++++++++++++++++------------------------
1 file changed, 60 insertions(+), 41 deletions(-)
(limited to 'app')
diff --git a/app/Main.hs b/app/Main.hs
index a5efb6d..342162e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -42,10 +42,14 @@ main = do
]
data Query
- = Select FieldSelector Collection (JoinClauses FilePath) WhereClauses
+ = Select
+ FieldSelector
+ Collection
+ (JoinClauses FilePath)
+ (Maybe WhereClause)
instance Show Query where
- show (Select fs c js ws) =
+ show (Select fs c js w) =
intercalate " " $
catMaybes $
[ Just "SELECT",
@@ -53,7 +57,7 @@ instance Show Query where
Just "FROM",
Just (showCollection c),
showJoinClauses js,
- showWhereClauses ws
+ showWhereClause w
]
where
showFieldSelector All = "*"
@@ -64,21 +68,24 @@ instance Show Query where
showJoinClauses js = case map showJoinClause js of
[] -> Nothing
xs -> Just (intercalate " " xs)
- showJoinClause (JoinClause t c ws) =
+ showJoinClause (JoinClause t c w) =
intercalate " " $
catMaybes $
[ Just (showJoinType t),
Just (showCollection c),
Just "ON",
- showWhereClauses ws
+ showWhereClause w
]
showJoinType JoinLeft = "LEFT JOIN"
showJoinType JoinRight = "RIGHT JOIN"
showJoinType JoinFull = "FULL JOIN"
- showWhereClauses ws = case map showWhereClause ws of
- [] -> Nothing
- xs -> Just (intercalate " " xs)
- showWhereClause (Eq a b) = intercalate " " [showField a, "==", showField b]
+ 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]
data FieldSelector
= All
@@ -95,7 +102,7 @@ type Collection = FilePath
type JoinClauses a = [JoinClause a]
data JoinClause a
- = JoinClause JoinType a WhereClauses
+ = JoinClause JoinType a (Maybe WhereClause)
deriving (Show)
data JoinType
@@ -104,9 +111,13 @@ data JoinType
| JoinFull
deriving (Show)
-type WhereClauses = [WhereClause]
-
data WhereClause
+ = And [WhereClause]
+ | Or [WhereClause]
+ | Where Comparison
+ deriving (Show)
+
+data Comparison
= Eq Field Field
deriving (Show)
@@ -131,21 +142,21 @@ instance IsString Query where
from
c <- collection
js <- joinClauses
- ws <-
- fromMaybe [] <$> P.optional do
- where_
- whereClauses1
+ w <- P.optional do
+ where_
+ whereClause
P.eof
- pure $ Select fs c js ws
+ pure $ Select fs c js w
lexeme :: P.Parsec Void String a -> P.Parsec Void String a
lexeme = P.lexeme $ void $ P.takeWhileP Nothing isSpace
- comma, eq, from, on, select, where_ :: P.Parsec Void String ()
+ and = void $ lexeme (P.string "AND")
comma = void $ lexeme (P.string ",")
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")
@@ -156,14 +167,19 @@ instance IsString Query where
joinClause = do
t <- joinType
c <- collection
- on
- ws <- whereClauses
- pure $ JoinClause t c ws
+ w <- P.optional do
+ on
+ whereClause
+ pure $ JoinClause t c w
- whereClauses1 = P.some whereClause
- whereClauses = P.many whereClause
+ whereClause =
+ P.choice
+ [ P.try (And . map Where <$> P.sepBy1 comparison and),
+ P.try (Or . map Where <$> P.sepBy1 comparison or),
+ Where <$> comparison
+ ]
- whereClause = do
+ comparison = do
a <- field
eq
b <- field
@@ -208,17 +224,17 @@ instance IsString Query where
]
query :: Query -> IO [J.Value]
-query (Select fs c js ws) = do
+query (Select fs c js w) = do
c' <-
mapM (fmap (Record c) . decodeFile . (c </>)) =<< ls c
js' <-
mapM
- ( \(JoinClause t c ws) ->
- fmap (\j' -> JoinClause t (map (Record c) j') ws) . mapM (decodeFile . (c </>))
+ ( \(JoinClause t c w) ->
+ fmap (\j' -> JoinClause t (map (Record c) j') w) . mapM (decodeFile . (c </>))
=<< ls c
)
js
- pure $ map (select fs) $ where_ ws $ combine c' js'
+ pure $ map (select fs) $ where_ w $ combine c' js'
where
ls c =
filter (not . (isSuffixOf "/"))
@@ -229,36 +245,36 @@ combine :: [Record J.Value] -> JoinClauses [Record J.Value] -> [[Record J.Value]
combine vs js = combine' (map (: []) vs) js
where
combine' vss [] = vss
- combine' vss (JoinClause JoinLeft js ws : jss) =
+ combine' vss (JoinClause JoinLeft js w : jss) =
combine'
( concatMap
- ( \vs -> case filter (satisfies ws) $ map (\j -> vs ++ [j]) js of
+ ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
[] -> [vs]
vs' -> vs'
)
vss
)
jss
- combine' vss (JoinClause JoinRight js ws : jss) =
+ combine' vss (JoinClause JoinRight js w : jss) =
combine'
( concatMap
- ( \j -> case filter (satisfies ws) $ map (\vs -> vs ++ [j]) vss of
+ ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
[] -> [[j]]
vs' -> vs'
)
js
)
jss
- combine' vss (JoinClause JoinFull js ws : jss) =
+ combine' vss (JoinClause JoinFull js w : jss) =
combine'
( concatMap
- ( \vs -> case filter (satisfies ws) $ map (\j -> vs ++ [j]) js of
+ ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
[] -> [vs]
vs' -> vs'
)
vss
++ concatMap
- ( \j -> case filter (satisfies ws) $ map (\vs -> vs ++ [j]) vss of
+ ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
[] -> [[j]]
_ -> []
)
@@ -311,14 +327,17 @@ join' = foldl' merge (J.Object JM.empty)
joinUnsafe :: [J.Value] -> J.Value
joinUnsafe = foldl' mergeUnsafe (J.Object JM.empty)
-where_ :: WhereClauses -> [[Record J.Value]] -> [[Record J.Value]]
-where_ ws vss = filter (satisfies ws) vss
+where_ :: Maybe WhereClause -> [[Record J.Value]] -> [[Record J.Value]]
+where_ w = filter (satisfies w)
-satisfies :: WhereClauses -> [Record J.Value] -> Bool
-satisfies ws vs = all (\w -> satisfy w vs) ws
+satisfies :: Maybe WhereClause -> [Record 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 p)) vs = satisfy p vs
-satisfy :: WhereClause -> [Record J.Value] -> Bool
-satisfy (Eq f f') vs = unique f vs == unique f' vs
+satisfy :: Comparison -> [Record J.Value] -> Bool
+satisfy (Eq f g) vs = unique f vs == unique g vs
data DuplicateField' = DuplicateField'
deriving (Show)
--
cgit v1.2.3