-- | An abstraction for representing type constructors. This is a very
-- simplified version of `Data.Typeable`, which we don't use directly
-- to avoid compatibility headaches.
module Data.GI.CodeGen.Type
    ( Type(..)  -- Reexported for convenience.
    , BasicType(..)

    , TypeRep

    , con
    , con0

    , typeShow
    , typeConName

    , io
    , ptr
    , funptr
    , maybeT
    ) where

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import Data.Text (Text)

import Data.GI.GIR.BasicTypes (Type(..), BasicType(..))

-- | A fully applied type.
data TypeRep = TypeRep { TypeRep -> TypeCon
typeCon     :: TypeCon
                       , TypeRep -> [TypeRep]
typeConArgs :: [TypeRep]
                       } deriving (TypeRep -> TypeRep -> Bool
(TypeRep -> TypeRep -> Bool)
-> (TypeRep -> TypeRep -> Bool) -> Eq TypeRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeRep -> TypeRep -> Bool
$c/= :: TypeRep -> TypeRep -> Bool
== :: TypeRep -> TypeRep -> Bool
$c== :: TypeRep -> TypeRep -> Bool
Eq)

-- | A type constructor. We single out some specific constructors
-- since they have special syntax in their Haskell representation.
data TypeCon = TupleCon
             | ListCon
             | TextualCon Text
  deriving (TypeCon -> TypeCon -> Bool
(TypeCon -> TypeCon -> Bool)
-> (TypeCon -> TypeCon -> Bool) -> Eq TypeCon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeCon -> TypeCon -> Bool
$c/= :: TypeCon -> TypeCon -> Bool
== :: TypeCon -> TypeCon -> Bool
$c== :: TypeCon -> TypeCon -> Bool
Eq)

-- | Give a valid Haskell source representation of the given
-- `TypeRep`.
typeShow :: TypeRep -> Text
typeShow :: TypeRep -> Text
typeShow (TypeRep TypeCon
TupleCon [TypeRep]
args) =
  Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((TypeRep -> Text) -> [TypeRep] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TypeRep -> Text
typeShow [TypeRep]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
typeShow (TypeRep TypeCon
ListCon [TypeRep]
args) =
  Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((TypeRep -> Text) -> [TypeRep] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TypeRep -> Text
typeShow [TypeRep]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
typeShow (TypeRep (TextualCon Text
con) [TypeRep]
args) =
  Text -> [Text] -> Text
T.intercalate Text
" " (Text
con Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (TypeRep -> Text) -> [TypeRep] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
parenthesize (Text -> Text) -> (TypeRep -> Text) -> TypeRep -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> Text
typeShow) [TypeRep]
args)
  where parenthesize :: Text -> Text
        parenthesize :: Text -> Text
parenthesize Text
s = if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
s
                         then Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                         else Text
s

-- | Return a textual representation of the type constructor for the
-- given `TypeRep`.
typeConName :: TypeRep -> Text
typeConName :: TypeRep -> Text
typeConName (TypeRep TypeCon
TupleCon [TypeRep]
_) = Text
"(,)"
typeConName (TypeRep TypeCon
ListCon [TypeRep]
_) = Text
"[,]"
typeConName (TypeRep (TextualCon Text
s) [TypeRep]
_) = Text
s

-- | Type constructor applied to the given types.
con :: Text -> [TypeRep] -> TypeRep
con :: Text -> [TypeRep] -> TypeRep
con Text
"[]" [TypeRep]
xs = TypeRep :: TypeCon -> [TypeRep] -> TypeRep
TypeRep {typeCon :: TypeCon
typeCon = TypeCon
ListCon, typeConArgs :: [TypeRep]
typeConArgs = [TypeRep]
xs }
con Text
"(,)" [TypeRep]
xs = TypeRep :: TypeCon -> [TypeRep] -> TypeRep
TypeRep {typeCon :: TypeCon
typeCon = TypeCon
TupleCon, typeConArgs :: [TypeRep]
typeConArgs = [TypeRep]
xs }
con Text
s [TypeRep]
xs = TypeRep :: TypeCon -> [TypeRep] -> TypeRep
TypeRep {typeCon :: TypeCon
typeCon = Text -> TypeCon
TextualCon Text
s, typeConArgs :: [TypeRep]
typeConArgs = [TypeRep]
xs}

-- | A shorthand for a type constructor taking no arguments.
con0 :: Text -> TypeRep
con0 :: Text -> TypeRep
con0 Text
c = Text -> [TypeRep] -> TypeRep
con Text
c []

-- | Embed in the `IO` monad.
io :: TypeRep -> TypeRep
io :: TypeRep -> TypeRep
io TypeRep
t = Text
"IO" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
t]

-- | A `Ptr` to the type.
ptr :: TypeRep -> TypeRep
ptr :: TypeRep -> TypeRep
ptr TypeRep
t = Text
"Ptr" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
t]

-- | A `FunPtr` to the type.
funptr :: TypeRep -> TypeRep
funptr :: TypeRep -> TypeRep
funptr TypeRep
t = Text
"FunPtr" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
t]

-- | Embed in the `Maybe` monad.
maybeT :: TypeRep -> TypeRep
maybeT :: TypeRep -> TypeRep
maybeT TypeRep
t = Text
"Maybe" Text -> [TypeRep] -> TypeRep
`con` [TypeRep
t]