    {-|
    Copyright  :  (C) 2019, Myrtle Software Ltd
    License    :  BSD2 (see the file LICENSE)
    Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
    -}

    module Clash.Class.HasDomain.CodeGen
      ( mkTryDomainTuples
      , mkHasDomainTuples
      ) where

    import           Language.Haskell.TH.Syntax
    import           Clash.CPP                    (maxTupleSize)
    import           Language.Haskell.TH.Compat   (mkTySynInstD)

    mkTup :: [Type] -> Type
    mkTup :: [Type] -> Type
    mkTup names :: [Type]
    names@([Type] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length -> Int
    n) =
      (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT (Int -> Type
    TupleT Int
    n) [Type]
    names

    -- | Creates an instance of the form:
    --
    --  type instance TryDomain t (a, b, c, d, e) = Merge t a (b, c, d, e)
    --
    -- With /n/ number of variables on the LHS.
    mkTryDomainTupleInstance :: Name -> Name -> Int -> Dec
    mkTryDomainTupleInstance :: Name -> Name -> Int -> Dec
    mkTryDomainTupleInstance Name
    tryDomainName Name
    mergeName Int
    n =
      Name -> [Type] -> Type -> Dec
    mkTySynInstD Name
    tryDomainName [Type
    t, Type
    tupPat] Type
    tupBody
     where
      bcde :: [Type]
    bcde = (Int -> Type) -> [Int] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Type
    VarT (Name -> Type) -> (Int -> Name) -> Int -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName (String -> Name) -> (Int -> String) -> Int -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "a"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [Int
    1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1]
      a :: Type
    a    = Name -> Type
    VarT (String -> Name
    mkName String
    "a0")
      t :: Type
    t    = Name -> Type
    VarT (String -> Name
    mkName String
    "t")

      -- Merge t a (b, c, d, e)
      tupBody :: Type
    tupBody = Name -> Type
    ConT Name
    mergeName Type -> Type -> Type
    `AppT` Type
    t Type -> Type -> Type
    `AppT` Type
    a Type -> Type -> Type
    `AppT` ([Type] -> Type
    mkTup [Type]
    bcde)

      -- (a, b, c, d, e)
      tupPat :: Type
    tupPat = [Type] -> Type
    mkTup (Type
    a Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : [Type]
    bcde)

    mkTryDomainTuples :: Name -> Name -> Q [Dec]
    mkTryDomainTuples :: Name -> Name -> Q [Dec]
    mkTryDomainTuples Name
    tryDomainName Name
    mergeName =
      [Dec] -> Q [Dec]
    forall a. a -> Q a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((Int -> Dec) -> [Int] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Name -> Int -> Dec
    mkTryDomainTupleInstance Name
    tryDomainName Name
    mergeName) [Int
    3..Int
    forall a. Num a => a
    maxTupleSize])

    -- | Creates an instance of the form:
    --
    --  type instance HasDomain' dom (a, b, c, d, e) =
    --    Merge' (HasDomain' dom a) (HasDomain' dom (b, c, d, e))
    --
    -- With /n/ number of variables on the LHS.
    mkHasDomainTupleInstance :: Name -> Name -> Int -> Dec
    mkHasDomainTupleInstance :: Name -> Name -> Int -> Dec
    mkHasDomainTupleInstance Name
    hasDomainName Name
    mergeName Int
    n =
      Name -> [Type] -> Type -> Dec
    mkTySynInstD Name
    hasDomainName [Type
    dom, Type
    tupPat] Type
    merge
     where
      bcde :: [Type]
    bcde = (Int -> Type) -> [Int] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Type
    VarT (Name -> Type) -> (Int -> Name) -> Int -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName (String -> Name) -> (Int -> String) -> Int -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "a"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [Int
    1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1]
      a :: Type
    a    = Name -> Type
    VarT (String -> Name
    mkName String
    "a0")
      dom :: Type
    dom  = Name -> Type
    VarT (String -> Name
    mkName String
    "dom")

      -- Merge dom a (b, c, d, e)
      merge :: Type
    merge = Name -> Type
    ConT Name
    mergeName Type -> Type -> Type
    `AppT` Type
    dom Type -> Type -> Type
    `AppT` Type
    a Type -> Type -> Type
    `AppT` [Type] -> Type
    mkTup [Type]
    bcde

      -- (a, b, c, d, e)
      tupPat :: Type
    tupPat = [Type] -> Type
    mkTup (Type
    a Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : [Type]
    bcde)

    mkHasDomainTuples :: Name -> Name -> Q [Dec]
    mkHasDomainTuples :: Name -> Name -> Q [Dec]
    mkHasDomainTuples Name
    hasDomainName Name
    mergeName =
      [Dec] -> Q [Dec]
    forall a. a -> Q a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((Int -> Dec) -> [Int] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Name -> Int -> Dec
    mkHasDomainTupleInstance Name
    hasDomainName Name
    mergeName) [Int
    3..Int
    forall a. Num a => a
    maxTupleSize])