    {-# LANGUAGE CPP                  #-}
    {-# LANGUAGE FlexibleInstances    #-}
    {-# LANGUAGE TemplateHaskell      #-}
    {-# LANGUAGE TypeSynonymInstances #-}

    {- |
      Module      :  Language.Haskell.Meta.Syntax.Translate
      Copyright   :  (c) Matt Morrow 2008
      License     :  BSD3
      Maintainer  :  Matt Morrow <mjm2002@gmail.com>
      Stability   :  experimental
      Portability :  portable (template-haskell)
    -}

    module Language.Haskell.Meta.Syntax.Translate (
        module Language.Haskell.Meta.Syntax.Translate
      , TyVarBndr_
    ) where

    import qualified Data.Char                      as Char
    import qualified Data.List                      as List
    import qualified Language.Haskell.Exts.SrcLoc   as Exts.SrcLoc
    import qualified Language.Haskell.Exts.Syntax   as Exts
    import           Language.Haskell.Meta.THCompat (TyVarBndr_)
    import qualified Language.Haskell.Meta.THCompat as Compat
    import qualified Language.Haskell.TH.Lib        as TH
    import qualified Language.Haskell.TH.Syntax     as TH

    -----------------------------------------------------------------------------

    class ToName a where toName :: a -> TH.Name
    class ToNames a where toNames :: a -> [TH.Name]
    class ToLit  a where toLit  :: a -> TH.Lit
    class ToType a where toType :: a -> TH.Type
    class ToPat  a where toPat  :: a -> TH.Pat
    class ToExp  a where toExp  :: a -> TH.Exp
    class ToDecs a where toDecs :: a -> [TH.Dec]
    class ToDec  a where toDec  :: a -> TH.Dec
    class ToStmt a where toStmt :: a -> TH.Stmt
    class ToLoc  a where toLoc  :: a -> TH.Loc
    class ToCxt  a where toCxt  :: a -> TH.Cxt
    class ToPred a where toPred :: a -> TH.Pred
    class ToTyVars a where toTyVars :: a -> [TyVarBndr_ ()]
    class ToMaybeKind a where toMaybeKind :: a -> Maybe TH.Kind
    class ToInjectivityAnn a where toInjectivityAnn :: a -> TH.InjectivityAnn

    type DerivClause = TH.DerivClause

    class ToDerivClauses a where toDerivClauses :: a -> [DerivClause]

    -- for error messages
    moduleName :: String
    moduleName :: String
    moduleName = String
    "Language.Haskell.Meta.Syntax.Translate"

    -- When to use each of these isn't always clear: prefer 'todo' if unsure.
    noTH :: (Functor f, Show (f ())) => String -> f e -> a
    noTH :: forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    fun f e
    thing = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> ([String] -> String) -> [String] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> a) -> [String] -> a
    forall a b. (a -> b) -> a -> b
    $ [String
    moduleName, String
    ".", String
    fun,
      String
    ": template-haskell has no representation for: ", f () -> String
    forall a. Show a => a -> String
    show ((e -> ()) -> f e -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> e -> ()
    forall a b. a -> b -> a
    const ()) f e
    thing)]

    noTHyet :: (Functor f, Show (f ())) => String -> String -> f e -> a
    noTHyet :: forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> String -> f e -> a
    noTHyet String
    fun String
    minVersion f e
    thing = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> ([String] -> String) -> [String] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> a) -> [String] -> a
    forall a b. (a -> b) -> a -> b
    $ [String
    moduleName, String
    ".", String
    fun,
      String
    ": template-haskell-", VERSION_template_haskell, " (< ", minVersion, ")",
      String
    " has no representation for: ", f () -> String
    forall a. Show a => a -> String
    show ((e -> ()) -> f e -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> e -> ()
    forall a b. a -> b -> a
    const ()) f e
    thing)]

    todo :: (Functor f, Show (f ())) => String -> f e -> a
    todo :: forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    fun f e
    thing = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> ([String] -> String) -> [String] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> a) -> [String] -> a
    forall a b. (a -> b) -> a -> b
    $ [String
    moduleName, String
    ".", String
    fun,
      String
    ": not implemented: ", f () -> String
    forall a. Show a => a -> String
    show ((e -> ()) -> f e -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> e -> ()
    forall a b. a -> b -> a
    const ()) f e
    thing)]

    nonsense :: (Functor f, Show (f ())) => String -> String -> f e -> a
    nonsense :: forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> String -> f e -> a
    nonsense String
    fun String
    inparticular f e
    thing = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> ([String] -> String) -> [String] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> a) -> [String] -> a
    forall a b. (a -> b) -> a -> b
    $ [String
    moduleName, String
    ".", String
    fun,
      String
    ": nonsensical: ", String
    inparticular, String
    ": ", f () -> String
    forall a. Show a => a -> String
    show ((e -> ()) -> f e -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> e -> ()
    forall a b. a -> b -> a
    const ()) f e
    thing)]

    #if MIN_VERSION_template_haskell(2,16,0)
    toTupEl :: ToExp a => a -> Maybe TH.Exp
    toTupEl :: forall a. ToExp a => a -> Maybe Exp
    toTupEl = Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> (a -> Exp) -> a -> Maybe Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Exp
    forall a. ToExp a => a -> Exp
    toExp
    #else
    toTupEl :: ToExp a => a -> TH.Exp
    toTupEl = toExp
    #endif

    -----------------------------------------------------------------------------

    instance ToExp TH.Lit where
      toExp :: Lit -> Exp
    toExp = Lit -> Exp
    TH.LitE
    instance (ToExp a) => ToExp [a] where
      toExp :: [a] -> Exp
    toExp = [Exp] -> Exp
    TH.ListE ([Exp] -> Exp) -> ([a] -> [Exp]) -> [a] -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Exp) -> [a] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Exp
    forall a. ToExp a => a -> Exp
    toExp
    instance (ToExp a, ToExp b) => ToExp (a,b) where
      toExp :: (a, b) -> Exp
    toExp (a
    a,b
    b) = [Maybe Exp] -> Exp
    TH.TupE [a -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl a
    a, b -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl b
    b]
    instance (ToExp a, ToExp b, ToExp c) => ToExp (a,b,c) where
      toExp :: (a, b, c) -> Exp
    toExp (a
    a,b
    b,c
    c) = [Maybe Exp] -> Exp
    TH.TupE [a -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl a
    a, b -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl b
    b, c -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl c
    c]
    instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a,b,c,d) where
      toExp :: (a, b, c, d) -> Exp
    toExp (a
    a,b
    b,c
    c,d
    d) = [Maybe Exp] -> Exp
    TH.TupE [a -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl a
    a, b -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl b
    b, c -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl c
    c, d -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl d
    d]

    instance ToPat TH.Lit where
      toPat :: Lit -> Pat
    toPat = Lit -> Pat
    TH.LitP
    instance (ToPat a) => ToPat [a] where
      toPat :: [a] -> Pat
    toPat = [Pat] -> Pat
    TH.ListP ([Pat] -> Pat) -> ([a] -> [Pat]) -> [a] -> Pat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Pat) -> [a] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Pat
    forall a. ToPat a => a -> Pat
    toPat
    instance (ToPat a, ToPat b) => ToPat (a,b) where
      toPat :: (a, b) -> Pat
    toPat (a
    a,b
    b) = [Pat] -> Pat
    TH.TupP [a -> Pat
    forall a. ToPat a => a -> Pat
    toPat a
    a, b -> Pat
    forall a. ToPat a => a -> Pat
    toPat b
    b]
    instance (ToPat a, ToPat b, ToPat c) => ToPat (a,b,c) where
      toPat :: (a, b, c) -> Pat
    toPat (a
    a,b
    b,c
    c) = [Pat] -> Pat
    TH.TupP [a -> Pat
    forall a. ToPat a => a -> Pat
    toPat a
    a, b -> Pat
    forall a. ToPat a => a -> Pat
    toPat b
    b, c -> Pat
    forall a. ToPat a => a -> Pat
    toPat c
    c]
    instance (ToPat a, ToPat b, ToPat c, ToPat d) => ToPat (a,b,c,d) where
      toPat :: (a, b, c, d) -> Pat
    toPat (a
    a,b
    b,c
    c,d
    d) = [Pat] -> Pat
    TH.TupP [a -> Pat
    forall a. ToPat a => a -> Pat
    toPat a
    a, b -> Pat
    forall a. ToPat a => a -> Pat
    toPat b
    b, c -> Pat
    forall a. ToPat a => a -> Pat
    toPat c
    c, d -> Pat
    forall a. ToPat a => a -> Pat
    toPat d
    d]

    instance ToLit Char where
      toLit :: Char -> Lit
    toLit = Char -> Lit
    TH.CharL
    instance ToLit String where
      toLit :: String -> Lit
    toLit = String -> Lit
    TH.StringL
    instance ToLit Integer where
      toLit :: Integer -> Lit
    toLit = Integer -> Lit
    TH.IntegerL
    instance ToLit Int where
      toLit :: Int -> Lit
    toLit = Integer -> Lit
    TH.IntegerL (Integer -> Lit) -> (Int -> Integer) -> Int -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger
    instance ToLit Float where
      toLit :: Float -> Lit
    toLit = Rational -> Lit
    TH.RationalL (Rational -> Lit) -> (Float -> Rational) -> Float -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Float -> Rational
    forall a. Real a => a -> Rational
    toRational
    instance ToLit Double where
      toLit :: Double -> Lit
    toLit = Rational -> Lit
    TH.RationalL (Rational -> Lit) -> (Double -> Rational) -> Double -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> Rational
    forall a. Real a => a -> Rational
    toRational

    -----------------------------------------------------------------------------

    -- * ToName {String,HsName,Module,HsSpecialCon,HsQName}

    instance ToName String where
      toName :: String -> Name
    toName = String -> Name
    TH.mkName

    instance ToName (Exts.Name l) where
      toName :: Name l -> Name
    toName (Exts.Ident l
    _ String
    s)  = String -> Name
    forall a. ToName a => a -> Name
    toName String
    s
      toName (Exts.Symbol l
    _ String
    s) = String -> Name
    forall a. ToName a => a -> Name
    toName String
    s

    instance ToName (Exts.SpecialCon l) where
      toName :: SpecialCon l -> Name
    toName (Exts.UnitCon l
    _) = String -> Name
    TH.mkName String
    "()" -- TODO LumiGuide: '()
      toName (Exts.ListCon l
    _) = ''[] -- Parser only uses this in types -- TODO LumiGuide: '[]
      toName (Exts.FunCon l
    _)  = ''(->)
      toName (Exts.TupleCon l
    _ Boxed
    _ Int
    n) =
        String -> Name
    TH.mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    "(",Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ',',String
    ")"]
        -- TODO LumiGuide:
        -- .
        -- .| n<2 = '()
        -- .| otherwise =
        -- .  let x = maybe [] (++".") (nameModule '(,))
        -- .  in TH.mkName . concat $ x : ["(",replicate (n-1) ',',")"]
      toName (Exts.Cons l
    _)    = '(:)
      toName SpecialCon l
    h = String -> SpecialCon l -> Name
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toName not implemented" SpecialCon l
    h
      -- TODO
      -- toName (Exts.UnboxedSingleCon _) = ''
      -- toName (Exts.ExprHole _) = ''_

    instance ToName (Exts.QName l) where
    -- TODO: why is this commented out?
    --  toName (Exts.Qual (Exts.Module []) n) = toName n
      toName :: QName l -> Name
    toName (Exts.Qual l
    _ (Exts.ModuleName l
    _ []) Name l
    n) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n
      toName (Exts.Qual l
    _ (Exts.ModuleName l
    _ String
    m) Name l
    n) =
        let m' :: String
    m' = Name -> String
    forall a. Show a => a -> String
    show (Name -> String) -> (String -> Name) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    forall a. ToName a => a -> Name
    toName (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    m
            n' :: String
    n' = Name -> String
    forall a. Show a => a -> String
    show (Name -> String) -> (Name l -> Name) -> Name l -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name l -> Name
    forall a. ToName a => a -> Name
    toName (Name l -> String) -> Name l -> String
    forall a b. (a -> b) -> a -> b
    $ Name l
    n
        in String -> Name
    forall a. ToName a => a -> Name
    toName (String -> Name) -> ([String] -> String) -> [String] -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> Name) -> [String] -> Name
    forall a b. (a -> b) -> a -> b
    $ [String
    m',String
    ".",String
    n']
      toName (Exts.UnQual l
    _ Name l
    n) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n
      toName (Exts.Special l
    _ SpecialCon l
    s) = SpecialCon l -> Name
    forall a. ToName a => a -> Name
    toName SpecialCon l
    s

    #if MIN_VERSION_haskell_src_exts(1,20,1)
    instance ToName (Exts.MaybePromotedName l) where
      toName :: MaybePromotedName l -> Name
    toName (Exts.PromotedName   l
    _ QName l
    qn) = QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    qn
      toName (Exts.UnpromotedName l
    _ QName l
    qn) = QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    qn
    #endif

    instance ToName (Exts.Op l) where
      toName :: Op l -> Name
    toName (Exts.VarOp l
    _ Name l
    n) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n
      toName (Exts.ConOp l
    _ Name l
    n) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n

    -----------------------------------------------------------------------------

    -- * ToLit HsLiteral

    instance ToLit (Exts.Literal l) where
      toLit :: Literal l -> Lit
    toLit (Exts.Char l
    _ Char
    a String
    _) = Char -> Lit
    TH.CharL Char
    a
      toLit (Exts.String l
    _ String
    a String
    _) = String -> Lit
    TH.StringL String
    a
      toLit (Exts.Int l
    _ Integer
    a String
    _) = Integer -> Lit
    TH.IntegerL Integer
    a
      toLit (Exts.Frac l
    _ Rational
    a String
    _) = Rational -> Lit
    TH.RationalL Rational
    a
      toLit l :: Literal l
    l@Exts.PrimChar{} = String -> Literal l -> Lit
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toLit" Literal l
    l
      toLit (Exts.PrimString l
    _ String
    a String
    _) = [Word8] -> Lit
    TH.StringPrimL ((Char -> Word8) -> String -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Word8
    toWord8 String
    a)
       where
        toWord8 :: Char -> Word8
    toWord8 = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    Char.ord
      toLit (Exts.PrimInt l
    _ Integer
    a String
    _) = Integer -> Lit
    TH.IntPrimL Integer
    a
      toLit (Exts.PrimFloat l
    _ Rational
    a String
    _) = Rational -> Lit
    TH.FloatPrimL Rational
    a
      toLit (Exts.PrimDouble l
    _ Rational
    a String
    _) = Rational -> Lit
    TH.DoublePrimL Rational
    a
      toLit (Exts.PrimWord l
    _ Integer
    a String
    _) = Integer -> Lit
    TH.WordPrimL Integer
    a

    -----------------------------------------------------------------------------

    -- * ToPat HsPat

    instance ToPat (Exts.Pat l) where
      toPat :: Pat l -> Pat
    toPat (Exts.PVar l
    _ Name l
    n)
        = Name -> Pat
    TH.VarP (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n)
      toPat (Exts.PLit l
    _ (Exts.Signless l
    _) Literal l
    l)
        = Lit -> Pat
    TH.LitP (Literal l -> Lit
    forall a. ToLit a => a -> Lit
    toLit Literal l
    l)
      toPat (Exts.PLit l
    _ (Exts.Negative l
    _) Literal l
    l) = Lit -> Pat
    TH.LitP (Lit -> Pat) -> Lit -> Pat
    forall a b. (a -> b) -> a -> b
    $ case Literal l -> Lit
    forall a. ToLit a => a -> Lit
    toLit Literal l
    l of
        TH.IntegerL Integer
    z      -> Integer -> Lit
    TH.IntegerL (Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    z)
        TH.RationalL Rational
    q     -> Rational -> Lit
    TH.RationalL (Rational -> Rational
    forall a. Num a => a -> a
    negate Rational
    q)
        TH.IntPrimL Integer
    z'     -> Integer -> Lit
    TH.IntPrimL (Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    z')
        TH.FloatPrimL Rational
    r'   -> Rational -> Lit
    TH.FloatPrimL (Rational -> Rational
    forall a. Num a => a -> a
    negate Rational
    r')
        TH.DoublePrimL Rational
    r'' -> Rational -> Lit
    TH.DoublePrimL (Rational -> Rational
    forall a. Num a => a -> a
    negate Rational
    r'')
        Lit
    _                  -> String -> String -> Literal l -> Lit
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> String -> f e -> a
    nonsense String
    "toPat" String
    "negating wrong kind of literal" Literal l
    l
      toPat (Exts.PInfixApp l
    _ Pat l
    p QName l
    n Pat l
    q) = Pat -> Name -> Pat -> Pat
    TH.UInfixP (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p) (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n) (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    q)
      toPat (Exts.PApp l
    _ QName l
    n [Pat l]
    ps) = Name -> [Pat] -> Pat
    Compat.conP (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n) ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat [Pat l]
    ps)
      toPat (Exts.PTuple l
    _ Boxed
    Exts.Boxed [Pat l]
    ps) = [Pat] -> Pat
    TH.TupP ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat [Pat l]
    ps)
      toPat (Exts.PTuple l
    _ Boxed
    Exts.Unboxed [Pat l]
    ps) = [Pat] -> Pat
    TH.UnboxedTupP ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat [Pat l]
    ps)
      toPat (Exts.PList l
    _ [Pat l]
    ps) = [Pat] -> Pat
    TH.ListP ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat [Pat l]
    ps)
      toPat (Exts.PParen l
    _ Pat l
    p) = Pat -> Pat
    TH.ParensP (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p)
      -- TODO: move toFieldPat to top level defn
      toPat (Exts.PRec l
    _ QName l
    n [PatField l]
    pfs) = let toFieldPat :: PatField e -> (Name, Pat)
    toFieldPat (Exts.PFieldPat e
    _ QName e
    n' Pat e
    p) = (QName e -> Name
    forall a. ToName a => a -> Name
    toName QName e
    n', Pat e -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat e
    p)
                                      toFieldPat PatField e
    h = String -> PatField e -> (Name, Pat)
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toFieldPat" PatField e
    h
                                in Name -> [(Name, Pat)] -> Pat
    TH.RecP (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n) ((PatField l -> (Name, Pat)) -> [PatField l] -> [(Name, Pat)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PatField l -> (Name, Pat)
    forall {e}. PatField e -> (Name, Pat)
    toFieldPat [PatField l]
    pfs)
      toPat (Exts.PAsPat l
    _ Name l
    n Pat l
    p) = Name -> Pat -> Pat
    TH.AsP (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p)
      toPat (Exts.PWildCard l
    _) = Pat
    TH.WildP
      toPat (Exts.PIrrPat l
    _ Pat l
    p) = Pat -> Pat
    TH.TildeP (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p)
      toPat (Exts.PatTypeSig l
    _ Pat l
    p Type l
    t) = Pat -> Type -> Pat
    TH.SigP (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)
      toPat (Exts.PViewPat l
    _ Exp l
    e Pat l
    p) = Exp -> Pat -> Pat
    TH.ViewP (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p)
      -- regular pattern
      toPat p :: Pat l
    p@Exts.PRPat{} = String -> Pat l -> Pat
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toPat" Pat l
    p
      -- XML stuff
      toPat p :: Pat l
    p@Exts.PXTag{} = String -> Pat l -> Pat
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toPat" Pat l
    p
      toPat p :: Pat l
    p@Exts.PXETag{} = String -> Pat l -> Pat
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toPat" Pat l
    p
      toPat p :: Pat l
    p@Exts.PXPcdata{} = String -> Pat l -> Pat
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toPat" Pat l
    p
      toPat p :: Pat l
    p@Exts.PXPatTag{} = String -> Pat l -> Pat
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toPat" Pat l
    p
      toPat (Exts.PBangPat l
    _ Pat l
    p) = Pat -> Pat
    TH.BangP (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p)
      toPat Pat l
    p = String -> Pat l -> Pat
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toPat" Pat l
    p
      -- TODO
                -- (Exts.PNPlusK _ _ _)
                -- (Exts.PUnboxedSum _ _ _ _)
                -- (Exts.PXRPats _ _)
                -- (Exts.PSplice _ _)
                -- ...

    -----------------------------------------------------------------------------

    -- * ToExp HsExp

    instance ToExp (Exts.QOp l) where
      toExp :: QOp l -> Exp
    toExp (Exts.QVarOp l
    _ QName l
    n) = Name -> Exp
    TH.VarE (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n)
      toExp (Exts.QConOp l
    _ QName l
    n) = Name -> Exp
    TH.ConE (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n)

    toFieldExp :: Exts.FieldUpdate l -> TH.FieldExp
    toFieldExp :: forall l. FieldUpdate l -> FieldExp
    toFieldExp (Exts.FieldUpdate l
    _ QName l
    n Exp l
    e) = (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n, Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
    toFieldExp FieldUpdate l
    h                        = String -> FieldUpdate l -> FieldExp
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toFieldExp" FieldUpdate l
    h

    instance ToExp (Exts.Exp l) where
      toExp :: Exp l -> Exp
    toExp (Exts.Var l
    _ QName l
    n)                 = Name -> Exp
    TH.VarE (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n)
      toExp e :: Exp l
    e@Exts.IPVar{}                 = String -> Exp l -> Exp
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toExp" Exp l
    e
      toExp (Exts.Con l
    _ QName l
    n)                 = Name -> Exp
    TH.ConE (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n)
      toExp (Exts.Lit l
    _ Literal l
    l)                 = Lit -> Exp
    TH.LitE (Literal l -> Lit
    forall a. ToLit a => a -> Lit
    toLit Literal l
    l)
    #if MIN_VERSION_template_haskell(2,13,0)
      toExp (Exts.OverloadedLabel l
    _ String
    s)     = String -> Exp
    TH.LabelE String
    s
    #endif
      toExp (Exts.InfixApp l
    _ Exp l
    e QOp l
    o Exp l
    f)        = Exp -> Exp -> Exp -> Exp
    TH.UInfixE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (QOp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp QOp l
    o) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    f)
      toExp (Exts.App l
    _ Exp l
    e (Exts.TypeApp l
    _ Type l
    t)) = Exp -> Type -> Exp
    TH.AppTypeE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)
      toExp (Exts.App l
    _ Exp l
    e Exp l
    f)               = Exp -> Exp -> Exp
    TH.AppE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    f)
      toExp (Exts.NegApp l
    _ Exp l
    e)              = Exp -> Exp -> Exp
    TH.AppE (Name -> Exp
    TH.VarE 'negate) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toExp (Exts.Lambda l
    _ [Pat l]
    ps Exp l
    e)           = [Pat] -> Exp -> Exp
    TH.LamE ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat [Pat l]
    ps) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toExp (Exts.Let l
    _ Binds l
    bs Exp l
    e)              = [Dec] -> Exp -> Exp
    TH.LetE (Binds l -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Binds l
    bs) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toExp (Exts.If l
    _ Exp l
    a Exp l
    b Exp l
    c)              = Exp -> Exp -> Exp -> Exp
    TH.CondE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    a) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    b) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    c)
      toExp (Exts.MultiIf l
    _ [GuardedRhs l]
    ifs)           = [(Guard, Exp)] -> Exp
    TH.MultiIfE ((GuardedRhs l -> (Guard, Exp)) -> [GuardedRhs l] -> [(Guard, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map GuardedRhs l -> (Guard, Exp)
    forall l. GuardedRhs l -> (Guard, Exp)
    toGuard [GuardedRhs l]
    ifs)
      toExp (Exts.Case l
    _ Exp l
    e [Alt l]
    alts)           = Exp -> [Match] -> Exp
    TH.CaseE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) ((Alt l -> Match) -> [Alt l] -> [Match]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt l -> Match
    forall l. Alt l -> Match
    toMatch [Alt l]
    alts)
    #if MIN_VERSION_template_haskell(2,17,0)
      toExp (Exts.Do l
    _ [Stmt l]
    ss)                 = Maybe ModName -> [Stmt] -> Exp
    TH.DoE Maybe ModName
    forall a. Maybe a
    Nothing ((Stmt l -> Stmt) -> [Stmt l] -> [Stmt]
    forall a b. (a -> b) -> [a] -> [b]
    map Stmt l -> Stmt
    forall a. ToStmt a => a -> Stmt
    toStmt [Stmt l]
    ss)
    #else
      toExp (Exts.Do _ ss)                 = TH.DoE (map toStmt ss)
    #endif
      toExp e :: Exp l
    e@Exts.MDo{}                   = String -> Exp l -> Exp
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toExp" Exp l
    e
      toExp (Exts.Tuple l
    _ Boxed
    Exts.Boxed [Exp l]
    xs)   = [Maybe Exp] -> Exp
    TH.TupE ((Exp l -> Maybe Exp) -> [Exp l] -> [Maybe Exp]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Exp l -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl [Exp l]
    xs)
      toExp (Exts.Tuple l
    _ Boxed
    Exts.Unboxed [Exp l]
    xs) = [Maybe Exp] -> Exp
    TH.UnboxedTupE ((Exp l -> Maybe Exp) -> [Exp l] -> [Maybe Exp]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Exp l -> Maybe Exp
    forall a. ToExp a => a -> Maybe Exp
    toTupEl [Exp l]
    xs)
      toExp e :: Exp l
    e@Exts.TupleSection{}          = String -> Exp l -> Exp
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toExp" Exp l
    e
      toExp (Exts.List l
    _ [Exp l]
    xs)               = [Exp] -> Exp
    TH.ListE ((Exp l -> Exp) -> [Exp l] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp [Exp l]
    xs)
      toExp (Exts.Paren l
    _ Exp l
    e)               = Exp -> Exp
    TH.ParensE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toExp (Exts.LeftSection l
    _ Exp l
    e QOp l
    o)       = Maybe Exp -> Exp -> Maybe Exp -> Exp
    TH.InfixE (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> (Exp l -> Exp) -> Exp l -> Maybe Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp (Exp l -> Maybe Exp) -> Exp l -> Maybe Exp
    forall a b. (a -> b) -> a -> b
    $ Exp l
    e) (QOp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp QOp l
    o) Maybe Exp
    forall a. Maybe a
    Nothing
      toExp (Exts.RightSection l
    _ QOp l
    o Exp l
    f)      = Maybe Exp -> Exp -> Maybe Exp -> Exp
    TH.InfixE Maybe Exp
    forall a. Maybe a
    Nothing (QOp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp QOp l
    o) (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> (Exp l -> Exp) -> Exp l -> Maybe Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp (Exp l -> Maybe Exp) -> Exp l -> Maybe Exp
    forall a b. (a -> b) -> a -> b
    $ Exp l
    f)
      toExp (Exts.RecConstr l
    _ QName l
    n [FieldUpdate l]
    xs)        = Name -> [FieldExp] -> Exp
    TH.RecConE (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n) ((FieldUpdate l -> FieldExp) -> [FieldUpdate l] -> [FieldExp]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldUpdate l -> FieldExp
    forall l. FieldUpdate l -> FieldExp
    toFieldExp [FieldUpdate l]
    xs)
      toExp (Exts.RecUpdate l
    _ Exp l
    e [FieldUpdate l]
    xs)        = Exp -> [FieldExp] -> Exp
    TH.RecUpdE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) ((FieldUpdate l -> FieldExp) -> [FieldUpdate l] -> [FieldExp]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldUpdate l -> FieldExp
    forall l. FieldUpdate l -> FieldExp
    toFieldExp [FieldUpdate l]
    xs)
      toExp (Exts.EnumFrom l
    _ Exp l
    e)            = Range -> Exp
    TH.ArithSeqE (Range -> Exp) -> Range -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Range
    TH.FromR (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toExp (Exts.EnumFromTo l
    _ Exp l
    e Exp l
    f)        = Range -> Exp
    TH.ArithSeqE (Range -> Exp) -> Range -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Range
    TH.FromToR (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    f)
      toExp (Exts.EnumFromThen l
    _ Exp l
    e Exp l
    f)      = Range -> Exp
    TH.ArithSeqE (Range -> Exp) -> Range -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Range
    TH.FromThenR (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    f)
      toExp (Exts.EnumFromThenTo l
    _ Exp l
    e Exp l
    f Exp l
    g)  = Range -> Exp
    TH.ArithSeqE (Range -> Exp) -> Range -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp -> Range
    TH.FromThenToR (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    f) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    g)
      toExp (Exts.ListComp l
    _ Exp l
    e [QualStmt l]
    ss)         = [Stmt] -> Exp
    TH.CompE ([Stmt] -> Exp) -> [Stmt] -> Exp
    forall a b. (a -> b) -> a -> b
    $ (QualStmt l -> Stmt) -> [QualStmt l] -> [Stmt]
    forall a b. (a -> b) -> [a] -> [b]
    map QualStmt l -> Stmt
    forall {e}. QualStmt e -> Stmt
    convert [QualStmt l]
    ss [Stmt] -> [Stmt] -> [Stmt]
    forall a. [a] -> [a] -> [a]
    ++ [Exp -> Stmt
    TH.NoBindS (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)]
       where
        convert :: QualStmt e -> Stmt
    convert (Exts.QualStmt e
    _ Stmt e
    st) = Stmt e -> Stmt
    forall a. ToStmt a => a -> Stmt
    toStmt Stmt e
    st
        convert QualStmt e
    s                    = String -> QualStmt e -> Stmt
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toExp ListComp" QualStmt e
    s
      toExp (Exts.ExpTypeSig l
    _ Exp l
    e Type l
    t)      = Exp -> Type -> Exp
    TH.SigE (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)
      toExp Exp l
    e = String -> Exp l -> Exp
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toExp" Exp l
    e

    toMatch :: Exts.Alt l -> TH.Match
    toMatch :: forall l. Alt l -> Match
    toMatch (Exts.Alt l
    _ Pat l
    p Rhs l
    rhs Maybe (Binds l)
    ds) = Pat -> Body -> [Dec] -> Match
    TH.Match (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p) (Rhs l -> Body
    forall l. Rhs l -> Body
    toBody Rhs l
    rhs) (Maybe (Binds l) -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Maybe (Binds l)
    ds)

    toBody :: Exts.Rhs l -> TH.Body
    toBody :: forall l. Rhs l -> Body
    toBody (Exts.UnGuardedRhs l
    _ Exp l
    e)   = Exp -> Body
    TH.NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e
    toBody (Exts.GuardedRhss l
    _ [GuardedRhs l]
    rhss) = [(Guard, Exp)] -> Body
    TH.GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
    forall a b. (a -> b) -> a -> b
    $ (GuardedRhs l -> (Guard, Exp)) -> [GuardedRhs l] -> [(Guard, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map GuardedRhs l -> (Guard, Exp)
    forall l. GuardedRhs l -> (Guard, Exp)
    toGuard [GuardedRhs l]
    rhss

    toGuard :: Exts.GuardedRhs l -> (TH.Guard, TH.Exp)
    toGuard :: forall l. GuardedRhs l -> (Guard, Exp)
    toGuard (Exts.GuardedRhs l
    _ [Stmt l]
    stmts Exp l
    e) = (Guard
    g, Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      where
        g :: Guard
    g = case (Stmt l -> Stmt) -> [Stmt l] -> [Stmt]
    forall a b. (a -> b) -> [a] -> [b]
    map Stmt l -> Stmt
    forall a. ToStmt a => a -> Stmt
    toStmt [Stmt l]
    stmts of
          [TH.NoBindS Exp
    x] -> Exp -> Guard
    TH.NormalG Exp
    x
          [Stmt]
    xs             -> [Stmt] -> Guard
    TH.PatG [Stmt]
    xs

    instance ToDecs a => ToDecs (Maybe a) where
        toDecs :: Maybe a -> [Dec]
    toDecs Maybe a
    Nothing  = []
        toDecs (Just a
    a) = a -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs a
    a

    instance ToDecs (Exts.Binds l) where
      toDecs :: Binds l -> [Dec]
    toDecs (Exts.BDecls l
    _ [Decl l]
    ds)  = [Decl l] -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs [Decl l]
    ds
      toDecs a :: Binds l
    a@(Exts.IPBinds {}) = String -> Binds l -> [Dec]
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "ToDecs Exts.Binds" Binds l
    a

    instance ToDecs (Exts.ClassDecl l) where
      toDecs :: ClassDecl l -> [Dec]
    toDecs (Exts.ClsDecl l
    _ Decl l
    d) = Decl l -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Decl l
    d
      toDecs ClassDecl l
    x                  = String -> ClassDecl l -> [Dec]
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "classDecl" ClassDecl l
    x

    -----------------------------------------------------------------------------

    -- * ToLoc SrcLoc

    instance ToLoc Exts.SrcLoc.SrcLoc where
      toLoc :: SrcLoc -> Loc
    toLoc (Exts.SrcLoc.SrcLoc String
    fn Int
    l Int
    c) =
        String -> String -> String -> CharPos -> CharPos -> Loc
    TH.Loc String
    fn [] [] (Int
    l,Int
    c) (-Int
    1,-Int
    1)

    -----------------------------------------------------------------------------

    -- * ToType HsType

    instance ToName (Exts.TyVarBind l) where
      toName :: TyVarBind l -> Name
    toName (Exts.KindedVar l
    _ Name l
    n Kind l
    _) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n
      toName (Exts.UnkindedVar l
    _ Name l
    n) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n

    instance ToName TH.Name where
      toName :: Name -> Name
    toName = Name -> Name
    forall a. a -> a
    id

    instance ToName (Compat.TyVarBndr_ flag) where
    #if MIN_VERSION_template_haskell(2,17,0)
      toName :: TyVarBndr_ flag -> Name
    toName (TH.PlainTV Name
    n flag
    _)    = Name
    n
      toName (TH.KindedTV Name
    n flag
    _ Type
    _) = Name
    n
    #else
      toName (TH.PlainTV n)      = n
      toName (TH.KindedTV n _)   = n
    #endif

    #if !MIN_VERSION_haskell_src_exts(1,21,0)
    instance ToType (Exts.Kind l) where
      toType (Exts.KindStar _)     = TH.StarT
      toType (Exts.KindFn _ k1 k2) = toType k1 .->. toType k2
      toType (Exts.KindParen _ kp) = toType kp
      toType (Exts.KindVar _ n)    = TH.VarT (toName n)
      -- TODO LumiGuide:
      -- toType (Hs.KindVar _ n)
      --    | isCon (nameBase th_n) = ConT th_n
      --    | otherwise             = VarT th_n
      --  where
      --    th_n = toName n
      --
      --    isCon :: String -> Bool
      --    isCon (c:_) = isUpper c || c == ':'
      --    isCon _ = nonsense "toType" "empty kind variable name" n
      toType (Exts.KindApp _ k1 k2) = toType k1 `TH.AppT` toType k2
      toType (Exts.KindTuple _ ks) = foldr (\k pt -> pt `TH.AppT` toType k) (TH.TupleT $ length ks) ks
      toType (Exts.KindList _ k) = TH.ListT `TH.AppT` toType k
    #endif

    toKind :: Exts.Kind l -> TH.Kind
    toKind :: forall l. Kind l -> Type
    toKind = Kind l -> Type
    forall a. ToType a => a -> Type
    toType

    toTyVar :: Exts.TyVarBind l -> TyVarBndr_ ()
    #if MIN_VERSION_template_haskell(2,17,0)
    toTyVar :: forall l. TyVarBind l -> TyVarBndr_ ()
    toTyVar (Exts.KindedVar l
    _ Name l
    n Kind l
    k) = Name -> () -> Type -> TyVarBndr_ ()
    forall flag. Name -> flag -> Type -> TyVarBndr flag
    TH.KindedTV (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) () (Kind l -> Type
    forall l. Kind l -> Type
    toKind Kind l
    k)
    toTyVar (Exts.UnkindedVar l
    _ Name l
    n) = Name -> () -> TyVarBndr_ ()
    forall flag. Name -> flag -> TyVarBndr flag
    TH.PlainTV (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) ()
    #else
    toTyVar (Exts.KindedVar _ n k) = TH.KindedTV (toName n) (toKind k)
    toTyVar (Exts.UnkindedVar _ n) = TH.PlainTV (toName n)
    #endif

    #if MIN_VERSION_template_haskell(2,17,0)
    toTyVarSpec :: TyVarBndr_ () -> TH.TyVarBndrSpec
    toTyVarSpec :: TyVarBndr_ () -> TyVarBndrSpec
    toTyVarSpec (TH.KindedTV Name
    n () Type
    k) = Name -> Specificity -> Type -> TyVarBndrSpec
    forall flag. Name -> flag -> Type -> TyVarBndr flag
    TH.KindedTV Name
    n Specificity
    TH.SpecifiedSpec Type
    k
    toTyVarSpec (TH.PlainTV Name
    n ())    = Name -> Specificity -> TyVarBndrSpec
    forall flag. Name -> flag -> TyVarBndr flag
    TH.PlainTV Name
    n Specificity
    TH.SpecifiedSpec
    #else
    toTyVarSpec :: TyVarBndr_ flag -> TyVarBndr_ flag
    toTyVarSpec = id
    #endif

    -- TODO (int-index): Use MIN_VERSION_template_haskell(2,21,0)
    #if __GLASGOW_HASKELL__ >= 907
    toTyVarsVis :: ToTyVars a => a -> [TH.TyVarBndrVis]
    toTyVarsVis :: forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis = (TyVarBndr_ () -> TyVarBndrVis)
    -> [TyVarBndr_ ()] -> [TyVarBndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndr_ () -> TyVarBndrVis
    toTyVarVis ([TyVarBndr_ ()] -> [TyVarBndrVis])
    -> (a -> [TyVarBndr_ ()]) -> a -> [TyVarBndrVis]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [TyVarBndr_ ()]
    forall a. ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVars
      where
        toTyVarVis :: TyVarBndr_ () -> TyVarBndrVis
    toTyVarVis (TH.KindedTV Name
    n () Type
    k) = Name -> BndrVis -> Type -> TyVarBndrVis
    forall flag. Name -> flag -> Type -> TyVarBndr flag
    TH.KindedTV Name
    n BndrVis
    TH.BndrReq Type
    k
        toTyVarVis (TH.PlainTV Name
    n ())    = Name -> BndrVis -> TyVarBndrVis
    forall flag. Name -> flag -> TyVarBndr flag
    TH.PlainTV Name
    n BndrVis
    TH.BndrReq
    #else
    toTyVarsVis :: ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVarsVis = toTyVars
    #endif

    instance ToType (Exts.Type l) where
      toType :: Type l -> Type
    toType (Exts.TyForall l
    _ Maybe [TyVarBind l]
    tvbM Maybe (Context l)
    cxt Type l
    t) = [TyVarBndrSpec] -> Cxt -> Type -> Type
    TH.ForallT ([TyVarBndrSpec]
    -> ([TyVarBind l] -> [TyVarBndrSpec])
    -> Maybe [TyVarBind l]
    -> [TyVarBndrSpec]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] ((TyVarBind l -> TyVarBndrSpec) -> [TyVarBind l] -> [TyVarBndrSpec]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TyVarBndr_ () -> TyVarBndrSpec
    toTyVarSpec (TyVarBndr_ () -> TyVarBndrSpec)
    -> (TyVarBind l -> TyVarBndr_ ()) -> TyVarBind l -> TyVarBndrSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVarBind l -> TyVarBndr_ ()
    forall l. TyVarBind l -> TyVarBndr_ ()
    toTyVar)) Maybe [TyVarBind l]
    tvbM) (Maybe (Context l) -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt Maybe (Context l)
    cxt) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)
      toType (Exts.TyFun l
    _ Type l
    a Type l
    b) = Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    a Type -> Type -> Type
    .->. Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    b
      toType (Exts.TyList l
    _ Type l
    t) = Type
    TH.ListT Type -> Type -> Type
    `TH.AppT` Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t
      toType (Exts.TyTuple l
    _ Boxed
    b [Type l]
    ts) = Type -> Cxt -> Type
    foldAppT (Int -> Type
    tuple (Int -> Type) -> ([Type l] -> Int) -> [Type l] -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Type l] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Type l] -> Type) -> [Type l] -> Type
    forall a b. (a -> b) -> a -> b
    $ [Type l]
    ts) ((Type l -> Type) -> [Type l] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type l -> Type
    forall a. ToType a => a -> Type
    toType [Type l]
    ts)
       where
        tuple :: Int -> Type
    tuple = case Boxed
    b of
          Boxed
    Exts.Boxed   -> Int -> Type
    TH.TupleT
          Boxed
    Exts.Unboxed -> Int -> Type
    TH.UnboxedTupleT
      toType (Exts.TyApp l
    _ Type l
    a Type l
    b) = Type -> Type -> Type
    TH.AppT (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    a) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    b)
      toType (Exts.TyVar l
    _ Name l
    n) = Name -> Type
    TH.VarT (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n)
      toType (Exts.TyCon l
    _ QName l
    qn) = Name -> Type
    TH.ConT (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    qn)
      toType (Exts.TyParen l
    _ Type l
    t) = Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t
      -- XXX: need to wrap the name in parens!
    #if MIN_VERSION_haskell_src_exts(1,20,0)
      -- TODO: why does this branch exist?
      -- Why fail toType if this is a promoted name?
      toType (Exts.TyInfix l
    _ Type l
    a (Exts.UnpromotedName l
    _ QName l
    o) Type l
    b) =
        Type -> Type -> Type
    TH.AppT (Type -> Type -> Type
    TH.AppT (Name -> Type
    TH.ConT (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    o)) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    a)) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    b)
    #else
      toType (Exts.TyInfix _ a o b) =
        TH.AppT (TH.AppT (TH.ConT (toName o)) (toType a)) (toType b)
    #endif
      toType (Exts.TyKind l
    _ Type l
    t Type l
    k) = Type -> Type -> Type
    TH.SigT (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t) (Type l -> Type
    forall l. Kind l -> Type
    toKind Type l
    k)
      toType (Exts.TyPromoted l
    _ Promoted l
    p) = case Promoted l
    p of
        Exts.PromotedInteger l
    _ Integer
    i String
    _ -> TyLit -> Type
    TH.LitT (TyLit -> Type) -> TyLit -> Type
    forall a b. (a -> b) -> a -> b
    $ Integer -> TyLit
    TH.NumTyLit Integer
    i
        Exts.PromotedString l
    _ String
    _ String
    s -> TyLit -> Type
    TH.LitT (TyLit -> Type) -> TyLit -> Type
    forall a b. (a -> b) -> a -> b
    $ String -> TyLit
    TH.StrTyLit String
    s
        Exts.PromotedCon l
    _ Bool
    _q QName l
    n -> Name -> Type
    TH.PromotedT (Name -> Type) -> Name -> Type
    forall a b. (a -> b) -> a -> b
    $ QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n
        Exts.PromotedList l
    _ Bool
    _q [Type l]
    ts -> (Type l -> Type -> Type) -> Type -> [Type l] -> Type
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Type l
    t Type
    pl -> Type
    TH.PromotedConsT Type -> Type -> Type
    `TH.AppT` Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t Type -> Type -> Type
    `TH.AppT` Type
    pl) Type
    TH.PromotedNilT [Type l]
    ts
        Exts.PromotedTuple l
    _ [Type l]
    ts -> (Type -> Type l -> Type) -> Type -> [Type l] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Type
    pt Type l
    t -> Type
    pt Type -> Type -> Type
    `TH.AppT` Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t) (Int -> Type
    TH.PromotedTupleT (Int -> Type) -> Int -> Type
    forall a b. (a -> b) -> a -> b
    $ [Type l] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type l]
    ts) [Type l]
    ts
        Exts.PromotedUnit l
    _ -> Name -> Type
    TH.PromotedT ''()
      toType (Exts.TyEquals l
    _ Type l
    t1 Type l
    t2) = Type
    TH.EqualityT Type -> Type -> Type
    `TH.AppT` Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t1 Type -> Type -> Type
    `TH.AppT` Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t2
      toType t :: Type l
    t@Exts.TySplice{} = String -> Type l -> Type
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toType" Type l
    t
      toType t :: Type l
    t@Exts.TyBang{} =
        String -> String -> Type l -> Type
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> String -> f e -> a
    nonsense String
    "toType" String
    "type cannot have strictness annotations in this context" Type l
    t
      toType t :: Type l
    t@Exts.TyWildCard{} = String -> Type l -> Type
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toType" Type l
    t
      toType Type l
    t = String -> Type l -> Type
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toType" Type l
    t
      -- TODO
      -- toType (Exts.TyUnboxedSum _ _)
      -- toType (Exts.TyParArray _ _)
      -- toType (Exts.TyInfix _ _ (Exts.PromotedName _ _) _)

    toStrictType :: Exts.Type l -> TH.StrictType
    toStrictType :: forall l. Type l -> StrictType
    toStrictType (Exts.TyBang l
    _ BangType l
    s Unpackedness l
    u Type l
    t) = (SourceUnpackedness -> SourceStrictness -> Bang
    TH.Bang (Unpackedness l -> SourceUnpackedness
    forall {l}. Unpackedness l -> SourceUnpackedness
    toUnpack Unpackedness l
    u) (BangType l -> SourceStrictness
    forall {l}. BangType l -> SourceStrictness
    toStrict BangType l
    s), Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)
        where
          toStrict :: BangType l -> SourceStrictness
    toStrict (Exts.LazyTy l
    _)        = SourceStrictness
    TH.SourceLazy
          toStrict (Exts.BangedTy l
    _)      = SourceStrictness
    TH.SourceStrict
          toStrict (Exts.NoStrictAnnot l
    _) = SourceStrictness
    TH.NoSourceStrictness
          toUnpack :: Unpackedness l -> SourceUnpackedness
    toUnpack (Exts.Unpack l
    _)         = SourceUnpackedness
    TH.SourceUnpack
          toUnpack (Exts.NoUnpack l
    _)       = SourceUnpackedness
    TH.SourceNoUnpack
          toUnpack (Exts.NoUnpackPragma l
    _) = SourceUnpackedness
    TH.NoSourceUnpackedness
    toStrictType Type l
    x = (SourceUnpackedness -> SourceStrictness -> Bang
    TH.Bang SourceUnpackedness
    TH.NoSourceUnpackedness SourceStrictness
    TH.NoSourceStrictness, Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    x)

    (.->.) :: TH.Type -> TH.Type -> TH.Type
    Type
    a .->. :: Type -> Type -> Type
    .->. Type
    b = Type -> Type -> Type
    TH.AppT (Type -> Type -> Type
    TH.AppT Type
    TH.ArrowT Type
    a) Type
    b

    instance ToPred (Exts.Asst l) where
    #if MIN_VERSION_haskell_src_exts(1,22,0)
        toPred :: Asst l -> Type
    toPred (Exts.TypeA l
    _ Type l
    t) = Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t
    #else
        toPred (Exts.ClassA _ n ts) = List.foldl' TH.AppT (TH.ConT (toName n)) (fmap toType ts)
        toPred (Exts.InfixA _ t1 n t2) = List.foldl' TH.AppT (TH.ConT (toName n)) (fmap toType [t1,t2])
        toPred (Exts.EqualP _ t1 t2) = List.foldl' TH.AppT TH.EqualityT (fmap toType [t1,t2])
        toPred a@Exts.AppA{} = todo "toPred" a
        toPred a@Exts.WildCardA{} = todo "toPred" a
    #endif
        toPred (Exts.ParenA l
    _ Asst l
    asst) = Asst l -> Type
    forall a. ToPred a => a -> Type
    toPred Asst l
    asst
        toPred a :: Asst l
    a@Exts.IParam{} = String -> Asst l -> Type
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toPred" Asst l
    a
        -- Pattern match is redundant.
        -- TODO: Is there a way to turn off this warn for catch-alls?
        -- would make the code more future-compat
        -- toPred p = todo "toPred" p

    instance ToDerivClauses (Exts.Deriving l) where
    #if MIN_VERSION_haskell_src_exts(1,20,0)
      toDerivClauses :: Deriving l -> [DerivClause]
    toDerivClauses (Exts.Deriving l
    _ Maybe (DerivStrategy l)
    strat [InstRule l]
    irules) = [Maybe DerivStrategy -> Cxt -> DerivClause
    TH.DerivClause ((DerivStrategy l -> DerivStrategy)
    -> Maybe (DerivStrategy l) -> Maybe DerivStrategy
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DerivStrategy l -> DerivStrategy
    forall l. DerivStrategy l -> DerivStrategy
    toDerivStrategy Maybe (DerivStrategy l)
    strat) ((InstRule l -> Type) -> [InstRule l] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map InstRule l -> Type
    forall a. ToType a => a -> Type
    toType [InstRule l]
    irules)]
    #else
      toDerivClauses (Exts.Deriving _ irules) = [TH.DerivClause Nothing (map toType irules)]
    #endif

    instance ToDerivClauses a => ToDerivClauses (Maybe a) where
      toDerivClauses :: Maybe a -> [DerivClause]
    toDerivClauses Maybe a
    Nothing  = []
      toDerivClauses (Just a
    a) = a -> [DerivClause]
    forall a. ToDerivClauses a => a -> [DerivClause]
    toDerivClauses a
    a

    instance ToDerivClauses a => ToDerivClauses [a] where
      toDerivClauses :: [a] -> [DerivClause]
    toDerivClauses = (a -> [DerivClause]) -> [a] -> [DerivClause]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [DerivClause]
    forall a. ToDerivClauses a => a -> [DerivClause]
    toDerivClauses

    toDerivStrategy :: (Exts.DerivStrategy l) -> TH.DerivStrategy
    toDerivStrategy :: forall l. DerivStrategy l -> DerivStrategy
    toDerivStrategy (Exts.DerivStock l
    _)    = DerivStrategy
    TH.StockStrategy
    toDerivStrategy (Exts.DerivAnyclass l
    _) = DerivStrategy
    TH.AnyclassStrategy
    toDerivStrategy (Exts.DerivNewtype l
    _)  = DerivStrategy
    TH.NewtypeStrategy
    #if MIN_VERSION_haskell_src_exts(1,21,0) && MIN_VERSION_template_haskell(2,14,0)
    toDerivStrategy (Exts.DerivVia l
    _ Type l
    t)    = Type -> DerivStrategy
    TH.ViaStrategy (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)
    #else
    toDerivStrategy d@Exts.DerivVia{}      = noTHyet "toDerivStrategy" "2.14" d
    #endif

    -- TODO LumiGuide
    -- instance ToCxt (Hs.Deriving l) where
    -- #if MIN_VERSION_haskell_src_exts(1,20,1)
    --   toCxt (Hs.Deriving _ _ rule) = toCxt rule
    -- #else
    --   toCxt (Hs.Deriving _   rule) = toCxt rule
    -- #endif

    -- instance ToCxt [Hs.InstRule l] where
    --   toCxt = concatMap toCxt

    -- instance ToCxt a => ToCxt (Maybe a) where
    --     toCxt Nothing = []
    --     toCxt (Just a) = toCxt a

    foldAppT :: TH.Type -> [TH.Type] -> TH.Type
    foldAppT :: Type -> Cxt -> Type
    foldAppT Type
    t Cxt
    ts = (Type -> Type -> Type) -> Type -> Cxt -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' Type -> Type -> Type
    TH.AppT Type
    t Cxt
    ts

    -----------------------------------------------------------------------------

    -- * ToStmt HsStmt

    instance ToStmt (Exts.Stmt l) where
      toStmt :: Stmt l -> Stmt
    toStmt (Exts.Generator l
    _ Pat l
    p Exp l
    e)   = Pat -> Exp -> Stmt
    TH.BindS (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toStmt (Exts.Qualifier l
    _ Exp l
    e)     = Exp -> Stmt
    TH.NoBindS (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
      toStmt _a :: Stmt l
    _a@(Exts.LetStmt l
    _ Binds l
    bnds) = [Dec] -> Stmt
    TH.LetS (Binds l -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Binds l
    bnds)
      toStmt s :: Stmt l
    s@Exts.RecStmt{}         = String -> Stmt l -> Stmt
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toStmt" Stmt l
    s

    -----------------------------------------------------------------------------

    -- * ToDec HsDecl

    instance ToDec (Exts.Decl l) where
      toDec :: Decl l -> Dec
    toDec (Exts.TypeDecl l
    _ DeclHead l
    h Type l
    t)
        = Name -> [TyVarBndrVis] -> Type -> Dec
    TH.TySynD (DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h) (DeclHead l -> [TyVarBndrVis]
    forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis DeclHead l
    h) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t)

      toDec a :: Decl l
    a@(Exts.DataDecl  l
    _ DataOrNew l
    dOrN Maybe (Context l)
    cxt DeclHead l
    h [QualConDecl l]
    qcds [Deriving l]
    qns)
        = case DataOrNew l
    dOrN of
            Exts.DataType l
    _ -> Cxt
    -> Name
    -> [TyVarBndrVis]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    TH.DataD (Maybe (Context l) -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt Maybe (Context l)
    cxt)
                                 (DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h)
                                 (DeclHead l -> [TyVarBndrVis]
    forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis DeclHead l
    h)
                                 Maybe Type
    forall a. Maybe a
    Nothing
                                 ((QualConDecl l -> Con) -> [QualConDecl l] -> [Con]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap QualConDecl l -> Con
    forall l. QualConDecl l -> Con
    qualConDeclToCon [QualConDecl l]
    qcds)
                                 ([Deriving l] -> [DerivClause]
    forall a. ToDerivClauses a => a -> [DerivClause]
    toDerivClauses [Deriving l]
    qns)
            Exts.NewType l
    _  -> let qcd :: QualConDecl l
    qcd = case [QualConDecl l]
    qcds of
                                         [QualConDecl l
    x] -> QualConDecl l
    x
                                         [QualConDecl l]
    _   -> String -> String -> Decl l -> QualConDecl l
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> String -> f e -> a
    nonsense String
    "toDec" (String
    "newtype with " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                                  String
    "wrong number of constructors") Decl l
    a
                            in Cxt
    -> Name
    -> [TyVarBndrVis]
    -> Maybe Type
    -> Con
    -> [DerivClause]
    -> Dec
    TH.NewtypeD (Maybe (Context l) -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt Maybe (Context l)
    cxt)
                                        (DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h)
                                        (DeclHead l -> [TyVarBndrVis]
    forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis DeclHead l
    h)
                                        Maybe Type
    forall a. Maybe a
    Nothing
                                        (QualConDecl l -> Con
    forall l. QualConDecl l -> Con
    qualConDeclToCon QualConDecl l
    qcd)
                                        ([Deriving l] -> [DerivClause]
    forall a. ToDerivClauses a => a -> [DerivClause]
    toDerivClauses [Deriving l]
    qns)

      -- This type-signature conversion is just wrong.
      -- Type variables need to be dealt with. /Jonas
      toDec _a :: Decl l
    _a@(Exts.TypeSig l
    _ [Name l]
    ns Type l
    t)
        -- XXXXXXXXXXXXXX: oh crap, we can't return a [Dec] from this class!
        = let xs :: [Dec]
    xs = (Name l -> Dec) -> [Name l] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Name -> Type -> Dec) -> Type -> Name -> Dec
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Name -> Type -> Dec
    TH.SigD (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t) (Name -> Dec) -> (Name l -> Name) -> Name l -> Dec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name l -> Name
    forall a. ToName a => a -> Name
    toName) [Name l]
    ns
          in case [Dec]
    xs of Dec
    x:[Dec]
    _ -> Dec
    x; [] -> String -> Dec
    forall a. HasCallStack => String -> a
    error String
    "toDec: malformed TypeSig!"

      toDec (Exts.InlineConlikeSig l
    _ Maybe (Activation l)
    act QName l
    qn) = Pragma -> Dec
    TH.PragmaD (Pragma -> Dec) -> Pragma -> Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> Inline -> RuleMatch -> Phases -> Pragma
    TH.InlineP (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    qn) Inline
    TH.Inline RuleMatch
    TH.ConLike (Maybe (Activation l) -> Phases
    forall l. Maybe (Activation l) -> Phases
    transAct Maybe (Activation l)
    act)
      toDec (Exts.InlineSig l
    _ Bool
    b Maybe (Activation l)
    act QName l
    qn) = Pragma -> Dec
    TH.PragmaD (Pragma -> Dec) -> Pragma -> Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> Inline -> RuleMatch -> Phases -> Pragma
    TH.InlineP (QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    qn) Inline
    inline RuleMatch
    TH.FunLike (Maybe (Activation l) -> Phases
    forall l. Maybe (Activation l) -> Phases
    transAct Maybe (Activation l)
    act)
       where
        inline :: Inline
    inline | Bool
    b = Inline
    TH.Inline | Bool
    otherwise = Inline
    TH.NoInline

      toDec (Exts.TypeFamDecl l
    _ DeclHead l
    h Maybe (ResultSig l)
    sig Maybe (InjectivityInfo l)
    inj)
        = TypeFamilyHead -> Dec
    TH.OpenTypeFamilyD (TypeFamilyHead -> Dec) -> TypeFamilyHead -> Dec
    forall a b. (a -> b) -> a -> b
    $ Name
    -> [TyVarBndrVis]
    -> FamilyResultSig
    -> Maybe InjectivityAnn
    -> TypeFamilyHead
    TH.TypeFamilyHead (DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h)
                                           (DeclHead l -> [TyVarBndrVis]
    forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis DeclHead l
    h)
                                           (FamilyResultSig
    -> (Type -> FamilyResultSig) -> Maybe Type -> FamilyResultSig
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FamilyResultSig
    TH.NoSig Type -> FamilyResultSig
    TH.KindSig (Maybe Type -> FamilyResultSig)
    -> (Maybe (ResultSig l) -> Maybe Type)
    -> Maybe (ResultSig l)
    -> FamilyResultSig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (ResultSig l) -> Maybe Type
    forall a. ToMaybeKind a => a -> Maybe Type
    toMaybeKind (Maybe (ResultSig l) -> FamilyResultSig)
    -> Maybe (ResultSig l) -> FamilyResultSig
    forall a b. (a -> b) -> a -> b
    $ Maybe (ResultSig l)
    sig)
                                           ((InjectivityInfo l -> InjectivityAnn)
    -> Maybe (InjectivityInfo l) -> Maybe InjectivityAnn
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap InjectivityInfo l -> InjectivityAnn
    forall a. ToInjectivityAnn a => a -> InjectivityAnn
    toInjectivityAnn Maybe (InjectivityInfo l)
    inj)
      toDec (Exts.DataFamDecl l
    _ Maybe (Context l)
    _ DeclHead l
    h Maybe (ResultSig l)
    sig)
        = Name -> [TyVarBndrVis] -> Maybe Type -> Dec
    TH.DataFamilyD (DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h) (DeclHead l -> [TyVarBndrVis]
    forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis DeclHead l
    h) (Maybe (ResultSig l) -> Maybe Type
    forall a. ToMaybeKind a => a -> Maybe Type
    toMaybeKind Maybe (ResultSig l)
    sig)

      toDec _a :: Decl l
    _a@(Exts.FunBind l
    _ [Match l]
    mtchs)                           = [Match l] -> Dec
    forall l. [Match l] -> Dec
    hsMatchesToFunD [Match l]
    mtchs
      toDec (Exts.PatBind l
    _ Pat l
    p Rhs l
    rhs Maybe (Binds l)
    bnds)                      = Pat -> Body -> [Dec] -> Dec
    TH.ValD (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p)
                                                                  (Rhs l -> Body
    forall l. Rhs l -> Body
    hsRhsToBody Rhs l
    rhs)
                                                                  (Maybe (Binds l) -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Maybe (Binds l)
    bnds)

      toDec i :: Decl l
    i@(Exts.InstDecl l
    _ (Just Overlap l
    overlap) InstRule l
    _ Maybe [InstDecl l]
    _) =
        String -> (Overlap (), Decl l) -> Dec
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    noTH String
    "toDec" ((l -> ()) -> Overlap l -> Overlap ()
    forall a b. (a -> b) -> Overlap a -> Overlap b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> l -> ()
    forall a b. a -> b -> a
    const ()) Overlap l
    overlap, Decl l
    i)

      -- the 'vars' bit seems to be for: instance forall a. C (T a) where ...
      -- TH's own parser seems to flat-out ignore them, and honestly I can't see
      -- that it's obviously wrong to do so.
      toDec (Exts.InstDecl l
    _ Maybe (Overlap l)
    Nothing InstRule l
    irule Maybe [InstDecl l]
    ids) = Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
    TH.InstanceD
        Maybe Overlap
    forall a. Maybe a
    Nothing
        (InstRule l -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt InstRule l
    irule)
        (InstRule l -> Type
    forall a. ToType a => a -> Type
    toType InstRule l
    irule)
        (Maybe [InstDecl l] -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Maybe [InstDecl l]
    ids)

      toDec (Exts.ClassDecl l
    _ Maybe (Context l)
    cxt DeclHead l
    h [FunDep l]
    fds Maybe [ClassDecl l]
    decls) = Cxt -> Name -> [TyVarBndrVis] -> [FunDep] -> [Dec] -> Dec
    TH.ClassD
        (Maybe (Context l) -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt Maybe (Context l)
    cxt)
        (DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h)
        (DeclHead l -> [TyVarBndrVis]
    forall a. ToTyVars a => a -> [TyVarBndrVis]
    toTyVarsVis DeclHead l
    h)
        ((FunDep l -> FunDep) -> [FunDep l] -> [FunDep]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FunDep l -> FunDep
    forall {l}. FunDep l -> FunDep
    toFunDep [FunDep l]
    fds)
        (Maybe [ClassDecl l] -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Maybe [ClassDecl l]
    decls)
       where
        toFunDep :: FunDep l -> FunDep
    toFunDep (Exts.FunDep l
    _ [Name l]
    ls [Name l]
    rs) = [Name] -> [Name] -> FunDep
    TH.FunDep ((Name l -> Name) -> [Name l] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name l -> Name
    forall a. ToName a => a -> Name
    toName [Name l]
    ls) ((Name l -> Name) -> [Name l] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name l -> Name
    forall a. ToName a => a -> Name
    toName [Name l]
    rs)

      toDec (Exts.AnnPragma l
    _ Annotation l
    ann) = Pragma -> Dec
    TH.PragmaD (AnnTarget -> Exp -> Pragma
    TH.AnnP (Annotation l -> AnnTarget
    forall {l}. Annotation l -> AnnTarget
    target Annotation l
    ann) (Annotation l -> Exp
    forall {l}. Annotation l -> Exp
    expann Annotation l
    ann))
        where
          target :: Annotation l -> AnnTarget
    target (Exts.Ann l
    _ Name l
    n Exp l
    _)     = Name -> AnnTarget
    TH.ValueAnnotation (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n)
          target (Exts.TypeAnn l
    _ Name l
    n Exp l
    _) = Name -> AnnTarget
    TH.TypeAnnotation (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n)
          target (Exts.ModuleAnn l
    _ Exp l
    _) = AnnTarget
    TH.ModuleAnnotation
          expann :: Annotation l -> Exp
    expann (Exts.Ann l
    _ Name l
    _ Exp l
    e)     = Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e
          expann (Exts.TypeAnn l
    _ Name l
    _ Exp l
    e) = Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e
          expann (Exts.ModuleAnn l
    _ Exp l
    e) = Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e

      toDec Decl l
    x = String -> Decl l -> Dec
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toDec" Decl l
    x

    instance ToMaybeKind (Exts.ResultSig l) where
        toMaybeKind :: ResultSig l -> Maybe Type
    toMaybeKind (Exts.KindSig l
    _ Kind l
    k)  = Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Type -> Maybe Type) -> Type -> Maybe Type
    forall a b. (a -> b) -> a -> b
    $ Kind l -> Type
    forall l. Kind l -> Type
    toKind Kind l
    k
        toMaybeKind (Exts.TyVarSig l
    _ TyVarBind l
    _) = Maybe Type
    forall a. Maybe a
    Nothing

    instance ToMaybeKind a => ToMaybeKind (Maybe a) where
        toMaybeKind :: Maybe a -> Maybe Type
    toMaybeKind Maybe a
    Nothing  = Maybe Type
    forall a. Maybe a
    Nothing
        toMaybeKind (Just a
    a) = a -> Maybe Type
    forall a. ToMaybeKind a => a -> Maybe Type
    toMaybeKind a
    a

    instance ToInjectivityAnn (Exts.InjectivityInfo l) where
      toInjectivityAnn :: InjectivityInfo l -> InjectivityAnn
    toInjectivityAnn (Exts.InjectivityInfo l
    _ Name l
    n [Name l]
    ns) = Name -> [Name] -> InjectivityAnn
    TH.InjectivityAnn (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) ((Name l -> Name) -> [Name l] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name l -> Name
    forall a. ToName a => a -> Name
    toName [Name l]
    ns)

    transAct :: Maybe (Exts.Activation l) -> TH.Phases
    transAct :: forall l. Maybe (Activation l) -> Phases
    transAct Maybe (Activation l)
    Nothing                       = Phases
    TH.AllPhases
    transAct (Just (Exts.ActiveFrom l
    _ Int
    n))  = Int -> Phases
    TH.FromPhase Int
    n
    transAct (Just (Exts.ActiveUntil l
    _ Int
    n)) = Int -> Phases
    TH.BeforePhase Int
    n

    instance ToName (Exts.DeclHead l) where
      toName :: DeclHead l -> Name
    toName (Exts.DHead l
    _ Name l
    n)     = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n
      toName (Exts.DHInfix l
    _ TyVarBind l
    _ Name l
    n) = Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n
      toName (Exts.DHParen l
    _ DeclHead l
    h)   = DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h
      toName (Exts.DHApp l
    _ DeclHead l
    h TyVarBind l
    _)   = DeclHead l -> Name
    forall a. ToName a => a -> Name
    toName DeclHead l
    h

    instance ToTyVars (Exts.DeclHead l) where
      toTyVars :: DeclHead l -> [TyVarBndr_ ()]
    toTyVars (Exts.DHead l
    _ Name l
    _)       = []
      toTyVars (Exts.DHParen l
    _ DeclHead l
    h)     = DeclHead l -> [TyVarBndr_ ()]
    forall a. ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVars DeclHead l
    h
      toTyVars (Exts.DHInfix l
    _ TyVarBind l
    tvb Name l
    _) = [TyVarBind l -> TyVarBndr_ ()
    forall l. TyVarBind l -> TyVarBndr_ ()
    toTyVar TyVarBind l
    tvb]
      toTyVars (Exts.DHApp l
    _ DeclHead l
    h TyVarBind l
    tvb)   = DeclHead l -> [TyVarBndr_ ()]
    forall a. ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVars DeclHead l
    h [TyVarBndr_ ()] -> [TyVarBndr_ ()] -> [TyVarBndr_ ()]
    forall a. [a] -> [a] -> [a]
    ++ [TyVarBind l -> TyVarBndr_ ()
    forall l. TyVarBind l -> TyVarBndr_ ()
    toTyVar TyVarBind l
    tvb]

    instance ToNames a => ToNames (Maybe a) where
      toNames :: Maybe a -> [Name]
    toNames Maybe a
    Nothing  = []
      toNames (Just a
    a) = a -> [Name]
    forall a. ToNames a => a -> [Name]
    toNames a
    a

    instance ToNames (Exts.Deriving l) where
    #if MIN_VERSION_haskell_src_exts(1,20,0)
      toNames :: Deriving l -> [Name]
    toNames (Exts.Deriving l
    _ Maybe (DerivStrategy l)
    _ [InstRule l]
    irules) = (InstRule l -> [Name]) -> [InstRule l] -> [Name]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap InstRule l -> [Name]
    forall a. ToNames a => a -> [Name]
    toNames [InstRule l]
    irules
    #else
      toNames (Exts.Deriving _ irules)   = concatMap toNames irules
    #endif

    instance ToNames (Exts.InstRule l) where
      toNames :: InstRule l -> [Name]
    toNames (Exts.IParen l
    _ InstRule l
    irule)            = InstRule l -> [Name]
    forall a. ToNames a => a -> [Name]
    toNames InstRule l
    irule
      toNames (Exts.IRule l
    _ Maybe [TyVarBind l]
    _mtvbs Maybe (Context l)
    _mcxt InstHead l
    mihd) = InstHead l -> [Name]
    forall a. ToNames a => a -> [Name]
    toNames InstHead l
    mihd
    instance ToNames (Exts.InstHead l) where
      toNames :: InstHead l -> [Name]
    toNames (Exts.IHCon l
    _ QName l
    n)     = [QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n]
      toNames (Exts.IHInfix l
    _ Type l
    _ QName l
    n) = [QName l -> Name
    forall a. ToName a => a -> Name
    toName QName l
    n]
      toNames (Exts.IHParen l
    _ InstHead l
    h)   = InstHead l -> [Name]
    forall a. ToNames a => a -> [Name]
    toNames InstHead l
    h
      toNames (Exts.IHApp l
    _ InstHead l
    h Type l
    _)   = InstHead l -> [Name]
    forall a. ToNames a => a -> [Name]
    toNames InstHead l
    h

    instance ToCxt (Exts.InstRule l) where
      toCxt :: InstRule l -> Cxt
    toCxt (Exts.IRule l
    _ Maybe [TyVarBind l]
    _ Maybe (Context l)
    cxt InstHead l
    _) = Maybe (Context l) -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt Maybe (Context l)
    cxt
      toCxt (Exts.IParen l
    _ InstRule l
    irule)  = InstRule l -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt InstRule l
    irule

    instance ToCxt (Exts.Context l) where
      toCxt :: Context l -> Cxt
    toCxt Context l
    x = case Context l
    x of
                  Exts.CxEmpty l
    _     -> []
                  Exts.CxSingle l
    _ Asst l
    x' -> [Asst l -> Type
    forall a. ToPred a => a -> Type
    toPred Asst l
    x']
                  Exts.CxTuple l
    _ [Asst l]
    xs  -> (Asst l -> Type) -> [Asst l] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Asst l -> Type
    forall a. ToPred a => a -> Type
    toPred [Asst l]
    xs

    instance ToCxt a => ToCxt (Maybe a) where
        toCxt :: Maybe a -> Cxt
    toCxt Maybe a
    Nothing  = []
        toCxt (Just a
    a) = a -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt a
    a

    instance ToType (Exts.InstRule l) where
        toType :: InstRule l -> Type
    toType (Exts.IRule l
    _ Maybe [TyVarBind l]
    _ Maybe (Context l)
    _ InstHead l
    h)  = InstHead l -> Type
    forall a. ToType a => a -> Type
    toType InstHead l
    h
        toType (Exts.IParen l
    _ InstRule l
    irule) = InstRule l -> Type
    forall a. ToType a => a -> Type
    toType InstRule l
    irule

    instance ToType (Exts.InstHead l) where
        toType :: InstHead l -> Type
    toType (Exts.IHCon l
    _ QName l
    qn)       = QName l -> Type
    forall a. ToType a => a -> Type
    toType QName l
    qn
        toType (Exts.IHInfix l
    _ Type l
    typ QName l
    qn) = Type -> Type -> Type
    TH.AppT (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    typ) (QName l -> Type
    forall a. ToType a => a -> Type
    toType QName l
    qn)
        toType (Exts.IHParen l
    _ InstHead l
    hd)     = InstHead l -> Type
    forall a. ToType a => a -> Type
    toType InstHead l
    hd
        toType (Exts.IHApp l
    _ InstHead l
    hd Type l
    typ)   = Type -> Type -> Type
    TH.AppT (InstHead l -> Type
    forall a. ToType a => a -> Type
    toType InstHead l
    hd) (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    typ)

    qualConDeclToCon :: Exts.QualConDecl l -> TH.Con
    qualConDeclToCon :: forall l. QualConDecl l -> Con
    qualConDeclToCon (Exts.QualConDecl l
    _ Maybe [TyVarBind l]
    Nothing Maybe (Context l)
    Nothing ConDecl l
    cdecl) = ConDecl l -> Con
    forall l. ConDecl l -> Con
    conDeclToCon ConDecl l
    cdecl
    qualConDeclToCon (Exts.QualConDecl l
    _ Maybe [TyVarBind l]
    ns Maybe (Context l)
    cxt ConDecl l
    cdecl) = [TyVarBndrSpec] -> Cxt -> Con -> Con
    TH.ForallC (TyVarBndr_ () -> TyVarBndrSpec
    toTyVarSpec (TyVarBndr_ () -> TyVarBndrSpec)
    -> [TyVarBndr_ ()] -> [TyVarBndrSpec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe [TyVarBind l] -> [TyVarBndr_ ()]
    forall a. ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVars Maybe [TyVarBind l]
    ns)
                                                        (Maybe (Context l) -> Cxt
    forall a. ToCxt a => a -> Cxt
    toCxt Maybe (Context l)
    cxt)
                                                        (ConDecl l -> Con
    forall l. ConDecl l -> Con
    conDeclToCon ConDecl l
    cdecl)

    instance ToTyVars a => ToTyVars (Maybe a) where
      toTyVars :: Maybe a -> [TyVarBndr_ ()]
    toTyVars Maybe a
    Nothing  = []
      toTyVars (Just a
    a) = a -> [TyVarBndr_ ()]
    forall a. ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVars a
    a

    instance ToTyVars a => ToTyVars [a] where
      toTyVars :: [a] -> [TyVarBndr_ ()]
    toTyVars = (a -> [TyVarBndr_ ()]) -> [a] -> [TyVarBndr_ ()]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [TyVarBndr_ ()]
    forall a. ToTyVars a => a -> [TyVarBndr_ ()]
    toTyVars

    instance ToTyVars (Exts.TyVarBind l) where
      toTyVars :: TyVarBind l -> [TyVarBndr_ ()]
    toTyVars TyVarBind l
    tvb = [TyVarBind l -> TyVarBndr_ ()
    forall l. TyVarBind l -> TyVarBndr_ ()
    toTyVar TyVarBind l
    tvb]

    instance ToType (Exts.QName l) where
        toType :: QName l -> Type
    toType = Name -> Type
    TH.ConT (Name -> Type) -> (QName l -> Name) -> QName l -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName l -> Name
    forall a. ToName a => a -> Name
    toName

    conDeclToCon :: Exts.ConDecl l -> TH.Con
    conDeclToCon :: forall l. ConDecl l -> Con
    conDeclToCon (Exts.ConDecl l
    _ Name l
    n [Type l]
    tys)
      = Name -> [StrictType] -> Con
    TH.NormalC (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) ((Type l -> StrictType) -> [Type l] -> [StrictType]
    forall a b. (a -> b) -> [a] -> [b]
    map Type l -> StrictType
    forall l. Type l -> StrictType
    toStrictType [Type l]
    tys)
    conDeclToCon (Exts.RecDecl l
    _ Name l
    n [FieldDecl l]
    fieldDecls)
      = Name -> [VarBangType] -> Con
    TH.RecC (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) ((FieldDecl l -> [VarBangType]) -> [FieldDecl l] -> [VarBangType]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap FieldDecl l -> [VarBangType]
    forall l. FieldDecl l -> [VarBangType]
    convField [FieldDecl l]
    fieldDecls)
      where
        convField :: Exts.FieldDecl l -> [TH.VarStrictType]
        convField :: forall l. FieldDecl l -> [VarBangType]
    convField (Exts.FieldDecl l
    _ [Name l]
    ns Type l
    t) =
          let (Bang
    strict, Type
    ty) = Type l -> StrictType
    forall l. Type l -> StrictType
    toStrictType Type l
    t
          in (Name l -> VarBangType) -> [Name l] -> [VarBangType]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Name l
    n' -> (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n', Bang
    strict, Type
    ty)) [Name l]
    ns
    conDeclToCon ConDecl l
    h = String -> ConDecl l -> Con
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "conDeclToCon" ConDecl l
    h
    -- TODO
    -- (Exts.InfixConDecl _ _ _ _)

    hsMatchesToFunD :: [Exts.Match l] -> TH.Dec
    hsMatchesToFunD :: forall l. [Match l] -> Dec
    hsMatchesToFunD [] = Name -> [Clause] -> Dec
    TH.FunD (String -> Name
    TH.mkName []) []   -- errorish
    hsMatchesToFunD xs :: [Match l]
    xs@(Exts.Match l
    _ Name l
    n [Pat l]
    _ Rhs l
    _ Maybe (Binds l)
    _ : [Match l]
    _) = Name -> [Clause] -> Dec
    TH.FunD (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) ((Match l -> Clause) -> [Match l] -> [Clause]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Match l -> Clause
    forall l. Match l -> Clause
    hsMatchToClause [Match l]
    xs)
    hsMatchesToFunD xs :: [Match l]
    xs@(Exts.InfixMatch l
    _ Pat l
    _ Name l
    n [Pat l]
    _ Rhs l
    _ Maybe (Binds l)
    _ : [Match l]
    _) = Name -> [Clause] -> Dec
    TH.FunD (Name l -> Name
    forall a. ToName a => a -> Name
    toName Name l
    n) ((Match l -> Clause) -> [Match l] -> [Clause]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Match l -> Clause
    forall l. Match l -> Clause
    hsMatchToClause [Match l]
    xs)

    hsMatchToClause :: Exts.Match l -> TH.Clause
    hsMatchToClause :: forall l. Match l -> Clause
    hsMatchToClause (Exts.Match l
    _ Name l
    _ [Pat l]
    ps Rhs l
    rhs Maybe (Binds l)
    bnds) = [Pat] -> Body -> [Dec] -> Clause
    TH.Clause
                                                    ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat [Pat l]
    ps)
                                                    (Rhs l -> Body
    forall l. Rhs l -> Body
    hsRhsToBody Rhs l
    rhs)
                                                    (Maybe (Binds l) -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Maybe (Binds l)
    bnds)
    hsMatchToClause (Exts.InfixMatch l
    _ Pat l
    p Name l
    _ [Pat l]
    ps Rhs l
    rhs Maybe (Binds l)
    bnds) = [Pat] -> Body -> [Dec] -> Clause
    TH.Clause
                                                            ((Pat l -> Pat) -> [Pat l] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat (Pat l
    pPat l -> [Pat l] -> [Pat l]
    forall a. a -> [a] -> [a]
    :[Pat l]
    ps))
                                                            (Rhs l -> Body
    forall l. Rhs l -> Body
    hsRhsToBody Rhs l
    rhs)
                                                            (Maybe (Binds l) -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Maybe (Binds l)
    bnds)

    hsRhsToBody :: Exts.Rhs l -> TH.Body
    hsRhsToBody :: forall l. Rhs l -> Body
    hsRhsToBody (Exts.UnGuardedRhs l
    _ Exp l
    e) = Exp -> Body
    TH.NormalB (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
    hsRhsToBody (Exts.GuardedRhss l
    _ [GuardedRhs l]
    hsgrhs) =
      let fromGuardedB :: Body -> [(Guard, Exp)]
    fromGuardedB (TH.GuardedB [(Guard, Exp)]
    a) = [(Guard, Exp)]
    a
          fromGuardedB Body
    h               = String -> [Body] -> [(Guard, Exp)]
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "fromGuardedB" [Body
    h]
          -- TODO: (NormalB _)
      in [(Guard, Exp)] -> Body
    TH.GuardedB ([(Guard, Exp)] -> Body)
    -> ([GuardedRhs l] -> [(Guard, Exp)]) -> [GuardedRhs l] -> Body
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[(Guard, Exp)]] -> [(Guard, Exp)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
         ([[(Guard, Exp)]] -> [(Guard, Exp)])
    -> ([GuardedRhs l] -> [[(Guard, Exp)]])
    -> [GuardedRhs l]
    -> [(Guard, Exp)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GuardedRhs l -> [(Guard, Exp)])
    -> [GuardedRhs l] -> [[(Guard, Exp)]]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Body -> [(Guard, Exp)]
    fromGuardedB (Body -> [(Guard, Exp)])
    -> (GuardedRhs l -> Body) -> GuardedRhs l -> [(Guard, Exp)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GuardedRhs l -> Body
    forall l. GuardedRhs l -> Body
    hsGuardedRhsToBody)
         ([GuardedRhs l] -> Body) -> [GuardedRhs l] -> Body
    forall a b. (a -> b) -> a -> b
    $ [GuardedRhs l]
    hsgrhs

    hsGuardedRhsToBody :: Exts.GuardedRhs l -> TH.Body
    hsGuardedRhsToBody :: forall l. GuardedRhs l -> Body
    hsGuardedRhsToBody (Exts.GuardedRhs l
    _ [] Exp l
    e)  = Exp -> Body
    TH.NormalB (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
    hsGuardedRhsToBody (Exts.GuardedRhs l
    _ [Stmt l
    s] Exp l
    e) = [(Guard, Exp)] -> Body
    TH.GuardedB [(Stmt l -> Guard
    forall l. Stmt l -> Guard
    hsStmtToGuard Stmt l
    s, Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)]
    hsGuardedRhsToBody (Exts.GuardedRhs l
    _ [Stmt l]
    ss Exp l
    e)  = let ss' :: [Guard]
    ss' = (Stmt l -> Guard) -> [Stmt l] -> [Guard]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Stmt l -> Guard
    forall l. Stmt l -> Guard
    hsStmtToGuard [Stmt l]
    ss
                                                       ([[Stmt]]
    pgs,[Guard]
    ngs) = [([Stmt], Guard)] -> ([[Stmt]], [Guard])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [([Stmt]
    p,Guard
    n)
                                                                         | (TH.PatG [Stmt]
    p) <- [Guard]
    ss'
                                                                         , n :: Guard
    n@(TH.NormalG Exp
    _) <- [Guard]
    ss']
                                                       e' :: Exp
    e' = Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e
                                                       patg :: Guard
    patg = [Stmt] -> Guard
    TH.PatG ([[Stmt]] -> [Stmt]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Stmt]]
    pgs)
                                                   in [(Guard, Exp)] -> Body
    TH.GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
    forall a b. (a -> b) -> a -> b
    $ (Guard
    patg,Exp
    e') (Guard, Exp) -> [(Guard, Exp)] -> [(Guard, Exp)]
    forall a. a -> [a] -> [a]
    : [Guard] -> [Exp] -> [(Guard, Exp)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Guard]
    ngs (Exp -> [Exp]
    forall a. a -> [a]
    repeat Exp
    e')

    hsStmtToGuard :: Exts.Stmt l -> TH.Guard
    hsStmtToGuard :: forall l. Stmt l -> Guard
    hsStmtToGuard (Exts.Generator l
    _ Pat l
    p Exp l
    e) = [Stmt] -> Guard
    TH.PatG [Pat -> Exp -> Stmt
    TH.BindS (Pat l -> Pat
    forall a. ToPat a => a -> Pat
    toPat Pat l
    p) (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)]
    hsStmtToGuard (Exts.Qualifier l
    _ Exp l
    e)   = Exp -> Guard
    TH.NormalG (Exp l -> Exp
    forall a. ToExp a => a -> Exp
    toExp Exp l
    e)
    hsStmtToGuard (Exts.LetStmt l
    _ Binds l
    bs)    = [Stmt] -> Guard
    TH.PatG [[Dec] -> Stmt
    TH.LetS (Binds l -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Binds l
    bs)]
    hsStmtToGuard Stmt l
    h                      = String -> Stmt l -> Guard
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "hsStmtToGuard" Stmt l
    h
    -- TODO
    -- (Exts.RecStmt _ _)

    -----------------------------------------------------------------------------

    -- * ToDecs InstDecl
    instance ToDecs (Exts.InstDecl l) where
      toDecs :: InstDecl l -> [Dec]
    toDecs (Exts.InsDecl l
    _ Decl l
    decl) = Decl l -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs Decl l
    decl
      toDecs InstDecl l
    d                     = String -> InstDecl l -> [Dec]
    forall (f :: * -> *) e a.
    (Functor f, Show (f ())) =>
    String -> f e -> a
    todo String
    "toDec" InstDecl l
    d

    -- * ToDecs HsDecl HsBinds

    instance ToDecs (Exts.Decl l) where
      toDecs :: Decl l -> [Dec]
    toDecs _a :: Decl l
    _a@(Exts.TypeSig l
    _ [Name l]
    ns Type l
    t)
        -- TODO: fixforall as before?
        -- = let xs = fmap (flip SigD (fixForall $ toType t) . toName) ns
        = let xs :: [Dec]
    xs = (Name l -> Dec) -> [Name l] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Name -> Type -> Dec) -> Type -> Name -> Dec
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Name -> Type -> Dec
    TH.SigD (Type l -> Type
    forall a. ToType a => a -> Type
    toType Type l
    t) (Name -> Dec) -> (Name l -> Name) -> Name l -> Dec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name l -> Name
    forall a. ToName a => a -> Name
    toName) [Name l]
    ns
           in [Dec]
    xs

      toDecs (Exts.InfixDecl l
    l Assoc l
    assoc Maybe Int
    Nothing [Op l]
    ops) =
          Decl l -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs (l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
    forall l. l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
    Exts.InfixDecl l
    l Assoc l
    assoc (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    9) [Op l]
    ops)
      toDecs (Exts.InfixDecl l
    _ Assoc l
    assoc (Just Int
    fixity) [Op l]
    ops) =
    #if MIN_VERSION_template_haskell(2,22,0)
        (Op l -> Dec) -> [Op l] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Op l
    op -> Fixity -> NamespaceSpecifier -> Name -> Dec
    TH.InfixD (Int -> FixityDirection -> Fixity
    TH.Fixity Int
    fixity FixityDirection
    dir) NamespaceSpecifier
    TH.NoNamespaceSpecifier (Op l -> Name
    forall a. ToName a => a -> Name
    toName Op l
    op)) [Op l]
    ops
    #else
        map (\op -> TH.InfixD (TH.Fixity fixity dir) (toName op)) ops
    #endif
       where
        dir :: FixityDirection
    dir = case Assoc l
    assoc of
          Exts.AssocNone l
    _  -> FixityDirection
    TH.InfixN
          Exts.AssocLeft l
    _  -> FixityDirection
    TH.InfixL
          Exts.AssocRight l
    _ -> FixityDirection
    TH.InfixR

      toDecs Decl l
    a = [Decl l -> Dec
    forall a. ToDec a => a -> Dec
    toDec Decl l
    a]

    -- TODO: see aboe re: fixforall
    -- fixForall t@(TH.ForallT _ _ _) = t
    -- fixForall t = case vs of
    --   [] -> t
    --   _  -> TH.ForallT vs [] t
    --   where vs = collectVars t
    -- collectVars e = case e of
    --   VarT n -> [PlainTV n]
    --   AppT t1 t2 -> nub $ collectVars t1 ++ collectVars t2
    --   TH.ForallT ns _ t -> collectVars t \\ ns
    --   _          -> []

    instance ToDecs a => ToDecs [a] where
      toDecs :: [a] -> [Dec]
    toDecs [a]
    a = (a -> [Dec]) -> [a] -> [Dec]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [Dec]
    forall a. ToDecs a => a -> [Dec]
    toDecs [a]
    a