{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE Rank2Types #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.TH.Lens
-- Copyright   :  (C) 2012-2014 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  TemplateHaskell
--
-- Lenses, Prisms, and Traversals for working with Template Haskell
----------------------------------------------------------------------------
module Language.Haskell.TH.Lens
  (
  -- * Traversals
    HasName(..)
  , HasTypeVars(..)
  , SubstType(..)
  , typeVars      -- :: HasTypeVars t => Traversal' t Name
  , substTypeVars -- :: HasTypeVars t => Map Name Name -> t -> t
  , conFields
  , conNamedFields
  -- * Lenses
  -- ** Loc Lenses
  , locFileName
  , locPackage
  , locModule
  , locStart
  , locEnd
  -- ** FunDep Lenses
  , funDepInputs
  , funDepOutputs
  -- ** Match Lenses
  , matchPattern
  , matchBody
  , matchDeclarations
  -- ** Fixity Lenses
  , fixityPrecedence
  , fixityDirection
  -- ** Clause Lenses
  , clausePattern
  , clauseBody
  , clauseDecs
  -- ** FieldExp Lenses
  , fieldExpName
  , fieldExpExpression
  -- ** FieldPat Lenses
  , fieldPatName
  , fieldPatPattern
#if MIN_VERSION_template_haskell(2,9,0)
  -- ** TySynEqn Lenses
  , tySynEqnPatterns
  , tySynEqnResult
#endif
  -- * Prisms
  -- ** Info Prisms
  , _ClassI
  , _ClassOpI
  , _TyConI
  , _FamilyI
  , _PrimTyConI
  , _DataConI
  , _VarI
  , _TyVarI
  -- ** Dec Prisms
  , _FunD
  , _ValD
  , _DataD
  , _NewtypeD
  , _TySynD
  , _ClassD
  , _InstanceD
  , _SigD
  , _ForeignD
#if MIN_VERSION_template_haskell(2,8,0)
  , _InfixD
#endif
  , _PragmaD
  , _FamilyD
  , _DataInstD
  , _NewtypeInstD
  , _TySynInstD
#if MIN_VERSION_template_haskell(2,9,0)
  , _ClosedTypeFamilyD
  , _RoleAnnotD
#endif
  -- ** Con Prisms
  , _NormalC
  , _RecC
  , _InfixC
  , _ForallC
  -- ** Strict Prisms
  , _IsStrict
  , _NotStrict
  , _Unpacked
  -- ** Foreign Prisms
  , _ImportF
  , _ExportF
  -- ** Callconv Prisms
  , _CCall
  , _StdCall
  -- ** Safety Prisms
  , _Unsafe
  , _Safe
  , _Interruptible
  -- ** Pragma Prisms
  , _InlineP
  , _SpecialiseP
#if MIN_VERSION_template_haskell(2,8,0)
  , _SpecialiseInstP
  , _RuleP
#if MIN_VERSION_template_haskell(2,9,0)
  , _AnnP
#endif
  -- ** Inline Prisms
  , _NoInline
  , _Inline
  , _Inlinable
  -- ** RuleMatch Prisms
  , _ConLike
  , _FunLike
  -- ** Phases Prisms
  , _AllPhases
  , _FromPhase
  , _BeforePhase
  -- ** RuleBndr Prisms
  , _RuleVar
  , _TypedRuleVar
#endif
#if MIN_VERSION_template_haskell(2,9,0)
  -- ** AnnTarget Prisms
  , _ModuleAnnotation
  , _TypeAnnotation
  , _ValueAnnotation
#endif
  -- ** FunDep Prisms TODO make a lens
  , _FunDep
  -- ** FamFlavour Prisms
  , _TypeFam
  , _DataFam
  -- ** FixityDirection Prisms
  , _InfixL
  , _InfixR
  , _InfixN
  -- ** Exp Prisms
  , _VarE
  , _ConE
  , _LitE
  , _AppE
  , _InfixE
  , _UInfixE
  , _ParensE
  , _LamE
#if MIN_VERSION_template_haskell(2,8,0)
  , _LamCaseE
#endif
  , _TupE
  , _UnboxedTupE
  , _CondE
#if MIN_VERSION_template_haskell(2,8,0)
  , _MultiIfE
#endif
  , _LetE
  , _CaseE
  , _DoE
  , _CompE
  , _ArithSeqE
  , _ListE
  , _SigE
  , _RecConE
  , _RecUpdE
  -- ** Body Prisms
  , _GuardedB
  , _NormalB
  -- ** Guard Prisms
  , _NormalG
  , _PatG
  -- ** Stmt Prisms
  , _BindS
  , _LetS
  , _NoBindS
  , _ParS
  -- ** Range Prisms
  , _FromR
  , _FromThenR
  , _FromToR
  , _FromThenToR
  -- ** Lit Prisms
  , _CharL
  , _StringL
  , _IntegerL
  , _RationalL
  , _IntPrimL
  , _WordPrimL
  , _FloatPrimL
  , _DoublePrimL
  , _StringPrimL
  -- ** Pat Prisms
  , _LitP
  , _VarP
  , _TupP
  , _UnboxedTupP
  , _ConP
  , _InfixP
  , _UInfixP
  , _ParensP
  , _TildeP
  , _BangP
  , _AsP
  , _WildP
  , _RecP
  , _ListP
  , _SigP
  , _ViewP
  -- ** Type Prisms
  , _ForallT
  , _AppT
  , _SigT
  , _VarT
  , _ConT
#if MIN_VERSION_template_haskell(2,8,0)
  , _PromotedT
#endif
  , _TupleT
  , _UnboxedTupleT
  , _ArrowT
  , _ListT
#if MIN_VERSION_template_haskell(2,8,0)
  , _PromotedTupleT
  , _PromotedNilT
  , _PromotedConsT
  , _StarT
  , _ConstraintT
  , _LitT
#endif
  -- ** TyVarBndr Prisms
  , _PlainTV
  , _KindedTV
#if MIN_VERSION_template_haskell(2,8,0)
  -- ** TyLit Prisms
  , _NumTyLit
  , _StrTyLit
#endif
  -- ** Pred Prisms
  , _ClassP
  , _EqualP
#if MIN_VERSION_template_haskell(2,9,0)
  -- ** Role Prisms
  , _NominalR
  , _RepresentationalR
#endif
  ) where

import Control.Applicative
import Control.Lens.At
import Control.Lens.Getter
import Control.Lens.Setter
import Control.Lens.Fold
import Control.Lens.Lens
import Control.Lens.Prism
import Control.Lens.Tuple
import Control.Lens.Traversal
import Data.Map as Map hiding (toList,map)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Set as Set hiding (toList,map)
import Data.Set.Lens
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
#if MIN_VERSION_template_haskell(2,8,0)
import Data.Word
#endif

-- | Has a 'Name'
class HasName t where
  -- | Extract (or modify) the 'Name' of something
  name :: Lens' t Name

instance HasName TyVarBndr where
  name f (PlainTV n) = PlainTV <$> f n
  name f (KindedTV n k) = (`KindedTV` k) <$> f n

instance HasName Name where
  name = id

instance HasName Con where
  name f (NormalC n tys)       = (`NormalC` tys) <$> f n
  name f (RecC n tys)          = (`RecC` tys) <$> f n
  name f (InfixC l n r)        = (\n' -> InfixC l n' r) <$> f n
  name f (ForallC bds ctx con) = ForallC bds ctx <$> name f con

-- | Provides for the extraction of free type variables, and alpha renaming.
class HasTypeVars t where
  -- | When performing substitution into this traversal you're not allowed
  -- to substitute in a name that is bound internally or you'll violate
  -- the 'Traversal' laws, when in doubt generate your names with 'newName'.
  typeVarsEx :: Set Name -> Traversal' t Name

instance HasTypeVars TyVarBndr where
  typeVarsEx s f b
    | s^.contains (b^.name) = pure b
    | otherwise             = name f b

instance HasTypeVars Name where
  typeVarsEx s f n
    | s^.contains n = pure n
    | otherwise     = f n

instance HasTypeVars Type where
  typeVarsEx s f (VarT n)            = VarT <$> typeVarsEx s f n
  typeVarsEx s f (AppT l r)          = AppT <$> typeVarsEx s f l <*> typeVarsEx s f r
  typeVarsEx s f (SigT t k)          = (`SigT` k) <$> typeVarsEx s f t
  typeVarsEx s f (ForallT bs ctx ty) = ForallT bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f ty
       where s' = s `Set.union` setOf typeVars bs
  typeVarsEx _ _ t                   = pure t

instance HasTypeVars Pred where
  typeVarsEx s f (ClassP n ts) = ClassP n <$> typeVarsEx s f ts
  typeVarsEx s f (EqualP l r)  = EqualP <$> typeVarsEx s f l <*> typeVarsEx s f r

instance HasTypeVars Con where
  typeVarsEx s f (NormalC n ts) = NormalC n <$> traverseOf (traverse . _2) (typeVarsEx s f) ts
  typeVarsEx s f (RecC n ts) = RecC n <$> traverseOf (traverse . _3) (typeVarsEx s f) ts
  typeVarsEx s f (InfixC l n r) = InfixC <$> g l <*> pure n <*> g r
       where g (i, t) = (,) i <$> typeVarsEx s f t
  typeVarsEx s f (ForallC bs ctx c) = ForallC bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f c
       where s' = s `Set.union` setOf typeVars bs

instance HasTypeVars t => HasTypeVars [t] where
  typeVarsEx s = traverse . typeVarsEx s

-- | Traverse /free/ type variables
typeVars :: HasTypeVars t => Traversal' t Name
typeVars = typeVarsEx mempty

-- | Substitute using a map of names in for /free/ type variables
substTypeVars :: HasTypeVars t => Map Name Name -> t -> t
substTypeVars m = over typeVars $ \n -> fromMaybe n (m^.at n)

-- | Provides substitution for types
class SubstType t where
  -- | Perform substitution for types
  substType :: Map Name Type -> t -> t

instance SubstType Type where
  substType m t@(VarT n)          = fromMaybe t (m^.at n)
  substType m (ForallT bs ctx ty) = ForallT bs (substType m' ctx) (substType m' ty)
    where m' = foldrOf typeVars Map.delete m bs
  substType m (SigT t k)          = SigT (substType m t) k
  substType m (AppT l r)          = AppT (substType m l) (substType m r)
  substType _ t                   = t

instance SubstType t => SubstType [t] where
  substType = map . substType

instance SubstType Pred where
  substType m (ClassP n ts) = ClassP n (substType m ts)
  substType m (EqualP l r)  = substType m (EqualP l r)

-- | Provides a 'Traversal' of the types of each field of a constructor.
conFields :: Traversal' Con StrictType
conFields f (NormalC n fs)      = NormalC n <$> traverse f fs
conFields f (RecC n fs)         = RecC n <$> traverse sans_var fs
  where sans_var (fn,s,t) = (\(s', t') -> (fn,s',t')) <$> f (s, t)
conFields f (InfixC l n r)      = InfixC <$> f l <*> pure n <*> f r
conFields f (ForallC bds ctx c) = ForallC bds ctx <$> conFields f c

-- | 'Traversal' of the types of the /named/ fields of a constructor.
conNamedFields :: Traversal' Con VarStrictType
conNamedFields f (RecC n fs) = RecC n <$> traverse f fs
conNamedFields _ c = pure c

-- Lenses and Prisms
locFileName :: Lens' Loc String
locFileName = lens loc_filename
            $ \loc fn -> loc { loc_filename = fn }

locPackage :: Lens' Loc String
locPackage = lens loc_package
           $ \loc fn -> loc { loc_package = fn }

locModule :: Lens' Loc String
locModule = lens loc_module
          $ \loc fn -> loc { loc_module = fn }

locStart :: Lens' Loc CharPos
locStart = lens loc_start
         $ \loc fn -> loc { loc_start = fn }

locEnd :: Lens' Loc CharPos
locEnd = lens loc_end
       $ \loc fn -> loc { loc_end = fn }

funDepInputs :: Lens' FunDep [Name]
funDepInputs = lens g s where
   g (FunDep xs _)    = xs
   s (FunDep _ ys) xs = FunDep xs ys

funDepOutputs :: Lens' FunDep [Name]
funDepOutputs = lens g s where
   g (FunDep _ xs) = xs
   s (FunDep ys _) = FunDep ys

fieldExpName :: Lens' FieldExp Name
fieldExpName = _1

fieldExpExpression :: Lens' FieldExp Exp
fieldExpExpression = _2

fieldPatName :: Lens' FieldPat Name
fieldPatName = _1

fieldPatPattern :: Lens' FieldPat Pat
fieldPatPattern = _2

matchPattern :: Lens' Match Pat
matchPattern = lens g s where
   g (Match p _ _)   = p
   s (Match _ x y) p = Match p x y

matchBody :: Lens' Match Body
matchBody = lens g s where
   g (Match _ b _)   = b
   s (Match x _ y) b = Match x b y

matchDeclarations :: Lens' Match [Dec]
matchDeclarations = lens g s where
   g (Match _ _ ds) = ds
   s (Match x y _ ) = Match x y

fixityPrecedence :: Lens' Fixity Int
fixityPrecedence = lens g s where
   g (Fixity i _)   = i
   s (Fixity _ x) i = Fixity i x

fixityDirection :: Lens' Fixity FixityDirection
fixityDirection = lens g s where
   g (Fixity _ d) = d
   s (Fixity i _) = Fixity i

clausePattern :: Lens' Clause [Pat]
clausePattern = lens g s where
   g (Clause ps _ _)    = ps
   s (Clause _  x y) ps = Clause ps x y

clauseBody :: Lens' Clause Body
clauseBody = lens g s where
   g (Clause _ b _)   = b
   s (Clause x _ y) b = Clause x b y

clauseDecs :: Lens' Clause [Dec]
clauseDecs = lens g s where
   g (Clause _ _ ds) = ds
   s (Clause x y _ ) = Clause x y

#if MIN_VERSION_template_haskell(2,8,0)
_ClassI :: Prism' Info (Dec, [InstanceDec])
_ClassI
  = prism remitter reviewer
  where
      remitter (x, y) = ClassI x y
      reviewer (ClassI x y) = Right (x, y)
      reviewer x = Left x

_ClassOpI :: Prism' Info (Name, Type, ParentName, Fixity)
_ClassOpI
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = ClassOpI x y z w
      reviewer (ClassOpI x y z w) = Right (x, y, z, w)
      reviewer x = Left x

#else
_ClassI :: Prism' Info (Dec, [Dec])
_ClassI
  = prism remitter reviewer
  where
      remitter (x, y) = ClassI x y
      reviewer (ClassI x y) = Right (x, y)
      reviewer x = Left x

_ClassOpI :: Prism' Info (Name, Type, Name, Fixity)
_ClassOpI
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = ClassOpI x y z w
      reviewer (ClassOpI x y z w) = Right (x, y, z, w)
      reviewer x = Left x
#endif

_TyConI :: Prism' Info Dec
_TyConI
  = prism remitter reviewer
  where
      remitter = TyConI
      reviewer (TyConI x) = Right x
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_FamilyI :: Prism' Info (Dec, [InstanceDec])
_FamilyI
  = prism remitter reviewer
  where
      remitter (x, y) = FamilyI x y
      reviewer (FamilyI x y) = Right (x, y)
      reviewer x = Left x

_PrimTyConI :: Prism' Info (Name, Arity, Unlifted)
_PrimTyConI
  = prism remitter reviewer
  where
      remitter (x, y, z) = PrimTyConI x y z
      reviewer (PrimTyConI x y z) = Right (x, y, z)
      reviewer x = Left x

_DataConI :: Prism' Info (Name, Type, ParentName, Fixity)
_DataConI
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = DataConI x y z w
      reviewer (DataConI x y z w) = Right (x, y, z, w)
      reviewer x = Left x
#else
_FamilyI :: Prism' Info (Dec, [Dec])
_FamilyI
  = prism remitter reviewer
  where
      remitter (x, y) = FamilyI x y
      reviewer (FamilyI x y) = Right (x, y)
      reviewer x = Left x

_PrimTyConI :: Prism' Info (Name, Int, Bool)
_PrimTyConI
  = prism remitter reviewer
  where
      remitter (x, y, z) = PrimTyConI x y z
      reviewer (PrimTyConI x y z) = Right (x, y, z)
      reviewer x = Left x

_DataConI :: Prism' Info (Name, Type, Name, Fixity)
_DataConI
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = DataConI x y z w
      reviewer (DataConI x y z w) = Right (x, y, z, w)
      reviewer x = Left x

#endif

_VarI :: Prism' Info (Name, Type, Maybe Dec, Fixity)
_VarI
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = VarI x y z w
      reviewer (VarI x y z w) = Right (x, y, z, w)
      reviewer x = Left x

_TyVarI :: Prism' Info (Name, Type)
_TyVarI
  = prism remitter reviewer
  where
      remitter (x, y) = TyVarI x y
      reviewer (TyVarI x y) = Right (x, y)
      reviewer x = Left x

_FunD :: Prism' Dec (Name, [Clause])
_FunD
  = prism remitter reviewer
  where
      remitter (x, y) = FunD x y
      reviewer (FunD x y) = Right (x, y)
      reviewer x = Left x

_ValD :: Prism' Dec (Pat, Body, [Dec])
_ValD
  = prism remitter reviewer
  where
      remitter (x, y, z) = ValD x y z
      reviewer (ValD x y z) = Right (x, y, z)
      reviewer x = Left x

_DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], [Con], [Name])
_DataD
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u) = DataD x y z w u
      reviewer (DataD x y z w u) = Right (x, y, z, w, u)
      reviewer x = Left x

_NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndr], Con, [Name])
_NewtypeD
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u) = NewtypeD x y z w u
      reviewer (NewtypeD x y z w u) = Right (x, y, z, w, u)
      reviewer x = Left x

_TySynD :: Prism' Dec (Name, [TyVarBndr], Type)
_TySynD
  = prism remitter reviewer
  where
      remitter (x, y, z) = TySynD x y z
      reviewer (TySynD x y z) = Right (x, y, z)
      reviewer x = Left x

_ClassD :: Prism' Dec (Cxt, Name, [TyVarBndr], [FunDep], [Dec])
_ClassD
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u) = ClassD x y z w u
      reviewer (ClassD x y z w u) = Right (x, y, z, w, u)
      reviewer x = Left x

_InstanceD :: Prism' Dec (Cxt, Type, [Dec])
_InstanceD
  = prism remitter reviewer
  where
      remitter (x, y, z) = InstanceD x y z
      reviewer (InstanceD x y z) = Right (x, y, z)
      reviewer x = Left x

_SigD :: Prism' Dec (Name, Type)
_SigD
  = prism remitter reviewer
  where
      remitter (x, y) = SigD x y
      reviewer (SigD x y) = Right (x, y)
      reviewer x = Left x

_ForeignD :: Prism' Dec Foreign
_ForeignD
  = prism remitter reviewer
  where
      remitter = ForeignD
      reviewer (ForeignD x) = Right x
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_InfixD :: Prism' Dec (Fixity, Name)
_InfixD
  = prism remitter reviewer
  where
      remitter (x, y) = InfixD x y
      reviewer (InfixD x y) = Right (x, y)
      reviewer x = Left x
