content: {-# LANGUAGE CPP #-}
  #ifdef TRUSTWORTHY
  # if MIN_VERSION_template_haskell(2,12,0)
  # else
  {-# LANGUAGE Trustworthy #-}
  # endif
  #endif
  
  #ifdef HLINT
  {-# ANN module "HLint: ignore Use camelCase" #-}
  #endif
  
  #ifndef MIN_VERSION_template_haskell
  #define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706)
  #endif
  
  #ifndef MIN_VERSION_containers
  #define MIN_VERSION_containers(x,y,z) 1
  #endif
  
  #ifndef MIN_VERSION_base
  #define MIN_VERSION_base(x,y,z) 1
  #endif
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Silica.Internal.TH
  -- Copyright   :  (C) 2013-2016 Edward Kmett and Eric Mertens
  -- License     :  BSD-style (see the file LICENSE)
  -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  ----------------------------------------------------------------------------
  module Silica.Internal.TH where
  
  import Data.Functor.Contravariant
  import Language.Haskell.TH
  import Language.Haskell.TH.Syntax
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  #ifndef CURRENT_PACKAGE_KEY
  import Data.Version (showVersion)
  import Paths_lens (version)
  #endif
  
  -- | Compatibility shim for recent changes to template haskell's 'tySynInstD'
  tySynInstD' :: Name -> [TypeQ] -> TypeQ -> DecQ
  #if MIN_VERSION_template_haskell(2,9,0)
  tySynInstD' fam ts r = tySynInstD fam (tySynEqn ts r)
  #else
  tySynInstD' = tySynInstD
  #endif
  
  -- | Apply arguments to a type constructor
  appsT :: TypeQ -> [TypeQ] -> TypeQ
  appsT = foldl appT
  
  -- | Apply arguments to a function
  appsE1 :: ExpQ -> [ExpQ] -> ExpQ
  appsE1 = foldl appE
  
  -- | Construct a tuple type given a list of types.
  toTupleT :: [TypeQ] -> TypeQ
  toTupleT [x] = x
  toTupleT xs = appsT (tupleT (length xs)) xs
  
  -- | Construct a tuple value given a list of expressions.
  toTupleE :: [ExpQ] -> ExpQ
  toTupleE [x] = x
  toTupleE xs = tupE xs
  
  -- | Construct a tuple pattern given a list of patterns.
  toTupleP :: [PatQ] -> PatQ
  toTupleP [x] = x
  toTupleP xs = tupP xs
  
  -- | Apply arguments to a type constructor.
  conAppsT :: Name -> [Type] -> Type
  conAppsT conName = foldl AppT (ConT conName)
  
  
  -- | Return 'Name' contained in a 'TyVarBndr'.
  bndrName :: TyVarBndr -> Name
  bndrName (PlainTV  n  ) = n
  bndrName (KindedTV n _) = n
  
  fromSet :: (k -> v) -> Set.Set k -> Map.Map k v
  #if MIN_VERSION_containers(0,5,0)
  fromSet = Map.fromSet
  #else
  fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ]
  #endif
  
  -- | Generate many new names from a given base name.
  newNames :: String {- ^ base name -} -> Int {- ^ count -} -> Q [Name]
  newNames base n = sequence [ newName (base++show i) | i <- [1..n] ]
  
  ------------------------------------------------------------------------
  -- Manually quoted names
  ------------------------------------------------------------------------
  -- By manually generating these names we avoid needing to use the
  -- TemplateHaskell language extension when compiling the lens library.
  -- This allows the library to be used in stage1 cross-compilers.
  
  lensPackageKey         :: String
  #ifdef CURRENT_PACKAGE_KEY
  lensPackageKey          = CURRENT_PACKAGE_KEY
  #else
  lensPackageKey          = "lens-" ++ showVersion version
  #endif
  
  mkLensName_tc          :: String -> String -> Name
  mkLensName_tc           = mkNameG_tc lensPackageKey
  
  mkLensName_v           :: String -> String -> Name
  mkLensName_v            = mkNameG_v lensPackageKey
  
  traversalTypeName      :: Name
  traversalTypeName       = mkLensName_tc "Silica.Type" "Traversal"
  
  traversal'TypeName     :: Name
  traversal'TypeName      = mkLensName_tc "Silica.Type" "Traversal'"
  
  lensTypeName           :: Name
  lensTypeName            = mkLensName_tc "Silica.Type" "Lens"
  
  lens'TypeName          :: Name
  lens'TypeName           = mkLensName_tc "Silica.Type" "Lens'"
  
  isoTypeName            :: Name
  isoTypeName             = mkLensName_tc "Silica.Type" "Iso"
  
  iso'TypeName           :: Name
  iso'TypeName            = mkLensName_tc "Silica.Type" "Iso'"
  
  getterTypeName         :: Name
  getterTypeName          = mkLensName_tc "Silica.Type" "Getter"
  
  foldTypeName           :: Name
  foldTypeName            = mkLensName_tc "Silica.Type" "Fold"
  
  prismTypeName          :: Name
  prismTypeName           = mkLensName_tc "Silica.Type" "Prism"
  
  prism'TypeName         :: Name
  prism'TypeName          = mkLensName_tc "Silica.Type" "Prism'"
  
  reviewTypeName          :: Name
  reviewTypeName           = mkLensName_tc "Silica.Type" "Review"
  
  wrappedTypeName         :: Name
  wrappedTypeName          = mkLensName_tc "Silica.Wrapped" "Wrapped"
  
  unwrappedTypeName       :: Name
  unwrappedTypeName        = mkLensName_tc "Silica.Wrapped" "Unwrapped"
  
  rewrappedTypeName       :: Name
  rewrappedTypeName        = mkLensName_tc "Silica.Wrapped" "Rewrapped"
  
  _wrapped'ValName        :: Name
  _wrapped'ValName         = mkLensName_v "Silica.Wrapped" "_Wrapped'"
  
  isoValName              :: Name
  isoValName               = mkLensName_v "Silica.Iso" "iso"
  
  prismValName            :: Name
  prismValName             = mkLensName_v "Silica.Prism" "prism"
  
  untoValName             :: Name
  untoValName              = mkLensName_v "Silica.Review" "unto"
  
  phantomValName          :: Name
  phantomValName           = mkLensName_v "Silica.Internal.TH" "phantom2"
  
  phantom2 :: (Functor f, Contravariant f) => f a -> f b
  phantom2 = phantom
  {-# INLINE phantom2 #-}
  
  composeValName          :: Name
  composeValName           = mkNameG_v "base" "GHC.Base" "."
  
  idValName               :: Name
  idValName                = mkNameG_v "base" "GHC.Base" "id"
  
  fmapValName             :: Name
  fmapValName              = mkNameG_v "base" "GHC.Base" "fmap"
  
  #if MIN_VERSION_base(4,8,0)
  pureValName             :: Name
  pureValName              = mkNameG_v "base" "GHC.Base" "pure"
  
  apValName               :: Name
  apValName                = mkNameG_v "base" "GHC.Base" "<*>"
  #else
  pureValName             :: Name
  pureValName              = mkNameG_v "base" "Control.Applicative" "pure"
  
  apValName               :: Name
  apValName                = mkNameG_v "base" "Control.Applicative" "<*>"
  #endif
  
  rightDataName           :: Name
  rightDataName            = mkNameG_d "base" "Data.Either" "Right"
  
  leftDataName            :: Name
  leftDataName             = mkNameG_d "base" "Data.Either" "Left"
  
  
  ------------------------------------------------------------------------
  -- Support for generating inline pragmas
  ------------------------------------------------------------------------
  
  inlinePragma :: Name -> [DecQ]
  
  #ifdef INLINING
  
  #if MIN_VERSION_template_haskell(2,8,0)
  
  # ifdef OLD_INLINE_PRAGMAS
  -- 7.6rc1?
  inlinePragma methodName = [pragInlD methodName (inlineSpecNoPhase Inline False)]
  # else
  -- 7.7.20120830
  inlinePragma methodName = [pragInlD methodName Inline FunLike AllPhases]
  # endif
  
  #else
  -- GHC <7.6, TH <2.8.0
  inlinePragma methodName = [pragInlD methodName (inlineSpecNoPhase True False)]
  #endif
  
  #else
  
  inlinePragma _ = []
  
  #endif
  