diff options
| -rw-r--r-- | app/Main.hs | 75 |
1 files changed, 55 insertions, 20 deletions
diff --git a/app/Main.hs b/app/Main.hs index 3747dab..d650a33 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -13,7 +13,7 @@ import Data.Set qualified as S import Data.String (IsString (fromString)) import Data.Text qualified as T import Debug.Trace (trace) -import System.Directory (listDirectory) +import System.Directory (listDirectory, setCurrentDirectory) import System.FilePath (takeExtension, (</>)) import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as P @@ -24,19 +24,33 @@ debug :: Show a => String -> a -> a debug s x = trace (printf "%s: %s" s (show x)) x main = do + setCurrentDirectory "./data" -- query "SELECT . FROM c" - query' $ Select ["."] "./data/c" [] [] + query' $ Select [Unqualified "."] "c" [] [] putStrLn "" -- query "SELECT id FROM c" - query' $ Select ["id"] "./data/c" [] [] + query' $ Select [Qualified "c" "id"] "c" [] [] putStrLn "" -- query "SELECT c.id, j.id, is_j FROM c JOIN j WHERE j.id == c.j_id" - query' $ Select ["c.id", "j.id", "is_j"] "./data/c" ["./data/j"] [Eq "j.id" "c.j_id"] + query' $ + Select + [ Qualified "c" "id", + Qualified "j" "id", + Unqualified "is_j" + ] + "c" + ["j"] + [ Eq (Qualified "j" "id") (Qualified "c" "j_id") + ] data Query = Select [Field] Collection Join Where + deriving (Show) -type Field = T.Text +data Field + = Qualified FilePath T.Text + | Unqualified T.Text + deriving (Show) type Collection = FilePath @@ -46,6 +60,11 @@ type Where = [Cmp] data Cmp = Eq Field Field + deriving (Show) + +data Record a + = Record FilePath a + deriving (Show, Eq) {- instance IsString Query where @@ -54,8 +73,8 @@ instance IsString Query where query :: Query -> IO [J.Value] query (Select fs c js ws) = do - c' <- mapM (decodeFile . (c </>)) =<< ls c - js' <- mapM (\j -> mapM (decodeFile . (j </>)) =<< ls j) js + c' <- mapM (fmap (Record c) . decodeFile . (c </>)) =<< ls c + js' <- mapM (\j -> mapM (fmap (Record j) . decodeFile . (j </>)) =<< ls j) js pure $ map (select fs) $ where_ ws $ combine c' js' combine c = combine' (map (: []) c) @@ -76,18 +95,29 @@ decodeFile :: J.FromJSON a => FilePath -> IO a decodeFile = fmap (fromMaybe (throw DecodeException)) . J.decodeFileStrict -select :: [T.Text] -> [J.Value] -> J.Value +select :: [Field] -> [Record J.Value] -> J.Value select fs vs = join' $ map (select' fs) vs -select' :: [T.Text] -> J.Value -> J.Value -select' ["."] (J.Object kvs) = J.Object kvs -select' fs (J.Object kvs) = - J.Object (JM.filterWithKey (\k _ -> JK.toText k `elem` fs) kvs) +select' :: [Field] -> Record J.Value -> Record J.Value +select' [Unqualified "."] v = v +select' fs (Record c (J.Object kvs)) = + Record c . J.Object $ + JM.fromList . mapMaybe match . JM.toList $ + kvs + where + match (k, v) = case filter (matches (Record c (JK.toText k))) fs of + (Qualified _ _ : _) -> Just (JK.fromString (c <> "." <> JK.toString k), v) + (Unqualified _ : _) -> Just (k, v) + _ -> Nothing + +matches :: Record T.Text -> Field -> Bool +matches (Record c k) (Qualified c' k') = c == c' && k == k' +matches (Record _ k) (Unqualified k') = k == k' -join' :: [J.Value] -> J.Value -join' vs = foldl' merge (J.Object JM.empty) vs +join' :: [Record J.Value] -> J.Value +join' vs = foldl' merge (J.Object JM.empty) (map (\(Record _ v) -> v) vs) -where_ :: Where -> [[J.Value]] -> [[J.Value]] +where_ :: Where -> [[Record J.Value]] -> [[Record J.Value]] where_ ws vss = filter (\vs -> all (\w -> satisfy w vs) ws) vss where satisfy (Eq f f') vs = unique f vs == unique f' vs @@ -97,13 +127,17 @@ data DuplicateField' = DuplicateField' instance Exception DuplicateField' -unique :: T.Text -> [J.Value] -> J.Value -unique f as = case debug "unique" $ mapMaybe (get (debug "f" f)) (debug "as" as) of - [x] -> x +unique :: Field -> [Record J.Value] -> J.Value +unique f as = case mapMaybe (get f) as of + [Record _ v] -> v (_ : _) -> throw DuplicateField' -get :: T.Text -> J.Value -> Maybe J.Value -get f (J.Object kvs) = JM.lookup (JK.fromText f) kvs +get :: Field -> Record J.Value -> Maybe (Record J.Value) +get (Unqualified k) (Record c (J.Object kvs)) = + Record c <$> JM.lookup (JK.fromText k) kvs +get (Qualified c' k) (Record c (J.Object kvs)) + | c' == c = Record c <$> JM.lookup (JK.fromText k) kvs + | otherwise = Nothing data DuplicateField = DuplicateField deriving (Show) @@ -116,6 +150,7 @@ merge (J.Object kvs) (J.Object kvs') = True -> J.Object (JM.union kvs kvs') False -> throw DuplicateField +disjoint :: JM.KeyMap v -> JM.KeyMap v -> Bool disjoint kvs kvs' = let ks = S.fromList (JM.keys kvs) ks' = S.fromList (JM.keys kvs') |