#endif

_PragmaD :: Prism' Dec Pragma
_PragmaD
  = prism remitter reviewer
  where
      remitter = PragmaD
      reviewer (PragmaD x) = Right x
      reviewer x = Left x

_FamilyD :: Prism' Dec (FamFlavour, Name, [TyVarBndr], Maybe Kind)
_FamilyD
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = FamilyD x y z w
      reviewer (FamilyD x y z w) = Right (x, y, z, w)
      reviewer x = Left x

_DataInstD :: Prism' Dec (Cxt, Name, [Type], [Con], [Name])
_DataInstD
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u) = DataInstD x y z w u
      reviewer (DataInstD x y z w u) = Right (x, y, z, w, u)
      reviewer x = Left x

_NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Con, [Name])
_NewtypeInstD
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u) = NewtypeInstD x y z w u
      reviewer (NewtypeInstD x y z w u) = Right (x, y, z, w, u)
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,9,0)
_TySynInstD :: Prism' Dec (Name, TySynEqn)
_TySynInstD
  = prism remitter reviewer
  where
      remitter (x, y) = TySynInstD x y
      reviewer (TySynInstD x y) = Right (x, y)
      reviewer x = Left x

_ClosedTypeFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind, [TySynEqn])
_ClosedTypeFamilyD
  = prism remitter reviewer
  where
      remitter (x, y, z, w) = ClosedTypeFamilyD x y z w
      reviewer (ClosedTypeFamilyD x y z w) = Right (x, y, z, w)
      reviewer x = Left x

