blob: 3747dabe526ac99b4b66be4f597bff62bebaf5cd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Exception (Exception, throw)
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as JK
import Data.Aeson.KeyMap qualified as JM
import Data.ByteString.Lazy.Char8 qualified as LB
import Data.List (foldl')
import Data.Maybe (fromMaybe, mapMaybe)
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.FilePath (takeExtension, (</>))
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P
import Text.Megaparsec.Char.Lexer qualified as P
import Text.Printf (printf)
debug :: Show a => String -> a -> a
debug s x = trace (printf "%s: %s" s (show x)) x
main = do
-- query "SELECT . FROM c"
query' $ Select ["."] "./data/c" [] []
putStrLn ""
-- query "SELECT id FROM c"
query' $ Select ["id"] "./data/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"]
data Query
= Select [Field] Collection Join Where
type Field = T.Text
type Collection = FilePath
type Join = [FilePath]
type Where = [Cmp]
data Cmp
= Eq Field Field
{-
instance IsString Query where
fromString =
either throw id (P.parse parser "" s)-}
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
pure $ map (select fs) $ where_ ws $ combine c' js'
combine c = combine' (map (: []) c)
where
combine' cs [] = cs
combine' cs (js : jss) = combine' [c ++ [j] | c <- cs, j <- js] jss
ls :: FilePath -> IO [FilePath]
ls =
fmap (filter ((== ".json") . takeExtension)) . listDirectory
data DecodeException = DecodeException
deriving (Show)
instance Exception DecodeException
decodeFile :: J.FromJSON a => FilePath -> IO a
decodeFile =
fmap (fromMaybe (throw DecodeException)) . J.decodeFileStrict
select :: [T.Text] -> [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)
join' :: [J.Value] -> J.Value
join' vs = foldl' merge (J.Object JM.empty) vs
where_ :: Where -> [[J.Value]] -> [[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
data DuplicateField' = DuplicateField'
deriving (Show)
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
(_ : _) -> throw DuplicateField'
get :: T.Text -> J.Value -> Maybe J.Value
get f (J.Object kvs) = JM.lookup (JK.fromText f) kvs
data DuplicateField = DuplicateField
deriving (Show)
instance Exception DuplicateField
merge :: J.Value -> J.Value -> J.Value
merge (J.Object kvs) (J.Object kvs') =
case disjoint kvs kvs' of
True -> J.Object (JM.union kvs kvs')
False -> throw DuplicateField
disjoint kvs kvs' =
let ks = S.fromList (JM.keys kvs)
ks' = S.fromList (JM.keys kvs')
in S.size ks + S.size ks' == S.size (ks `S.union` ks')
query' :: Query -> IO ()
query' q = mapM_ (LB.putStrLn . J.encode) =<< query q
|
