{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
-- | Union types describing JSON objects, and operations for querying these types.
module Data.Aeson.AutoType.Type(typeSize,
                                Dict(..), keys, get, withDict,
                                Type(..), emptyType,
                                isSimple, isArray, isObject, typeAsSet,
                                hasNonTopTObj,
                                hasTObj,
                                isNullable,
                                emptySetLikes
  ) where

import           Prelude             hiding (any)
import qualified Data.HashMap.Strict as Hash
import qualified Data.Set            as Set
import           Data.Data          (Data(..))
import           Data.Typeable      (Typeable)
import           Data.Foldable      (any)
import           Data.Text          (Text)
import           Data.Set           (Set )
import           Data.HashMap.Strict(HashMap)
import           Data.List          (sort)
import           Data.Ord           (comparing)
import           Data.Generics.Uniplate
import           Text.PrettyPrint.GenericPretty

import           Data.Aeson.AutoType.Pretty ()

-- * Dictionary types for overloading of usual class instances.
-- | Type alias for HashMap
type Map = HashMap

-- | Dictionary of types indexed by names.
newtype Dict = Dict { Dict -> Map Text Type
unDict :: Map Text Type }
  deriving (Dict -> Dict -> Bool
(Dict -> Dict -> Bool) -> (Dict -> Dict -> Bool) -> Eq Dict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dict -> Dict -> Bool
$c/= :: Dict -> Dict -> Bool
== :: Dict -> Dict -> Bool
$c== :: Dict -> Dict -> Bool
Eq, Typeable Dict
DataType
Constr
Typeable Dict =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Dict -> c Dict)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Dict)
-> (Dict -> Constr)
-> (Dict -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Dict))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dict))
-> ((forall b. Data b => b -> b) -> Dict -> Dict)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r)
-> (forall u. (forall d. Data d => d -> u) -> Dict -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Dict -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Dict -> m Dict)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dict -> m Dict)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Dict -> m Dict)
-> Data Dict
Dict -> DataType
Dict -> Constr
(forall b. Data b => b -> b) -> Dict -> Dict
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dict -> c Dict
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dict
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Dict -> u
forall u. (forall d. Data d => d -> u) -> Dict -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dict -> m Dict
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dict -> m Dict
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dict
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dict -> c Dict
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dict)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dict)
$cDict :: Constr
$tDict :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Dict -> m Dict
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dict -> m Dict
gmapMp :: (forall d. Data d => d -> m d) -> Dict -> m Dict
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dict -> m Dict
gmapM :: (forall d. Data d => d -> m d) -> Dict -> m Dict
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dict -> m Dict
gmapQi :: Int -> (forall d. Data d => d -> u) -> Dict -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dict -> u
gmapQ :: (forall d. Data d => d -> u) -> Dict -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Dict -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dict -> r
gmapT :: (forall b. Data b => b -> b) -> Dict -> Dict
$cgmapT :: (forall b. Data b => b -> b) -> Dict -> Dict
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dict)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dict)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Dict)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dict)
dataTypeOf :: Dict -> DataType
$cdataTypeOf :: Dict -> DataType
toConstr :: Dict -> Constr
$ctoConstr :: Dict -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dict
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dict
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dict -> c Dict
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dict -> c Dict
$cp1Data :: Typeable Dict
Data, Typeable, (forall x. Dict -> Rep Dict x)
-> (forall x. Rep Dict x -> Dict) -> Generic Dict
forall x. Rep Dict x -> Dict
forall x. Dict -> Rep Dict x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dict x -> Dict
$cfrom :: forall x. Dict -> Rep Dict x
Generic)

instance Out Dict where
  doc :: Dict -> Doc
doc       = Map Text Type -> Doc
forall a. Out a => a -> Doc
doc       (Map Text Type -> Doc) -> (Dict -> Map Text Type) -> Dict -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict
  docPrec :: Int -> Dict -> Doc