_RoleAnnotD :: Prism' Dec (Name, [Role])
_RoleAnnotD
  = prism remitter reviewer
  where
      remitter (x, y) = RoleAnnotD x y
      reviewer (RoleAnnotD x y) = Right (x, y)
      reviewer x = Left x

#else
_TySynInstD :: Prism' Dec (Name, [Type], Type)
_TySynInstD
  = prism remitter reviewer
  where
      remitter (x, y, z) = TySynInstD x y z
      reviewer (TySynInstD x y z) = Right (x, y, z)
      reviewer x = Left x
#endif

_NormalC ::
  Prism' Con (Name, [StrictType])
_NormalC
  = prism remitter reviewer
  where
      remitter (x, y) = NormalC x y
      reviewer (NormalC x y) = Right (x, y)
      reviewer x = Left x

_RecC ::
  Prism' Con (Name, [VarStrictType])
_RecC
  = prism remitter reviewer
  where
      remitter (x, y) = RecC x y
      reviewer (RecC x y) = Right (x, y)
      reviewer x = Left x

_InfixC ::
  Prism' Con (StrictType,
              Name,
              StrictType)
_InfixC
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = InfixC x y z
      reviewer (InfixC x y z)
        = Right (x, y, z)
      reviewer x = Left x

_ForallC :: Prism' Con ([TyVarBndr], Cxt, Con)
_ForallC
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = ForallC x y z
      reviewer (ForallC x y z)
        = Right (x, y, z)
      reviewer x = Left x

_IsStrict :: Prism' Strict ()
_IsStrict
  = prism remitter reviewer
  where
      remitter () = IsStrict
      reviewer IsStrict = Right ()
      reviewer x = Left x

_NotStrict :: Prism' Strict ()
_NotStrict
  = prism remitter reviewer
  where
      remitter () = NotStrict
      reviewer NotStrict = Right ()
      reviewer x = Left x

_Unpacked :: Prism' Strict ()
_Unpacked
  = prism remitter reviewer
  where
      remitter () = Unpacked
      reviewer Unpacked = Right ()
      reviewer x = Left x

_ImportF :: Prism' Foreign (Callconv, Safety, String, Name, Type)
_ImportF
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u)
        = ImportF x y z w u
      reviewer (ImportF x y z w u)
        = Right (x, y, z, w, u)
      reviewer x = Left x

_ExportF :: Prism' Foreign (Callconv, String, Name, Type)
_ExportF
  = prism remitter reviewer
  where
      remitter (x, y, z, w)
        = ExportF x y z w
      reviewer (ExportF x y z w)
        = Right (x, y, z, w)
      reviewer x = Left x

_CCall :: Prism' Callconv ()
_CCall
  = prism remitter reviewer
  where
      remitter () = CCall
      reviewer CCall = Right ()
      reviewer x = Left x

_StdCall :: Prism' Callconv ()
_StdCall
  = prism remitter reviewer
  where
      remitter () = StdCall
      reviewer StdCall = Right ()
      reviewer x = Left x

_Unsafe :: Prism' Safety ()
_Unsafe
  = prism remitter reviewer
  where
      remitter () = Unsafe
      reviewer Unsafe = Right ()
      reviewer x = Left x

_Safe :: Prism' Safety ()
_Safe
  = prism remitter reviewer
  where
      remitter () = Safe
      reviewer Safe = Right ()
      reviewer x = Left x

