module Text.JSONb.Schema where
import Data.Ord
import Data.Word
import Data.List (permutations)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Trie (Trie)
import qualified Data.Trie as Trie
import qualified Text.JSONb.Simple as Simple
data Schema counter
= Num
| Str
| Bool
| Null
| Obj (Props counter)
| Arr (Elements counter)
deriving instance (Eq counter) => Eq (Schema counter)
deriving instance (Ord counter) => Ord (Schema counter)
schema :: (Counter counter) => Simple.JSON -> Schema counter
schema json = case json of
Simple.Object trie -> Obj $ props trie
Simple.Array list -> Arr . Elements $ schemas list
Simple.String _ -> Str
Simple.Number _ -> Num
Simple.Boolean _ -> Bool
Simple.Null -> Null
props :: (Counter counter) => Trie.Trie Simple.JSON -> Props counter
props = Props . fmap (Set.singleton . schema)
schemas :: (Counter counter) => [Simple.JSON] -> [(counter, Schema counter)]
schemas json = foldr collate []
[ (bottom, schema e) | e <- json ]
collate
:: (Counter counter, Counter counter')
=> (counter, Schema counter')
-> [(counter, Schema counter')]
-> [(counter, Schema counter')]
collate s [] = [s]
collate (c0, Obj p0) ((c1, Obj p1):t)
| match p0 p1 = (c0 `plus` c1, Obj $ merge p0 p1):t
| otherwise = (c0, Obj p0):(c1, Obj p1):t
collate (c0, schema0) ((c1, schema1):t)
| schema0 == schema1 = (c0 `plus` c1, schema0):t
| otherwise = (c0, schema0):(c1, schema1):t
data Props counter = Props (Trie.Trie (Set.Set (Schema counter)))
deriving instance (Eq counter) => Eq (Props counter)
instance (Ord counter) => Ord (Props counter) where
compare (Props trie0) (Props trie1) = comparing Trie.toList trie0 trie1
merge
:: (Counter counter)
=> Props counter
-> Props counter
-> Props counter
merge (Props a) (Props b) = Props $ Trie.mergeBy ((Just .) . merge') a b
where
merge' = ((count_in . merge'' . count_out) .) . Set.union
where
count_out = fmap ((,) ()) . Set.toList
count_in = Set.fromList . fmap snd
merge'' [ ] = []
merge'' (h:t) = foldr collate' t (h:t)
where
collate' schema = shortest . fmap (collate schema) . permutations
shortest [ ] = []
shortest (h:t) = foldr shortest' h t
where
shortest' x h
| length h < length x = h
| otherwise = x
match
:: (Counter counter)
=> Props counter
-> Props counter
-> Bool
match (Props a) (Props b) = Trie.keys a == Trie.keys b
data Elements counter = Elements [(counter, Schema counter)]
deriving instance (Eq counter) => Eq (Elements counter)
deriving instance (Ord counter) => Ord (Elements counter)
data OneMany = One | Many
deriving instance Eq OneMany
deriving instance Ord OneMany
deriving instance Show OneMany
class (Eq t, Show t, Ord t) => Counter t where
bottom :: t
plus :: t -> t -> t
instance Counter OneMany where
bottom = One
plus _ _ = Many
instance Counter Word where
bottom = 1
plus = (+)
instance Counter () where
bottom = ()
plus _ _ = ()