docPrec p :: Int
p = Int -> Map Text Type -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
p (Map Text Type -> Doc) -> (Dict -> Map Text Type) -> Dict -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict

instance Show Dict where
  show :: Dict -> String
show = [(Text, Type)] -> String
forall a. Show a => a -> String
show ([(Text, Type)] -> String)
-> (Dict -> [(Text, Type)]) -> Dict -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Type)] -> [(Text, Type)]
forall a. Ord a => [a] -> [a]
sort ([(Text, Type)] -> [(Text, Type)])
-> (Dict -> [(Text, Type)]) -> Dict -> [(Text, Type)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Type -> [(Text, Type)]
forall k v. HashMap k v -> [(k, v)]
Hash.toList (Map Text Type -> [(Text, Type)])
-> (Dict -> Map Text Type) -> Dict -> [(Text, Type)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict

instance Ord Dict where
  compare :: Dict -> Dict -> Ordering
compare = (Dict -> [(Text, Type)]) -> Dict -> Dict -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Dict -> [(Text, Type)]) -> Dict -> Dict -> Ordering)
-> (Dict -> [(Text, Type)]) -> Dict -> Dict -> Ordering
forall a b. (a -> b) -> a -> b
$ [(Text, Type)] -> [(Text, Type)]
forall a. Ord a => [a] -> [a]
sort ([(Text, Type)] -> [(Text, Type)])
-> (Dict -> [(Text, Type)]) -> Dict -> [(Text, Type)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Type -> [(Text, Type)]
forall k v. HashMap k v -> [(k, v)]
Hash.toList (Map Text Type -> [(Text, Type)])
-> (Dict -> Map Text Type) -> Dict -> [(Text, Type)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict

-- | Make operation on a map to an operation on a Dict.
withDict :: (Map Text Type -> Map Text Type) -> Dict -> Dict
f :: Map Text Type -> Map Text Type
f withDict :: (Map Text Type -> Map Text Type) -> Dict -> Dict
`withDict` (Dict m :: Map Text Type
m) = Map Text Type -> Dict
Dict (Map Text Type -> Dict) -> Map Text Type -> Dict
forall a b. (a -> b) -> a -> b
$ Map Text Type -> Map Text Type
f Map Text Type
m

-- | Take all keys from dictionary.
keys :: Dict -> Set Text
keys :: Dict -> Set Text
keys = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> (Dict -> [Text]) -> Dict -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Type -> [Text]
forall k v. HashMap k v -> [k]
Hash.keys (Map Text Type -> [Text])
-> (Dict -> Map Text Type) -> Dict -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict

-- | Union types for JSON values.
data Type = TNull | TBool | TString        |
            TInt  | TDouble                |
            TUnion (Set      Type)         |
            TLabel  Text                   |
            TObj    Dict                   |
            TArray  Type
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show,Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord, Typeable Type
DataType
Constr
Typeable Type =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Type -> c Type)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Type)
-> (Type -> Constr)
-> (Type -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Type))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type))
-> ((forall b. Data b => b -> b) -> Type -> Type)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r)
-> (forall u. (forall d. Data d => d -> u) -> Type -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Type -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Type -> m Type)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Type -> m Type)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Type -> m Type)
-> Data Type
Type -> DataType
Type -> Constr
(forall b. Data b => b -> b) -> Type -> Type
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Type -> u
forall u. (forall d. Data d => d -> u) -> Type -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
$cTArray :: Constr
$cTObj :: Constr
$cTLabel :: Constr
$cTUnion :: Constr
$cTDouble :: Constr
$cTInt :: Constr
$cTString :: Constr
$cTBool :: Constr
$cTNull :: Constr
$tType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Type -> m Type
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapMp :: (forall d. Data d => d -> m d) -> Type -> m Type
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapM :: (forall d. Data d => d -> m d) -> Type -> m Type
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapQi :: Int -> (forall d. Data d => d -> u) -> Type -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Type -> u
gmapQ :: (forall d. Data d => d -> u) -> Type -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Type -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
gmapT :: (forall b. Data b => b -> b) -> Type -> Type
$cgmapT :: (forall b. Data b => b -> b) -> Type -> Type
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Type)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
dataTypeOf :: Type -> DataType
$cdataTypeOf :: Type -> DataType
toConstr :: Type -> Constr
$ctoConstr :: Type -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
$cp1Data :: Typeable Type
Data, Typeable, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic)