_Interruptible :: Prism' Safety ()
_Interruptible
  = prism remitter reviewer
  where
      remitter () = Interruptible
      reviewer Interruptible = Right ()
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_InlineP :: Prism' Pragma (Name, Inline, RuleMatch, Phases)
_InlineP
  = prism remitter reviewer
  where
      remitter (x, y, z, w)
        = InlineP x y z w
      reviewer (InlineP x y z w)
        = Right (x, y, z, w)
      reviewer x = Left x

_SpecialiseP :: Prism' Pragma (Name, Type, Maybe Inline, Phases)
_SpecialiseP
  = prism remitter reviewer
  where
      remitter (x, y, z, w)
        = SpecialiseP x y z w
      reviewer (SpecialiseP x y z w)
        = Right (x, y, z, w)
      reviewer x = Left x
#else
_InlineP :: Prism' Pragma (Name, InlineSpec)
_InlineP
  = prism remitter reviewer
  where
      remitter (x, y)
        = InlineP x y
      reviewer (InlineP x y)
        = Right (x, y)
      reviewer x = Left x

_SpecialiseP :: Prism' Pragma (Name, Type, Maybe InlineSpec)
_SpecialiseP
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = SpecialiseP x y z
      reviewer (SpecialiseP x y z)
        = Right (x, y, z)
      reviewer x = Left x

-- TODO add lenses for InlineSpec
#endif

#if MIN_VERSION_template_haskell(2,8,0)
_SpecialiseInstP :: Prism' Pragma Type
_SpecialiseInstP
  = prism remitter reviewer
  where
      remitter x = SpecialiseInstP x
      reviewer (SpecialiseInstP x) = Right x
      reviewer x = Left x

_RuleP :: Prism' Pragma (String, [RuleBndr], Exp, Exp, Phases)
_RuleP
  = prism remitter reviewer
  where
      remitter (x, y, z, w, u)
        = RuleP x y z w u
      reviewer (RuleP x y z w u)
        = Right (x, y, z, w, u)
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,9,0)
_AnnP :: Prism' Pragma (AnnTarget, Exp)
_AnnP
  = prism remitter reviewer
  where
      remitter (x, y) = AnnP x y
      reviewer (AnnP x y) = Right (x, y)
      reviewer x = Left x
#endif

_NoInline :: Prism' Inline ()
_NoInline
  = prism remitter reviewer
  where
      remitter () = NoInline
      reviewer NoInline = Right ()
      reviewer x = Left x

_Inline :: Prism' Inline ()
_Inline
  = prism remitter reviewer
  where
      remitter () = Inline
      reviewer Inline = Right ()
      reviewer x = Left x

_Inlinable :: Prism' Inline ()
_Inlinable
  = prism remitter reviewer
  where
      remitter () = Inlinable
      reviewer Inlinable = Right ()
      reviewer x = Left x

_ConLike :: Prism' RuleMatch ()
_ConLike
  = prism remitter reviewer
  where
      remitter () = ConLike
      reviewer ConLike = Right ()
      reviewer x = Left x

_FunLike :: Prism' RuleMatch ()
_FunLike
  = prism remitter reviewer
  where
      remitter () = FunLike
      reviewer FunLike = Right ()
      reviewer x = Left x

_AllPhases :: Prism' Phases ()
_AllPhases
  = prism remitter reviewer
  where
      remitter () = AllPhases
      reviewer AllPhases = Right ()
      reviewer x = Left x

_FromPhase :: Prism' Phases Int
_FromPhase
  = prism remitter reviewer
  where
      remitter = FromPhase
      reviewer (FromPhase x) = Right x
      reviewer x = Left x

_BeforePhase :: Prism' Phases Int
_BeforePhase
  = prism remitter reviewer
  where
      remitter = BeforePhase
      reviewer (BeforePhase x) = Right x
      reviewer x = Left x

_RuleVar :: Prism' RuleBndr Name
_RuleVar
  = prism remitter reviewer
  where
      remitter = RuleVar
      reviewer (RuleVar x) = Right x
      reviewer x = Left x

_TypedRuleVar :: Prism' RuleBndr (Name, Type)
_TypedRuleVar
  = prism remitter reviewer
  where
      remitter (x, y) = TypedRuleVar x y
      reviewer (TypedRuleVar x y) = Right (x, y)
      reviewer x = Left x
#endif

#if MIN_VERSION_template_haskell(2,9,0)
_ModuleAnnotation :: Prism' AnnTarget ()
_ModuleAnnotation
  = prism remitter reviewer
  where
      remitter () = ModuleAnnotation
      reviewer ModuleAnnotation
        = Right ()
      reviewer x = Left x

_TypeAnnotation :: Prism' AnnTarget Name
_TypeAnnotation
  = prism remitter reviewer
  where
      remitter = TypeAnnotation
      reviewer (TypeAnnotation x)
        = Right x
      reviewer x = Left x

_ValueAnnotation :: Prism' AnnTarget Name
_ValueAnnotation
  = prism remitter reviewer
  where
      remitter = ValueAnnotation
      reviewer (ValueAnnotation x) = Right x
      reviewer x = Left x
#endif

_FunDep :: Prism' FunDep ([Name], [Name])
_FunDep
  = prism remitter reviewer
  where
      remitter (x, y) = FunDep x y
      reviewer (FunDep x y) = Right (x, y)

_TypeFam :: Prism' FamFlavour ()
_TypeFam
  = prism remitter reviewer
  where
      remitter () = TypeFam
      reviewer TypeFam = Right ()
      reviewer x = Left x

_DataFam :: Prism' FamFlavour ()
_DataFam
  = prism remitter reviewer
  where
      remitter () = DataFam
      reviewer DataFam = Right ()
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,9,0)
tySynEqnPatterns :: Lens' TySynEqn [Type]
tySynEqnPatterns = lens g s where
   g (TySynEqn xs _)    = xs
   s (TySynEqn _  y) xs = (TySynEqn xs y)

tySynEqnResult :: Lens' TySynEqn Type
tySynEqnResult = lens g s where
   g (TySynEqn _  x) = x
   s (TySynEqn xs _) = TySynEqn xs
#endif

