-- | 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 TupleCon args :: [TypeRep]
args) =
  "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate ", " ((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
<> ")"
typeShow (TypeRep ListCon args :: [TypeRep]
args) =
  "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate ", " ((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
<> "]"
typeShow (TypeRep (TextualCon con :: Text
con) args :: [TypeRep]
args) =
  Text -> [Text] -> Text
T.intercalate " " (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 s :: Text
s = if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') Text
s
                         then "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                         else Text
s

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

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

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

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

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

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