instance Out Type

-- These are missing Uniplate instances...
{-
instance Biplate (Set a) a where
  biplate s = (Set.toList s, Set.fromList)

instance Biplate (HashMap k v) v where
  biplate m = (Hash.elems m, Hash.fromList . zip (Hash.keys m))
 -}

instance Uniplate Type where
  uniplate :: UniplateType Type
uniplate (TUnion s :: Set Type
s) = (Set Type -> [Type]
forall a. Set a -> [a]
Set.toList Set Type
s, Set Type -> Type
TUnion (Set Type -> Type) -> ([Type] -> Set Type) -> [Type] -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.        [Type] -> Set Type
forall a. Ord a => [a] -> Set a
Set.fromList                     )
  uniplate (TObj   d :: Dict
d) = (Map Text Type -> [Type]
forall k v. HashMap k v -> [v]
Hash.elems Map Text Type
m, Dict -> Type
TObj   (Dict -> Type) -> ([Type] -> Dict) -> [Type] -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Type -> Dict
Dict (Map Text Type -> Dict)
-> ([Type] -> Map Text Type) -> [Type] -> Dict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Type)] -> Map Text Type
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Hash.fromList ([(Text, Type)] -> Map Text Type)
-> ([Type] -> [(Text, Type)]) -> [Type] -> Map Text Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Type] -> [(Text, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map Text Type -> [Text]
forall k v. HashMap k v -> [k]
Hash.keys Map Text Type
m))
    where
      m :: Map Text Type
m = Dict -> Map Text Type
unDict Dict
d
  uniplate (TArray t :: Type
t) = ([Type
t],          Type -> Type
TArray (Type -> Type) -> ([Type] -> Type) -> [Type] -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> Type
forall a. [a] -> a
head  )
  uniplate s :: Type
s          = ([],           Type -> [Type] -> Type
forall a b. a -> b -> a
const Type
s        )

-- | Empty type
emptyType :: Type
emptyType :: Type
emptyType = Set Type -> Type
TUnion Set Type
forall a. Set a
Set.empty

-- | Lookup the Type within the dictionary.
get :: Text -> Dict -> Type
get :: Text -> Dict -> Type
get key :: Text
key = Type -> Text -> Map Text Type -> Type
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
Hash.lookupDefault Type
TNull Text
key (Map Text Type -> Type) -> (Dict -> Map Text Type) -> Dict -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict

-- $derive makeUniplateDirect ''Type

-- | Size of the `Type` term.
typeSize           :: Type -> Int
typeSize :: Type -> Int
typeSize TNull      = 1
typeSize TBool      = 1
typeSize TString    = 1
typeSize TInt       = 1
typeSize TDouble    = 1
typeSize (TObj   o :: Dict
o) = (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Dict -> Int) -> Dict -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum     ([Int] -> Int) -> (Dict -> [Int]) -> Dict -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Int) -> [Type] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Int
typeSize ([Type] -> [Int]) -> (Dict -> [Type]) -> Dict -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Type -> [Type]
forall k v. HashMap k v -> [v]
Hash.elems (Map Text Type -> [Type])
-> (Dict -> Map Text Type) -> Dict -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict (Dict -> Int) -> Dict -> Int
forall a b. (a -> b) -> a -> b
$ Dict
o
typeSize (TArray a :: Type
a) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Type -> Int
typeSize Type
a
typeSize (TUnion u :: Set Type
u) = (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Set Type -> Int) -> Set Type -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Set Type -> [Int]) -> Set Type -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> (Set Type -> [Int]) -> Set Type -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Int) -> [Type] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Int
typeSize ([Type] -> [Int]) -> (Set Type -> [Type]) -> Set Type -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Type -> [Type]
forall a. Set a -> [a]
Set.toList (Set Type -> Int) -> Set Type -> Int
forall a b. (a -> b) -> a -> b
$ Set Type
u
typeSize (TLabel _) = String -> Int
forall a. HasCallStack => String -> a
error "Don't know how to compute typeSize of TLabel."

