module Language.Bond.Syntax.Util
(
isScalar
, isUnsigned
, isSigned
, isFloat
, isString
, isContainer
, isList
, isAssociative
, isNullable
, isStruct
, isEnum
, isMetaName
, fmapType
, foldMapFields
, foldMapStructFields
, foldMapType
, resolveAlias
) where
import Data.Maybe
import Data.List
import qualified Data.Foldable as F
import Data.Monoid
import Prelude
import Language.Bond.Util
import Language.Bond.Syntax.Types
isScalar :: Type -> Bool
isScalar BT_Int8 = True
isScalar BT_Int16 = True
isScalar BT_Int32 = True
isScalar BT_Int64 = True
isScalar BT_UInt8 = True
isScalar BT_UInt16 = True
isScalar BT_UInt32 = True
isScalar BT_UInt64 = True
isScalar BT_Float = True
isScalar BT_Double = True
isScalar BT_Bool = True
isScalar (BT_TypeParam (TypeParam _ (Just Value))) = True
isScalar (BT_UserDefined Enum {..} _) = True
isScalar (BT_UserDefined a@Alias {} args) = isScalar $ resolveAlias a args
isScalar _ = False
isUnsigned :: Type -> Bool
isUnsigned BT_UInt8 = True
isUnsigned BT_UInt16 = True
isUnsigned BT_UInt32 = True
isUnsigned BT_UInt64 = True
isUnsigned (BT_UserDefined a@Alias {} args) = isUnsigned $ resolveAlias a args
isUnsigned _ = False
isSigned :: Type -> Bool
isSigned BT_Int8 = True
isSigned BT_Int16 = True
isSigned BT_Int32 = True
isSigned BT_Int64 = True
isSigned (BT_UserDefined a@Alias {} args) = isSigned $ resolveAlias a args
isSigned _ = False
isFloat :: Type -> Bool
isFloat BT_Float = True
isFloat BT_Double = True
isFloat (BT_UserDefined a@Alias {} args) = isFloat $ resolveAlias a args
isFloat _ = False
isMetaName :: Type -> Bool
isMetaName BT_MetaName = True
isMetaName BT_MetaFullName = True
isMetaName (BT_UserDefined a@Alias {} args) = isMetaName $ resolveAlias a args
isMetaName _ = False
isString :: Type -> Bool
isString BT_String = True
isString BT_WString = True
isString (BT_UserDefined a@Alias {} args) = isString $ resolveAlias a args
isString _ = False
isList :: Type -> Bool
isList (BT_List _) = True
isList (BT_Vector _) = True
isList (BT_UserDefined a@Alias {} args) = isList $ resolveAlias a args
isList _ = False
isAssociative :: Type -> Bool
isAssociative (BT_Set _) = True
isAssociative (BT_Map _ _) = True
isAssociative (BT_UserDefined a@Alias {} args) = isAssociative $ resolveAlias a args
isAssociative _ = False
isContainer :: Type -> Bool
isContainer f = isList f || isAssociative f
isStruct :: Type -> Bool
isStruct (BT_UserDefined Struct {} _) = True
isStruct (BT_UserDefined Forward {} _) = True
isStruct (BT_UserDefined a@Alias {} args) = isStruct $ resolveAlias a args
isStruct _ = False
isEnum :: Type -> Bool
isEnum (BT_UserDefined Enum {} _) = True
isEnum (BT_UserDefined a@Alias {} args) = isEnum $ resolveAlias a args
isEnum _ = False
isNullable :: Type -> Bool
isNullable (BT_Nullable _) = True
isNullable (BT_UserDefined a@Alias {} args) = isNullable $ resolveAlias a args
isNullable _ = False
fmapType :: (Type -> Type) -> Type -> Type
fmapType f (BT_UserDefined decl args) = f $ BT_UserDefined decl $ map (fmapType f) args
fmapType f (BT_Maybe element) = f $ BT_Maybe $ fmapType f element
fmapType f (BT_Map key value) = f $ BT_Map (fmapType f key) (fmapType f value)
fmapType f (BT_List element) = f $ BT_List $ fmapType f element
fmapType f (BT_Vector element) = f $ BT_Vector $ fmapType f element
fmapType f (BT_Set element) = f $ BT_Set $ fmapType f element
fmapType f (BT_Nullable element) = f $ BT_Nullable $ fmapType f element
fmapType f (BT_Bonded struct) = f $ BT_Bonded $ fmapType f struct
fmapType f x = f x
foldMapFields :: (Monoid m) => (Field -> m) -> Type -> m
foldMapFields f t = case t of
(BT_UserDefined Struct {..} _) -> optional (foldMapFields f) structBase <> F.foldMap f structFields
(BT_UserDefined a@Alias {..} args) -> foldMapFields f $ resolveAlias a args
_ -> mempty
foldMapStructFields :: Monoid m => (Field -> m) -> Declaration -> m
foldMapStructFields f s = foldMapFields f $ BT_UserDefined s []
foldMapType :: (Monoid m) => (Type -> m) -> Type -> m
foldMapType f t@(BT_UserDefined a@Alias {} args) = f t <> foldMapType f (resolveAlias a args)
foldMapType f t@(BT_UserDefined _ args) = f t <> F.foldMap (foldMapType f) args
foldMapType f t@(BT_Maybe element) = f t <> foldMapType f element
foldMapType f t@(BT_Map key value) = f t <> foldMapType f key <> foldMapType f value
foldMapType f t@(BT_List element) = f t <> foldMapType f element
foldMapType f t@(BT_Vector element) = f t <> foldMapType f element
foldMapType f t@(BT_Set element) = f t <> foldMapType f element
foldMapType f t@(BT_Nullable element) = f t <> foldMapType f element
foldMapType f t@(BT_Bonded struct) = f t <> foldMapType f struct
foldMapType f x = f x
resolveAlias :: Declaration -> [Type] -> Type
resolveAlias Alias {..} args = fmapType resolveParam aliasType
where
resolveParam (BT_TypeParam param) = snd.fromJust $ find ((param ==).fst) paramsArgs
resolveParam x = x
paramsArgs = zip declParams args
resolveAlias _ _ = error "resolveAlias: impossible happened."