{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeSynonymInstances       #-}


module Language.PureScript.Bridge.TypeInfo (
 TypeInfo (..)
 , PSType
 , HaskellType
 , mkTypeInfo
 , mkTypeInfo'
 , Language (..)
 , typePackage
 , typeModule
 , typeName
 , typeParameters
 , HasHaskType
 , haskType
 , flattenTypeInfo
) where


import           Control.Lens
import           Data.Proxy
import           Data.Text     (Text)
import qualified Data.Text     as T
import           Data.Typeable

data Language = Haskell | PureScript

-- | Basic info about a data type:
data TypeInfo (lang :: Language) = TypeInfo {
  -- | Hackage package
  forall (lang :: Language). TypeInfo lang -> Text
_typePackage    :: !Text
  -- | Full Module path
, forall (lang :: Language). TypeInfo lang -> Text
_typeModule     :: !Text
, forall (lang :: Language). TypeInfo lang -> Text
_typeName       :: !Text
, forall (lang :: Language). TypeInfo lang -> [TypeInfo lang]
_typeParameters :: ![TypeInfo lang]
} deriving (TypeInfo lang -> TypeInfo lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
/= :: TypeInfo lang -> TypeInfo lang -> Bool
$c/= :: forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
== :: TypeInfo lang -> TypeInfo lang -> Bool
$c== :: forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
Eq, TypeInfo lang -> TypeInfo lang -> Bool
TypeInfo lang -> TypeInfo lang -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (lang :: Language). Eq (TypeInfo lang)
forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
forall (lang :: Language).
TypeInfo lang -> TypeInfo lang -> Ordering
forall (lang :: Language).
TypeInfo lang -> TypeInfo lang -> TypeInfo lang
min :: TypeInfo lang -> TypeInfo lang -> TypeInfo lang
$cmin :: forall (lang :: Language).
TypeInfo lang -> TypeInfo lang -> TypeInfo lang
max :: TypeInfo lang -> TypeInfo lang -> TypeInfo lang
$cmax :: forall (lang :: Language).
TypeInfo lang -> TypeInfo lang -> TypeInfo lang
>= :: TypeInfo lang -> TypeInfo lang -> Bool
$c>= :: forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
> :: TypeInfo lang -> TypeInfo lang -> Bool
$c> :: forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
<= :: TypeInfo lang -> TypeInfo lang -> Bool
$c<= :: forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
< :: TypeInfo lang -> TypeInfo lang -> Bool
$c< :: forall (lang :: Language). TypeInfo lang -> TypeInfo lang -> Bool
compare :: TypeInfo lang -> TypeInfo lang -> Ordering
$ccompare :: forall (lang :: Language).
TypeInfo lang -> TypeInfo lang -> Ordering
Ord, Int -> TypeInfo lang -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (lang :: Language). Int -> TypeInfo lang -> ShowS
forall (lang :: Language). [TypeInfo lang] -> ShowS
forall (lang :: Language). TypeInfo lang -> String
showList :: [TypeInfo lang] -> ShowS
$cshowList :: forall (lang :: Language). [TypeInfo lang] -> ShowS
show :: TypeInfo lang -> String
$cshow :: forall (lang :: Language). TypeInfo lang -> String
showsPrec :: Int -> TypeInfo lang -> ShowS
$cshowsPrec :: forall (lang :: Language). Int -> TypeInfo lang -> ShowS
Show)

makeLenses ''TypeInfo

-- | For convenience:
type PSType = TypeInfo 'PureScript

-- | For convenience:
type HaskellType = TypeInfo 'Haskell


-- | Types that have a lens for accessing a 'TypeInfo Haskell'.
class HasHaskType t where
  haskType :: Lens' t HaskellType

-- | Simple 'id' instance: Get the 'TypeInfo' itself.
instance HasHaskType HaskellType where
  haskType :: Lens' HaskellType HaskellType
haskType HaskellType -> f HaskellType
inj = HaskellType -> f HaskellType
inj


mkTypeInfo :: Typeable t => Proxy t -> HaskellType
mkTypeInfo :: forall t. Typeable t => Proxy t -> HaskellType
mkTypeInfo = TypeRep -> HaskellType
mkTypeInfo' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep

mkTypeInfo' :: TypeRep -> HaskellType
mkTypeInfo' :: TypeRep -> HaskellType
mkTypeInfo' TypeRep
rep = let
    con :: TyCon
con = TypeRep -> TyCon
typeRepTyCon TypeRep
rep
  in TypeInfo {
    _typePackage :: Text
_typePackage = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConPackage TyCon
con
  , _typeModule :: Text
_typeModule = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConModule TyCon
con
  , _typeName :: Text
_typeName = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConName TyCon
con
  , _typeParameters :: [HaskellType]
_typeParameters = forall a b. (a -> b) -> [a] -> [b]
map TypeRep -> HaskellType
mkTypeInfo' (TypeRep -> [TypeRep]
typeRepArgs TypeRep
rep)
  }

-- | Put the TypeInfo in a list together with all its '_typeParameters' (recursively)
flattenTypeInfo :: TypeInfo lang -> [TypeInfo lang]
flattenTypeInfo :: forall (lang :: Language). TypeInfo lang -> [TypeInfo lang]
flattenTypeInfo TypeInfo lang
t = TypeInfo lang
t forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (lang :: Language). TypeInfo lang -> [TypeInfo lang]
flattenTypeInfo (forall (lang :: Language). TypeInfo lang -> [TypeInfo lang]
_typeParameters TypeInfo lang
t)