-- | Check if this is nullable (Maybe) type, or not.
-- Nullable type will always accept TNull or missing key that contains it.
isNullable :: Type -> Bool
isNullable :: Type -> Bool
isNullable  TNull     = Bool
True
isNullable (TUnion u :: Set Type
u) = Type -> Bool
isNullable (Type -> Bool) -> Set Type -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` Set Type
u
isNullable  _         = Bool
False

-- | "Null-ish" types
emptySetLikes ::  Set Type
emptySetLikes :: Set Type
emptySetLikes = [Type] -> Set Type
forall a. Ord a => [a] -> Set a
Set.fromList [Type
TNull, Type -> Type
TArray (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Set Type -> Type
TUnion (Set Type -> Type) -> Set Type -> Type
forall a b. (a -> b) -> a -> b
$ [Type] -> Set Type
forall a. Ord a => [a] -> Set a
Set.fromList []]
-- Q: and TObj $ Map.fromList []?
{-# INLINE emptySetLikes #-}

-- | Convert any type into union type (even if just singleton).
typeAsSet :: Type -> Set Type
typeAsSet :: Type -> Set Type
typeAsSet (TUnion s :: Set Type
s) = Set Type
s
typeAsSet t :: Type
t          = Type -> Set Type
forall a. a -> Set a
Set.singleton Type
t

-- | Is the top-level constructor a TObj?
isObject         :: Type -> Bool
isObject :: Type -> Bool
isObject (TObj _) = Bool
True
isObject _        = Bool
False

-- | Is it a simple (non-compound) Type?
isSimple  :: Type -> Bool
isSimple :: Type -> Bool
isSimple x :: Type
x = Bool -> Bool
not (Type -> Bool
isObject Type
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (Type -> Bool
isArray Type
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (Type -> Bool
isUnion Type
x)

-- | Is the top-level constructor a TUnion?
isUnion           :: Type -> Bool
isUnion :: Type -> Bool
isUnion (TUnion _) = Bool
True
isUnion _          = Bool
False

-- | Is the top-level constructor a TArray?
-- | Check if the given type has non-top TObj.
isArray           :: Type -> Bool
isArray :: Type -> Bool
isArray (TArray _) = Bool
True
isArray _          = Bool
False

-- | Check if the given type has non-top TObj.
hasNonTopTObj         :: Type -> Bool
hasNonTopTObj :: Type -> Bool
hasNonTopTObj (TObj o :: Dict
o) = (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
hasTObj ([Type] -> Bool) -> [Type] -> Bool
forall a b. (a -> b) -> a -> b
$ Map Text Type -> [Type]
forall k v. HashMap k v -> [v]
Hash.elems (Map Text Type -> [Type]) -> Map Text Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Dict -> Map Text Type
unDict Dict
o
hasNonTopTObj _        = Bool
False

-- | Check if the given type has TObj on top or within array..
hasTObj           :: Type -> Bool
hasTObj :: Type -> Bool
hasTObj (TObj   _) = Bool
True
hasTObj (TArray a :: Type
a) = Type -> Bool
hasTObj Type
a
hasTObj (TUnion u :: Set Type
u) = (Type -> Bool) -> Set Type -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
hasTObj Set Type
u
hasTObj _          = Bool
False