diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 101 |
1 files changed, 60 insertions, 41 deletions
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) |