{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Language.Bond.Syntax.Internal
( showPretty
, showQualifiedName
, takeName
, takeNamespace
, isBaseField
, metaField
, baseFields
) where
import Data.Monoid
import Language.Bond.Util
import Language.Bond.Syntax.Util
import Language.Bond.Syntax.Types
takeName :: QualifiedName -> String
takeName = last
takeNamespace :: QualifiedName -> QualifiedName
takeNamespace = subtract 1 . length >>= take
showQualifiedName :: QualifiedName -> String
showQualifiedName = sepBy "." id
showTypeParams :: [TypeParam] -> String
showTypeParams = angles . sepBy ", " showPretty
class ShowPretty a where
showPretty :: a -> String
instance ShowPretty Constraint where
showPretty Value = ": value"
instance ShowPretty TypeParam where
showPretty TypeParam {..} = paramName ++ optional showPretty paramConstraint
instance ShowPretty Declaration where
showPretty Struct {..} = "struct " ++ declName ++ showTypeParams declParams
showPretty Enum {..} = "enum " ++ declName
showPretty Forward {..} = "struct declaration " ++ declName ++ showTypeParams declParams
showPretty Alias {..} = "alias " ++ declName ++ showTypeParams declParams
showPretty Service {..} = "service " ++ declName ++ showTypeParams declParams
metaField :: Field -> Any
metaField Field {..} = Any $ isMetaName fieldType
isBaseField :: String -> Maybe Type -> Bool
isBaseField name = getAny . optional (foldMapFields (Any.(name==).fieldName))
baseFields :: Declaration -> Maybe [Field]
baseFields Struct{..} = foldMapFields return <$> structBase
baseFields _ = Nothing