content: {-|
  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 names@(length -> n) =
    foldl AppT (TupleT n) 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 tryDomainName mergeName n =
    mkTySynInstD tryDomainName [t, tupPat] tupBody
   where
    bcde = map (VarT . mkName . ("a"++) . show) [1..n-1]
    a    = VarT (mkName "a0")
    t    = VarT (mkName "t")
  
    -- Merge t a (b, c, d, e)
    tupBody = ConT mergeName `AppT` t `AppT` a `AppT` (mkTup bcde)
  
    -- (a, b, c, d, e)
    tupPat = mkTup (a : bcde)
  
  mkTryDomainTuples :: Name -> Name -> Q [Dec]
  mkTryDomainTuples tryDomainName mergeName =
    pure (map (mkTryDomainTupleInstance tryDomainName mergeName) [3..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 hasDomainName mergeName n =
    mkTySynInstD hasDomainName [dom, tupPat] merge
   where
    bcde = map (VarT . mkName . ("a"++) . show) [1..n-1]
    a    = VarT (mkName "a0")
    dom  = VarT (mkName "dom")
  
    -- Merge dom a (b, c, d, e)
    merge = ConT mergeName `AppT` dom `AppT` a `AppT` mkTup bcde
  
    -- (a, b, c, d, e)
    tupPat = mkTup (a : bcde)
  
  mkHasDomainTuples :: Name -> Name -> Q [Dec]
  mkHasDomainTuples hasDomainName mergeName =
    pure (map (mkHasDomainTupleInstance hasDomainName mergeName) [3..maxTupleSize])
  