module DDC.Core.Flow.Prim.TyConFlow
        ( TyConFlow      (..)
        , readTyConFlow
        , kindTyConFlow

          -- * Predicates
        , isRateNatType
        , isSeriesType
        , isRefType
        , isVectorType
        , isRateVecType
        , isBufferType
        , isProcessType

          -- * Compounds
        , tTuple1
        , tTuple2
        , tTupleN
        , tVector
        , tBuffer
        , tRateVec
        , tSeries
        , tSegd
        , tSel1
        , tSel2
        , tRef
        , tWorld
        , tRateNat
        , tRateAppend
        , tRateCross
        , tDown
        , tTail
        , tProcess
        , tResize)
where
import DDC.Core.Flow.Prim.KiConFlow
import DDC.Core.Flow.Prim.Base
import DDC.Core.Exp.Simple.Compounds
import DDC.Core.Exp.Simple.Exp
import DDC.Base.Pretty
import Control.DeepSeq
import Data.Char
import Data.List


instance NFData TyConFlow where
 rnf !_ = ()


instance Pretty TyConFlow where
 ppr dc
  = case dc of
        TyConFlowTuple n        -> text "Tuple"   <> int n <> text "#"
        TyConFlowBuffer         -> text "Buffer#"
        TyConFlowVector         -> text "Vector#"
        TyConFlowRateVec        -> text "RateVec#"
        TyConFlowSeries         -> text "Series#"
        TyConFlowSegd           -> text "Segd#"
        TyConFlowSel n          -> text "Sel"     <> int n <> text "#"
        TyConFlowRef            -> text "Ref#"
        TyConFlowWorld          -> text "World#"
        TyConFlowRateNat        -> text "RateNat#"
        TyConFlowRateCross      -> text "RateCross#"
        TyConFlowRateAppend     -> text "RateAppend#"
        TyConFlowDown n         -> text "Down"    <> int n <> text "#"
        TyConFlowTail n         -> text "Tail"    <> int n <> text "#"
        TyConFlowProcess        -> text "Process#"
        TyConFlowResize         -> text "Resize#"


-- | Read a type constructor name.
readTyConFlow :: String -> Maybe TyConFlow
readTyConFlow str
        | Just rest     <- stripPrefix "Tuple" str
        , (ds, "#")     <- span isDigit rest
        , not $ null ds
        , arity         <- read ds
        = Just $ TyConFlowTuple arity

        | Just rest     <- stripPrefix "Down" str
        , (ds, "#")     <- span isDigit rest
        , not $ null ds
        , n             <- read ds
        = Just $ TyConFlowDown n

        | Just rest     <- stripPrefix "Tail" str
        , (ds, "#")     <- span isDigit rest
        , not $ null ds
        , n             <- read ds
        = Just $ TyConFlowTail n

        | otherwise
        = case str of
                "Buffer#"       -> Just $ TyConFlowBuffer
                "Vector#"       -> Just $ TyConFlowVector
                "RateVec#"      -> Just $ TyConFlowRateVec
                "Series#"       -> Just $ TyConFlowSeries
                "Segd#"         -> Just $ TyConFlowSegd
                "Sel1#"         -> Just $ TyConFlowSel 1
                "Ref#"          -> Just $ TyConFlowRef
                "World#"        -> Just $ TyConFlowWorld
                "RateNat#"      -> Just $ TyConFlowRateNat
                "RateCross#"    -> Just $ TyConFlowRateCross
                "RateAppend#"   -> Just $ TyConFlowRateAppend
                "Process#"      -> Just $ TyConFlowProcess
                "Resize#"       -> Just $ TyConFlowResize
                _               -> Nothing


-- Kinds ----------------------------------------------------------------------
-- | Yield the kind of a primitive type constructor.
kindTyConFlow :: TyConFlow -> Kind Name
kindTyConFlow tc
 = case tc of
        TyConFlowTuple n        -> foldr kFun kData (replicate n kData)
        TyConFlowBuffer         -> kData `kFun` kData
        TyConFlowVector         ->              kData `kFun` kData
        TyConFlowRateVec        -> kRate `kFun` kData `kFun` kData
        TyConFlowSeries         -> kProc `kFun` kRate `kFun` kData `kFun` kData
        TyConFlowSegd           -> kRate `kFun` kRate `kFun` kData
        TyConFlowSel n          -> kProc `kFun` foldr kFun kData (replicate (n + 1) kRate)
        TyConFlowRef            -> kData `kFun` kData
        TyConFlowWorld          -> kData
        TyConFlowRateNat        -> kRate `kFun` kData
        TyConFlowRateCross      -> kRate `kFun` kRate `kFun` kRate
        TyConFlowRateAppend     -> kRate `kFun` kRate `kFun` kRate
        TyConFlowDown{}         -> kRate `kFun` kRate
        TyConFlowTail{}         -> kRate `kFun` kRate
        TyConFlowProcess        -> kProc `kFun` kRate `kFun` kData
        TyConFlowResize         -> kProc `kFun` kRate `kFun` kRate `kFun` kData