_InfixL :: Prism' FixityDirection ()
_InfixL
  = prism remitter reviewer
  where
      remitter () = InfixL
      reviewer InfixL = Right ()
      reviewer x = Left x

_InfixR :: Prism' FixityDirection ()
_InfixR
  = prism remitter reviewer
  where
      remitter () = InfixR
      reviewer InfixR = Right ()
      reviewer x = Left x

_InfixN :: Prism' FixityDirection ()
_InfixN
  = prism remitter reviewer
  where
      remitter () = InfixN
      reviewer InfixN = Right ()
      reviewer x = Left x

_VarE :: Prism' Exp Name
_VarE
  = prism remitter reviewer
  where
      remitter = VarE
      reviewer (VarE x) = Right x
      reviewer x = Left x

_ConE :: Prism' Exp Name
_ConE
  = prism remitter reviewer
  where
      remitter = ConE
      reviewer (ConE x) = Right x
      reviewer x = Left x

_LitE :: Prism' Exp Lit
_LitE
  = prism remitter reviewer
  where
      remitter = LitE
      reviewer (LitE x) = Right x
      reviewer x = Left x

_AppE :: Prism' Exp (Exp, Exp)
_AppE
  = prism remitter reviewer
  where
      remitter (x, y) = AppE x y
      reviewer (AppE x y) = Right (x, y)
      reviewer x = Left x

_InfixE :: Prism' Exp (Maybe Exp, Exp, Maybe Exp)
_InfixE
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = InfixE x y z
      reviewer (InfixE x y z)
        = Right (x, y, z)
      reviewer x = Left x

_UInfixE :: Prism' Exp (Exp, Exp, Exp)
_UInfixE
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = UInfixE x y z
      reviewer (UInfixE x y z)
        = Right (x, y, z)
      reviewer x = Left x

_ParensE :: Prism' Exp Exp
_ParensE
  = prism remitter reviewer
  where
      remitter = ParensE
      reviewer (ParensE x) = Right x
      reviewer x = Left x

_LamE :: Prism' Exp ([Pat], Exp)
_LamE
  = prism remitter reviewer
  where
      remitter (x, y) = LamE x y
      reviewer (LamE x y) = Right (x, y)
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_LamCaseE :: Prism' Exp [Match]
_LamCaseE
  = prism remitter reviewer
  where
      remitter = LamCaseE
      reviewer (LamCaseE x) = Right x
      reviewer x = Left x
#endif

_TupE :: Prism' Exp [Exp]
_TupE
  = prism remitter reviewer
  where
      remitter = TupE
      reviewer (TupE x) = Right x
      reviewer x = Left x

_UnboxedTupE :: Prism' Exp [Exp]
_UnboxedTupE
  = prism remitter reviewer
  where
      remitter = UnboxedTupE
      reviewer (UnboxedTupE x) = Right x
      reviewer x = Left x

_CondE :: Prism' Exp (Exp, Exp, Exp)
_CondE
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = CondE x y z
      reviewer (CondE x y z)
        = Right (x, y, z)
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_MultiIfE :: Prism' Exp [(Guard, Exp)]
_MultiIfE
  = prism remitter reviewer
  where
      remitter = MultiIfE
      reviewer (MultiIfE x) = Right x
      reviewer x = Left x
#endif

_LetE :: Prism' Exp ([Dec], Exp)
_LetE
  = prism remitter reviewer
  where
      remitter (x, y) = LetE x y
      reviewer (LetE x y) = Right (x, y)
      reviewer x = Left x

_CaseE :: Prism' Exp (Exp, [Match])
_CaseE
  = prism remitter reviewer
  where
      remitter (x, y) = CaseE x y
      reviewer (CaseE x y) = Right (x, y)
      reviewer x = Left x

_DoE :: Prism' Exp [Stmt]
_DoE
  = prism remitter reviewer
  where
      remitter = DoE
      reviewer (DoE x) = Right x
      reviewer x = Left x

_CompE :: Prism' Exp [Stmt]
_CompE
  = prism remitter reviewer
  where
      remitter = CompE
      reviewer (CompE x) = Right x
      reviewer x = Left x

_ArithSeqE :: Prism' Exp Range
_ArithSeqE
  = prism remitter reviewer
  where
      remitter = ArithSeqE
      reviewer (ArithSeqE x) = Right x
      reviewer x = Left x

_ListE :: Prism' Exp [Exp]
_ListE
  = prism remitter reviewer
  where
      remitter = ListE
      reviewer (ListE x) = Right x
      reviewer x = Left x

_SigE :: Prism' Exp (Exp, Type)
_SigE
  = prism remitter reviewer
  where
      remitter (x, y) = SigE x y
      reviewer (SigE x y) = Right (x, y)
      reviewer x = Left x

_RecConE :: Prism' Exp (Name, [FieldExp])
_RecConE
  = prism remitter reviewer
  where
      remitter (x, y) = RecConE x y
      reviewer (RecConE x y) = Right (x, y)
      reviewer x = Left x

_RecUpdE :: Prism' Exp (Exp, [FieldExp])
_RecUpdE
  = prism remitter reviewer
  where
      remitter (x, y) = RecUpdE x y
      reviewer (RecUpdE x y) = Right (x, y)
      reviewer x = Left x

_GuardedB :: Prism' Body [(Guard, Exp)]
_GuardedB
  = prism remitter reviewer
  where
      remitter = GuardedB
      reviewer (GuardedB x) = Right x
      reviewer x = Left x

_NormalB :: Prism' Body Exp
_NormalB
  = prism remitter reviewer
  where
      remitter = NormalB
      reviewer (NormalB x) = Right x
      reviewer x = Left x

_NormalG :: Prism' Guard Exp
_NormalG
  = prism remitter reviewer
  where
      remitter = NormalG
      reviewer (NormalG x) = Right x
      reviewer x = Left x

_PatG :: Prism' Guard [Stmt]
_PatG
  = prism remitter reviewer
  where
      remitter = PatG
      reviewer (PatG x) = Right x
      reviewer x = Left x

_BindS :: Prism' Stmt (Pat, Exp)
_BindS
  = prism remitter reviewer
  where
      remitter (x, y) = BindS x y
      reviewer (BindS x y) = Right (x, y)
      reviewer x = Left x

