support qualified fields

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')