-- Predicates -----------------------------------------------------------------
-- | Check if some type is a fully applied type of a RateNat
isRateNatType :: Type Name -> Bool
isRateNatType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowRateNat, [_])   -> True
        _                                            -> False


-- | Check if some type is a fully applied type of a Series.
isSeriesType :: Type Name -> Bool
isSeriesType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowSeries, [_, _, _]) -> True
        _                                               -> False


-- | Check if some type is a fully applied type of a Ref.
isRefType :: Type Name -> Bool
isRefType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowRef, [_])       -> True
        _                                            -> False


-- | Check if some type is a fully applied type of a Vector.
isVectorType :: Type Name -> Bool
isVectorType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowVector, [_])    -> True
        _                                            -> False


-- | Check if some type is a fully applied type of a Buffer.
isBufferType :: Type Name -> Bool
isBufferType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowBuffer, [_])    -> True
        _                                            -> False

-- | Check if some type is a fully applied type of a RateVec.
isRateVecType :: Type Name -> Bool
isRateVecType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowRateVec, [_, _])-> True
        _                                            -> False

-- | Check if some type is a fully applied Process.
isProcessType :: Type Name -> Bool
isProcessType tt
 = case takePrimTyConApps tt of
        Just (NameTyConFlow TyConFlowProcess, [_, _]) -> True
        _                                             -> False



-- Compounds ------------------------------------------------------------------
tTuple1 :: Type Name -> Type Name
tTuple1 tA      = tApps (tConTyConFlow (TyConFlowTuple 1)) [tA]


tTuple2 :: Type Name -> Type Name -> Type Name
tTuple2 tA tB   = tApps (tConTyConFlow (TyConFlowTuple 2)) [tA, tB]


tTupleN :: [Type Name] -> Type Name
tTupleN tys     = tApps (tConTyConFlow (TyConFlowTuple (length tys))) tys


tBuffer :: Type Name -> Type Name
tBuffer tA      = tApps (tConTyConFlow TyConFlowBuffer)    [tA]


tVector ::  Type Name -> Type Name
tVector tA      = tApps (tConTyConFlow TyConFlowVector)    [tA]

tRateVec :: Type Name -> Type Name -> Type Name
tRateVec tK tA = tApps (tConTyConFlow TyConFlowRateVec)  [tK, tA]


tSeries :: Type Name -> Type Name -> Type Name -> Type Name
tSeries tP tK tA   = tApps (tConTyConFlow TyConFlowSeries)    [tP, tK, tA]


tSegd :: Type Name -> Type Name -> Type Name
tSegd tK1 tK2   = tApps (tConTyConFlow TyConFlowSegd)      [tK1, tK2]


tSel1 :: Type Name -> Type Name -> Type Name -> Type Name
tSel1 tP tK1 tK2   = tApps (tConTyConFlow $ TyConFlowSel 1) [tP, tK1, tK2]


tSel2 :: Type Name -> Type Name -> Type Name -> Type Name -> Type Name
tSel2 tP tK1 tK2 tK3 = tApps (tConTyConFlow $ TyConFlowSel 2) [tP, tK1, tK2, tK3]


tRef  :: Type Name -> Type Name
tRef tVal       = tApp (tConTyConFlow $ TyConFlowRef) tVal


tWorld :: Type Name
tWorld          = tConTyConFlow TyConFlowWorld


tRateNat :: Type Name -> Type Name
tRateNat tK     = tApp (tConTyConFlow TyConFlowRateNat)  tK

tRateCross :: Type Name -> Type Name -> Type Name
tRateCross tKa tKb = tConTyConFlow TyConFlowRateCross `tApps` [tKa, tKb]

tRateAppend :: Type Name -> Type Name -> Type Name
tRateAppend tKa tKb = tConTyConFlow TyConFlowRateAppend `tApps` [tKa, tKb]



tDown :: Int -> Type Name -> Type Name 
tDown n tK      = tApp (tConTyConFlow $ TyConFlowDown n) tK


tTail :: Int -> Type Name -> Type Name 
tTail n tK      = tApp (tConTyConFlow $ TyConFlowTail n) tK


tProcess :: Type Name -> Type Name -> Type Name 
tProcess tP tK = (tConTyConFlow TyConFlowProcess) `tApps` [tP, tK]

tResize  :: Type Name -> Type Name -> Type Name -> Type Name 
tResize  tP tJ tK = (tConTyConFlow TyConFlowResize) `tApps` [tP, tJ, tK]




-- Utils ----------------------------------------------------------------------
tConTyConFlow :: TyConFlow -> Type Name
tConTyConFlow tcf
 = let  k       = kindTyConFlow tcf
        u       = UPrim (NameTyConFlow tcf) k
        tc      = TyConBound u k
   in   TCon tc