_LetS :: Prism' Stmt [Dec]
_LetS
  = prism remitter reviewer
  where
      remitter = LetS
      reviewer (LetS x) = Right x
      reviewer x = Left x

_NoBindS :: Prism' Stmt Exp
_NoBindS
  = prism remitter reviewer
  where
      remitter = NoBindS
      reviewer (NoBindS x) = Right x
      reviewer x = Left x

_ParS :: Prism' Stmt [[Stmt]]
_ParS
  = prism remitter reviewer
  where
      remitter = ParS
      reviewer (ParS x) = Right x
      reviewer x = Left x

_FromR :: Prism' Range Exp
_FromR
  = prism remitter reviewer
  where
      remitter = FromR
      reviewer (FromR x) = Right x
      reviewer x = Left x

_FromThenR :: Prism' Range (Exp, Exp)
_FromThenR
  = prism remitter reviewer
  where
      remitter (x, y) = FromThenR x y
      reviewer (FromThenR x y)
        = Right (x, y)
      reviewer x = Left x

_FromToR :: Prism' Range (Exp, Exp)
_FromToR
  = prism remitter reviewer
  where
      remitter (x, y) = FromToR x y
      reviewer (FromToR x y) = Right (x, y)
      reviewer x = Left x

_FromThenToR :: Prism' Range (Exp, Exp, Exp)
_FromThenToR
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = FromThenToR x y z
      reviewer (FromThenToR x y z)
        = Right (x, y, z)
      reviewer x = Left x

_CharL :: Prism' Lit Char
_CharL
  = prism remitter reviewer
  where
      remitter = CharL
      reviewer (CharL x) = Right x
      reviewer x = Left x

_StringL :: Prism' Lit String
_StringL
  = prism remitter reviewer
  where
      remitter = StringL
      reviewer (StringL x) = Right x
      reviewer x = Left x

_IntegerL :: Prism' Lit Integer
_IntegerL
  = prism remitter reviewer
  where
      remitter = IntegerL
      reviewer (IntegerL x) = Right x
      reviewer x = Left x

_RationalL :: Prism' Lit Rational
_RationalL
  = prism remitter reviewer
  where
      remitter = RationalL
      reviewer (RationalL x) = Right x
      reviewer x = Left x

_IntPrimL :: Prism' Lit Integer
_IntPrimL
  = prism remitter reviewer
  where
      remitter = IntPrimL
      reviewer (IntPrimL x) = Right x
      reviewer x = Left x

_WordPrimL :: Prism' Lit Integer
_WordPrimL
  = prism remitter reviewer
  where
      remitter = WordPrimL
      reviewer (WordPrimL x) = Right x
      reviewer x = Left x

_FloatPrimL :: Prism' Lit Rational
_FloatPrimL
  = prism remitter reviewer
  where
      remitter = FloatPrimL
      reviewer (FloatPrimL x) = Right x
      reviewer x = Left x

_DoublePrimL :: Prism' Lit Rational
_DoublePrimL
  = prism remitter reviewer
  where
      remitter = DoublePrimL
      reviewer (DoublePrimL x) = Right x
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_StringPrimL :: Prism' Lit [Word8]
_StringPrimL
  = prism remitter reviewer
  where
      remitter = StringPrimL
      reviewer (StringPrimL x) = Right x
      reviewer x = Left x
#else
_StringPrimL :: Prism' Lit String
_StringPrimL
  = prism remitter reviewer
  where
      remitter = StringPrimL
      reviewer (StringPrimL x) = Right x
      reviewer x = Left x
#endif

_LitP :: Prism' Pat Lit
_LitP
  = prism remitter reviewer
  where
      remitter = LitP
      reviewer (LitP x) = Right x
      reviewer x = Left x

_VarP :: Prism' Pat Name
_VarP
  = prism remitter reviewer
  where
      remitter = VarP
      reviewer (VarP x) = Right x
      reviewer x = Left x

_TupP :: Prism' Pat [Pat]
_TupP
  = prism remitter reviewer
  where
      remitter = TupP
      reviewer (TupP x) = Right x
      reviewer x = Left x

_UnboxedTupP :: Prism' Pat [Pat]
_UnboxedTupP
  = prism remitter reviewer
  where
      remitter = UnboxedTupP
      reviewer (UnboxedTupP x) = Right x
      reviewer x = Left x

_ConP :: Prism' Pat (Name, [Pat])
_ConP
  = prism remitter reviewer
  where
      remitter (x, y) = ConP x y
      reviewer (ConP x y) = Right (x, y)
      reviewer x = Left x

_InfixP :: Prism' Pat (Pat, Name, Pat)
_InfixP
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = InfixP x y z
      reviewer (InfixP x y z)
        = Right (x, y, z)
      reviewer x = Left x
_UInfixP :: Prism' Pat (Pat, Name, Pat)
_UInfixP
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = UInfixP x y z
      reviewer (UInfixP x y z)
        = Right (x, y, z)
      reviewer x = Left x

_ParensP :: Prism' Pat Pat
_ParensP
  = prism remitter reviewer
  where
      remitter = ParensP
      reviewer (ParensP x) = Right x
      reviewer x = Left x

_TildeP :: Prism' Pat Pat
_TildeP
  = prism remitter reviewer
  where
      remitter = TildeP
      reviewer (TildeP x) = Right x
      reviewer x = Left x

_BangP :: Prism' Pat Pat
_BangP
  = prism remitter reviewer
  where
      remitter = BangP
      reviewer (BangP x) = Right x
      reviewer x = Left x

_AsP :: Prism' Pat (Name, Pat)
_AsP
  = prism remitter reviewer
  where
      remitter (x, y) = AsP x y
      reviewer (AsP x y) = Right (x, y)
      reviewer x = Left x

_WildP :: Prism' Pat ()
_WildP
  = prism remitter reviewer
  where
      remitter () = WildP
      reviewer WildP = Right ()
      reviewer x = Left x

_RecP :: Prism' Pat (Name, [FieldPat])
_RecP
  = prism remitter reviewer
  where
      remitter (x, y) = RecP x y
      reviewer (RecP x y) = Right (x, y)
      reviewer x = Left x

