module Data.Aeson.AutoType.Type(typeSize,
Dict(..), keys, get, withDict,
Type(..), emptyType,
isSimple, isArray, isObject, typeAsSet,
hasNonTopTObj,
hasTObj) where
import qualified Data.HashMap.Strict as Hash
import qualified Data.Set as Set
import Data.Data (Data(..))
import Data.Typeable (Typeable)
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
import Text.PrettyPrint.GenericPretty
import qualified Data.Text as Text
import Data.Aeson.AutoType.Pretty
type Map = HashMap
newtype Dict = Dict { unDict :: Map Text Type }
deriving (Eq, Data, Typeable, Generic)
instance Out Dict where
doc = doc . unDict
docPrec p = docPrec p . unDict
instance Show Dict where
show = show . sort . Hash.toList . unDict
instance Ord Dict where
compare = comparing $ sort . Hash.toList . unDict
withDict :: (Map Text Type -> Map Text Type) -> Dict -> Dict
f `withDict` (Dict m) = Dict $ f m
keys :: Dict -> Set Text
keys = Set.fromList . Hash.keys . unDict
data Type = TNull | TBool | TNum | TString |
TUnion (Set Type) |
TLabel Text |
TObj Dict |
TArray Type
deriving (Show,Eq, Ord, Data, Typeable, Generic)
instance Out Type
instance Uniplate Type where
uniplate (TUnion s) = (Set.toList s, TUnion . Set.fromList )
uniplate (TObj d) = (Hash.elems m, TObj . Dict . Hash.fromList . zip (Hash.keys m))
where
m = unDict d
uniplate (TArray t) = ([t], TArray . head )
uniplate s = ([], const s )
emptyType :: Type
emptyType = TUnion Set.empty
get :: Text -> Dict -> Type
get key = Hash.lookupDefault emptyType key . unDict
typeSize :: Type -> Int
typeSize TNull = 1
typeSize TBool = 1
typeSize TNum = 1
typeSize TString = 1
typeSize (TObj o) = (1+) . sum . map typeSize . Hash.elems . unDict $ o
typeSize (TArray a) = 1 + typeSize a
typeSize (TUnion u) = (1+) . maximum . (0:) . map typeSize . Set.toList $ u
typeSize (TLabel _) = error "Don't know how to compute typeSize of TLabel."
typeAsSet :: Type -> Set Type
typeAsSet (TUnion s) = s
typeAsSet t = Set.singleton t
hasTObj, hasNonTopTObj, isArray, isUnion, isSimple, isObject :: Type -> Bool
isObject (TObj _) = True
isObject _ = False
isSimple x = not (isObject x) && not (isArray x) && not (isUnion x)
isUnion (TUnion _) = True
isUnion _ = False
isArray (TArray _) = True
isArray _ = False
hasNonTopTObj (TObj o) = any hasTObj $ Hash.elems $ unDict o
hasNonTopTObj _ = False
hasTObj (TObj _) = True
hasTObj (TArray a) = hasTObj a
hasTObj (TUnion u) = setAny u
where
setAny = Set.foldr ((||) . hasTObj) False
hasTObj _ = False