diff options
Diffstat (limited to 'app/Main.hs')
-rw-r--r-- | app/Main.hs | 47 |
1 files changed, 24 insertions, 23 deletions
diff --git a/app/Main.hs b/app/Main.hs index dfee5e0..5ce4dd0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -40,7 +40,8 @@ main = do ] ) "c" - [ LeftJoin + [ JoinClause + JoinLeft "j" [ Eq (Qualified "j" "id") (Qualified "c" "j_id") ] @@ -56,7 +57,8 @@ main = do ] ) "c" - [ RightJoin + [ JoinClause + JoinRight "j" [ Eq (Qualified "j" "id") (Qualified "c" "j_id") ] @@ -72,7 +74,8 @@ main = do ] ) "c" - [ FullJoin + [ JoinClause + JoinFull "j" [ Eq (Qualified "j" "id") (Qualified "c" "j_id") ] @@ -80,7 +83,7 @@ main = do [] data Query - = Select FieldSelector Collection [Join FilePath] WhereClauses + = Select FieldSelector Collection (JoinClauses FilePath) WhereClauses deriving (Show) data FieldSelector @@ -95,10 +98,16 @@ data Field type Collection = FilePath -data Join a - = LeftJoin a WhereClauses - | RightJoin a WhereClauses - | FullJoin a WhereClauses +type JoinClauses a = [JoinClause a] + +data JoinClause a + = JoinClause JoinType a WhereClauses + deriving (Show) + +data JoinType + = JoinLeft + | JoinRight + | JoinFull deriving (Show) type WhereClauses = [WhereClause] @@ -122,17 +131,9 @@ query (Select fs c js ws) = do 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 - RightJoin c ws -> - 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 + ( \(JoinClause t c ws) -> + fmap (\j' -> JoinClause t (map (Record c) j') ws) . mapM (decodeFile . (c </>)) + =<< ls c ) js pure $ map (select fs) $ where_ ws $ combine c' js' @@ -142,11 +143,11 @@ query (Select fs c js ws) = do <$> S.withStore "." "HEAD" do S.listDirectory c -combine :: [Record J.Value] -> [Join [Record J.Value]] -> [[Record J.Value]] +combine :: [Record J.Value] -> JoinClauses [Record J.Value] -> [[Record J.Value]] combine vs js = combine' (map (: []) vs) js where combine' vss [] = vss - combine' vss (LeftJoin js ws : jss) = + combine' vss (JoinClause JoinLeft js ws : jss) = combine' ( concatMap ( \vs -> case filter (satisfies ws) $ map (\j -> vs ++ [j]) js of @@ -156,7 +157,7 @@ combine vs js = combine' (map (: []) vs) js vss ) jss - combine' vss (RightJoin js ws : jss) = + combine' vss (JoinClause JoinRight js ws : jss) = combine' ( concatMap ( \j -> case filter (satisfies ws) $ map (\vs -> vs ++ [j]) vss of @@ -166,7 +167,7 @@ combine vs js = combine' (map (: []) vs) js js ) jss - combine' vss (FullJoin js ws : jss) = + combine' vss (JoinClause JoinFull js ws : jss) = combine' ( concatMap ( \vs -> case filter (satisfies ws) $ map (\j -> vs ++ [j]) js of |