_ListP :: Prism' Pat [Pat]
_ListP
  = prism remitter reviewer
  where
      remitter = ListP
      reviewer (ListP x) = Right x
      reviewer x = Left x

_SigP :: Prism' Pat (Pat, Type)
_SigP
  = prism remitter reviewer
  where
      remitter (x, y) = SigP x y
      reviewer (SigP x y) = Right (x, y)
      reviewer x = Left x

_ViewP :: Prism' Pat (Exp, Pat)
_ViewP
  = prism remitter reviewer
  where
      remitter (x, y) = ViewP x y
      reviewer (ViewP x y) = Right (x, y)
      reviewer x = Left x

_ForallT :: Prism' Type ([TyVarBndr], Cxt, Type)
_ForallT
  = prism remitter reviewer
  where
      remitter (x, y, z)
        = ForallT x y z
      reviewer (ForallT x y z)
        = Right (x, y, z)
      reviewer x = Left x

_AppT :: Prism' Type (Type, Type)
_AppT
  = prism remitter reviewer
  where
      remitter (x, y) = AppT x y
      reviewer (AppT x y) = Right (x, y)
      reviewer x = Left x

_SigT :: Prism' Type (Type, Kind)
_SigT
  = prism remitter reviewer
  where
      remitter (x, y) = SigT x y
      reviewer (SigT x y) = Right (x, y)
      reviewer x = Left x

_VarT :: Prism' Type Name
_VarT
  = prism remitter reviewer
  where
      remitter = VarT
      reviewer (VarT x) = Right x
      reviewer x = Left x

_ConT :: Prism' Type Name
_ConT
  = prism remitter reviewer
  where
      remitter = ConT
      reviewer (ConT x) = Right x
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_PromotedT :: Prism' Type Name
_PromotedT
  = prism remitter reviewer
  where
      remitter = PromotedT
      reviewer (PromotedT x) = Right x
      reviewer x = Left x
#endif

_TupleT :: Prism' Type Int
_TupleT
  = prism remitter reviewer
  where
      remitter = TupleT
      reviewer (TupleT x) = Right x
      reviewer x = Left x

_UnboxedTupleT :: Prism' Type Int
_UnboxedTupleT
  = prism remitter reviewer
  where
      remitter = UnboxedTupleT
      reviewer (UnboxedTupleT x) = Right x
      reviewer x = Left x

_ArrowT :: Prism' Type ()
_ArrowT
  = prism remitter reviewer
  where
      remitter () = ArrowT
      reviewer ArrowT = Right ()
      reviewer x = Left x

_ListT :: Prism' Type ()
_ListT
  = prism remitter reviewer
  where
      remitter () = ListT
      reviewer ListT = Right ()
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_PromotedTupleT :: Prism' Type Int
_PromotedTupleT
  = prism remitter reviewer
  where
      remitter = PromotedTupleT
      reviewer (PromotedTupleT x) = Right x
      reviewer x = Left x

_PromotedNilT :: Prism' Type ()
_PromotedNilT
  = prism remitter reviewer
  where
      remitter () = PromotedNilT
      reviewer PromotedNilT = Right ()
      reviewer x = Left x

_PromotedConsT :: Prism' Type ()
_PromotedConsT
  = prism remitter reviewer
  where
      remitter () = PromotedConsT
      reviewer PromotedConsT = Right ()
      reviewer x = Left x

_StarT :: Prism' Type ()
_StarT
  = prism remitter reviewer
  where
      remitter () = StarT
      reviewer StarT = Right ()
      reviewer x = Left x

_ConstraintT :: Prism' Type ()
_ConstraintT
  = prism remitter reviewer
  where
      remitter () = ConstraintT
      reviewer ConstraintT = Right ()
      reviewer x = Left x

_LitT :: Prism' Type TyLit
_LitT
  = prism remitter reviewer
  where
      remitter x = LitT x
      reviewer (LitT x) = Right x
      reviewer x = Left x
#endif

_PlainTV :: Prism' TyVarBndr Name
_PlainTV
  = prism remitter reviewer
  where
      remitter = PlainTV
      reviewer (PlainTV x) = Right x
      reviewer x = Left x

_KindedTV :: Prism' TyVarBndr (Name, Kind)
_KindedTV
  = prism remitter reviewer
  where
      remitter (x, y) = KindedTV x y
      reviewer (KindedTV x y) = Right (x, y)
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,8,0)
_NumTyLit :: Prism' TyLit Integer
_NumTyLit
  = prism remitter reviewer
  where
      remitter = NumTyLit
      reviewer (NumTyLit x) = Right x
      reviewer x = Left x

_StrTyLit :: Prism' TyLit String
_StrTyLit
  = prism remitter reviewer
  where
      remitter = StrTyLit
      reviewer (StrTyLit x) = Right x
      reviewer x = Left x
#endif

_ClassP :: Prism' Pred (Name, [Type])
_ClassP
  = prism remitter reviewer
  where
      remitter (x, y) = ClassP x y
      reviewer (ClassP x y) = Right (x, y)
      reviewer x = Left x

_EqualP :: Prism' Pred (Type, Type)
_EqualP
  = prism remitter reviewer
  where
      remitter (x, y) = EqualP x y
      reviewer (EqualP x y) = Right (x, y)
      reviewer x = Left x

#if MIN_VERSION_template_haskell(2,9,0)
_NominalR :: Prism' Role ()
_NominalR
  = prism remitter reviewer
  where
      remitter () = NominalR
      reviewer NominalR = Right ()
      reviewer x = Left x

_RepresentationalR :: Prism' Role ()
_RepresentationalR
  = prism remitter reviewer
  where
      remitter () = RepresentationalR
      reviewer RepresentationalR = Right ()
      reviewer x = Left x

_PhantomR :: Prism' Role ()
_PhantomR
  = prism remitter reviewer
  where
      remitter () = PhantomR
      reviewer PhantomR = Right ()
      reviewer x = Left x

_InferR :: Prism' Role ()
_InferR
  = prism remitter reviewer
  where
      remitter () = InferR
      reviewer InferR = Right ()
      reviewer x = Left x
#endif