{-# Language CPP, DataKinds, FlexibleContexts, FlexibleInstances, GADTs, OverloadedStrings, RankNTypes,
             ScopedTypeVariables, TemplateHaskell, TypeOperators #-}
{-# Options_GHC -Werror=incomplete-patterns #-}

-- | Pretty-printing of AST via Template Haskell. That is, the AST is first transformed into corresponding
-- Template Haskell AST, then printed using its pretty-printer.
module Language.Haskell.Template (PrettyViaTH, pprint) where

import Data.Bifunctor (bimap)
import qualified Data.Char as Char
import Data.Foldable (foldl', toList)
import Data.Functor.Compose (Compose (getCompose))
import Data.Functor.Const (Const (Const))
import Data.List ((\\), nub)
import Data.Maybe (fromMaybe)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as ByteString.Char8
import Data.Text (Text, unpack)
import qualified Data.Text as Text
import GHC.Exts (TYPE)
import qualified GHC.Types
import qualified Rank2
import Text.PrettyPrint (render)

import Language.Haskell (Bound, Placed)
import Language.Haskell.Reserializer (ParsedLexemes(Trailing), lexemeText)
import Language.Haskell.Extensions (ExtensionSwitch(..))
import qualified Language.Haskell.Extensions as Extensions
import qualified Language.Haskell.Extensions.Abstract as Abstract
import Language.Haskell.Extensions.AST as ExtAST
import qualified Language.Haskell.Extensions.Reformulator as Reformulator
import Language.Haskell.Extensions.Translation (FullyTranslatable)
import Language.Haskell.TH hiding (Extension, doE, mdoE, pprint, safe)
import Language.Haskell.TH.Datatype.TyVarBndr (TyVarBndrSpec, TyVarBndrUnit, TyVarBndrVis,
                                               kindedTV, plainTV,
                                               kindedTVInferred, plainTVInferred,
                                               kindedTVInvis, plainTVInvis,
                                               kindedTVSpecified, plainTVSpecified)
import Language.Haskell.TH.PprLib ((<+>), ($$))
import Language.Haskell.TH.Ppr as Ppr (ppr)
import Language.Haskell.TH.Syntax (ModName, VarBangType, mkModName)

import qualified Language.Haskell.AST as AST
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.PprLib as Ppr

-- | Pretty-print the AST.
pprint :: (PrettyViaTH a, a ~ f (node Language Language f f), f ~ Reformulator.Wrap Language pos s,
           FullyTranslatable
              (Reformulator.ReformulationOf
                  (Extensions.On 'Extensions.RecordWildCards) '[ Extensions.On 'Extensions.NamedFieldPuns ]
                  Language Language pos s)
              node,
           FullyTranslatable
              (Reformulator.ReformulationOf
                  (Extensions.On 'Extensions.NPlusKPatterns) '[ Extensions.On 'Extensions.ViewPatterns ]
                  Language Language pos s)
              node,
           FullyTranslatable
              (Reformulator.ReformulationOf (Extensions.Off 'Extensions.ListTuplePuns) '[ ] Language Language pos s)
              node) => a -> String
pprint :: forall a (f :: * -> *)
       (node :: * -> * -> (* -> *) -> (* -> *) -> *) pos s.
(PrettyViaTH a, a ~ f (node Language Language f f),
 f ~ Wrap Language pos s,
 FullyTranslatable
   (ReformulationOf
      (On 'RecordWildCards)
      '[On 'NamedFieldPuns]
      Language
      Language
      pos
      s)
   node,
 FullyTranslatable
   (ReformulationOf
      (On 'NPlusKPatterns) '[On 'ViewPatterns] Language Language pos s)
   node,
 FullyTranslatable
   (ReformulationOf (Off 'ListTuplePuns) '[] Language Language pos s)
   node) =>
a -> String
pprint = Doc -> String
render (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
Ppr.to_HPJ_Doc (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap
  Language
  pos
  s
  (node
     Language Language (Wrap Language pos s) (Wrap Language pos s))
-> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH
         (Wrap
   Language
   pos
   s
   (node
      Language Language (Wrap Language pos s) (Wrap Language pos s))
 -> Doc)
-> (a
    -> Wrap
         Language
         pos
         s
         (node
            Language Language (Wrap Language pos s) (Wrap Language pos s)))
-> a
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap
  Language
  pos
  s
  (node
     Language Language (Wrap Language pos s) (Wrap Language pos s))
-> Wrap
     Language
     pos
     s
     (node
        Language Language (Wrap Language pos s) (Wrap Language pos s))
forall l1 l2 (node :: * -> * -> (* -> *) -> (* -> *) -> *) pos s.
(Haskell l2, ExtendedWith '[ 'NamedFieldPuns] l2,
 SameWrap 'RecordWildCards '[ 'NamedFieldPuns] pos s l1 l2,
 FullyTranslatable
   (ReformulationOf
      (On 'RecordWildCards) '[On 'NamedFieldPuns] l1 l2 pos s)
   node) =>
Wrap l1 pos s (node l1 l1 (Wrap l1 pos s) (Wrap l1 pos s))
-> Wrap l1 pos s (node l2 l2 (Wrap l1 pos s) (Wrap l1 pos s))
Reformulator.dropRecordWildCards
         (Wrap
   Language
   pos
   s
   (node
      Language Language (Wrap Language pos s) (Wrap Language pos s))
 -> Wrap
      Language
      pos
      s
      (node
         Language Language (Wrap Language pos s) (Wrap Language pos s)))
-> (a
    -> Wrap
         Language
         pos
         s
         (node
            Language Language (Wrap Language pos s) (Wrap Language pos s)))
-> a
-> Wrap
     Language
     pos
     s
     (node
        Language Language (Wrap Language pos s) (Wrap Language pos s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap
  Language
  pos
  s
  (node
     Language Language (Wrap Language pos s) (Wrap Language pos s))
-> Wrap
     Language
     pos
     s
     (node
        Language Language (Wrap Language pos s) (Wrap Language pos s))
forall l1 l2 (node :: * -> * -> (* -> *) -> (* -> *) -> *) pos s.
(Haskell l2, ExtendedWith '[ 'ViewPatterns] l2,
 SameWrap 'NPlusKPatterns '[ 'ViewPatterns] pos s l1 l2,
 FullyTranslatable
   (ReformulationOf
      (On 'NPlusKPatterns) '[On 'ViewPatterns] l1 l2 pos s)
   node) =>
Wrap l1 pos s (node l1 l1 (Wrap l1 pos s) (Wrap l1 pos s))
-> Wrap l1 pos s (node l2 l2 (Wrap l1 pos s) (Wrap l1 pos s))
Reformulator.dropNPlusKPatterns
         (Wrap
   Language
   pos
   s
   (node
      Language Language (Wrap Language pos s) (Wrap Language pos s))
 -> Wrap
      Language
      pos
      s
      (node
         Language Language (Wrap Language pos s) (Wrap Language pos s)))
-> (a
    -> Wrap
         Language
         pos
         s
         (node
            Language Language (Wrap Language pos s) (Wrap Language pos s)))
-> a
-> Wrap
     Language
     pos
     s
     (node
        Language Language (Wrap Language pos s) (Wrap Language pos s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> Wrap
     Language
     pos
     s
     (node
        Language Language (Wrap Language pos s) (Wrap Language pos s))
Wrap
  Language
  pos
  s
  (node
     Language Language (Wrap Language pos s) (Wrap Language pos s))
-> Wrap
     Language
     pos
     s
     (node
        Language Language (Wrap Language pos s) (Wrap Language pos s))
forall l1 l2 (node :: * -> * -> (* -> *) -> (* -> *) -> *) pos s.
(Haskell l2,
 FullyTranslatable
   (ReformulationOf (Off 'ListTuplePuns) '[] l1 l2 pos s) node) =>
Wrap l1 pos s (node l1 l1 (Wrap l1 pos s) (Wrap l1 pos s))
-> Wrap l1 pos s (node l2 l2 (Wrap l1 pos s) (Wrap l1 pos s))
Reformulator.dropNoListTuplePuns

doE, mdoE :: [Stmt] -> Exp
#if MIN_VERSION_template_haskell(2,17,0)
doE :: [Stmt] -> Exp
doE = Maybe ModName -> [Stmt] -> Exp
DoE Maybe ModName
forall a. Maybe a
Nothing
mdoE :: [Stmt] -> Exp
mdoE = Maybe ModName -> [Stmt] -> Exp
MDoE Maybe ModName
forall a. Maybe a
Nothing
#else
doE = DoE
mdoE = MDoE
#endif

-- | Class for AST nodes that can be pretty-printed, typically via Template Haskell
class PrettyViaTH a where
  -- | Turn the node into a 'Ppr.Doc'.
   prettyViaTH :: a -> Ppr.Doc

class Functor f => TemplateWrapper f where
   extract :: f a -> a
   isParenthesized :: f a -> Bool

instance TemplateWrapper Bound where
   extract :: forall a. Bound a -> a
extract = ((Int, ParsedLexemes Text, Int), a) -> a
forall a b. (a, b) -> b
snd (((Int, ParsedLexemes Text, Int), a) -> a)
-> (Bound a -> ((Int, ParsedLexemes Text, Int), a)) -> Bound a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attributes Language, ((Int, ParsedLexemes Text, Int), a))
-> ((Int, ParsedLexemes Text, Int), a)
forall a b. (a, b) -> b
snd ((Attributes Language, ((Int, ParsedLexemes Text, Int), a))
 -> ((Int, ParsedLexemes Text, Int), a))
-> (Bound a
    -> (Attributes Language, ((Int, ParsedLexemes Text, Int), a)))
-> Bound a
-> ((Int, ParsedLexemes Text, Int), a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a
-> (Attributes Language, ((Int, ParsedLexemes Text, Int), a))
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
   isParenthesized :: forall a. Bound a -> Bool
isParenthesized = Placed a -> Bool
forall a. Placed a -> Bool
forall (f :: * -> *) a. TemplateWrapper f => f a -> Bool
isParenthesized (Placed a -> Bool) -> (Bound a -> Placed a) -> Bound a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attributes Language, Placed a) -> Placed a
forall a b. (a, b) -> b
snd ((Attributes Language, Placed a) -> Placed a)
-> (Bound a -> (Attributes Language, Placed a))
-> Bound a
-> Placed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> (Attributes Language, Placed a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance TemplateWrapper Placed where
   extract :: forall a. Placed a -> a
extract = ((Int, ParsedLexemes Text, Int), a) -> a
forall a b. (a, b) -> b
snd
   isParenthesized :: forall a. Placed a -> Bool
isParenthesized ((Int
_, Trailing (Lexeme Text
lexeme:[Lexeme Text]
_), Int
_), a
_) = Text
"(" Text -> Text -> Bool
`Text.isPrefixOf` Lexeme Text -> Text
forall s. Lexeme s -> s
lexemeText Lexeme Text
lexeme
   isParenthesized ((Int, ParsedLexemes Text, Int), a)
_ = Bool
False

instance PrettyViaTH a => PrettyViaTH (x, a) where
   prettyViaTH :: (x, a) -> Doc
prettyViaTH = a -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (a -> Doc) -> ((x, a) -> a) -> (x, a) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, a) -> a
forall a b. (a, b) -> b
snd

instance (Foldable f, PrettyViaTH a) => PrettyViaTH (Compose f ((,) x) a) where
   prettyViaTH :: Compose f ((,) x) a -> Doc
prettyViaTH = ((x, a) -> Doc -> Doc) -> Doc -> f (x, a) -> Doc
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> ((x, a) -> Doc) -> (x, a) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, a) -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH) Doc
Ppr.empty (f (x, a) -> Doc)
-> (Compose f ((,) x) a -> f (x, a)) -> Compose f ((,) x) a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f ((,) x) a -> f (x, a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance TemplateWrapper f => PrettyViaTH (Module Language Language f f) where
   prettyViaTH :: Module Language Language f f -> Doc
prettyViaTH (AnonymousModule [f (Import Language Language f f)]
imports [f (Declaration Language Language f f)]
declarations) =
      [Doc] -> Doc
Ppr.vcat ((Import Language Language f f -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (Import Language Language f f -> Doc)
-> (f (Import Language Language f f)
    -> Import Language Language f f)
-> f (Import Language Language f f)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Import Language Language f f) -> Import Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Import Language Language f f) -> Doc)
-> [f (Import Language Language f f)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Import Language Language f f)]
[f (Import Language Language f f)]
imports) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Declaration Language Language f f -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (Declaration Language Language f f -> Doc)
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Declaration Language Language f f) -> Doc)
-> [f (Declaration Language Language f f)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
declarations))
   prettyViaTH (NamedModule ModuleName Language
name Maybe [f (Export Language Language f f)]
exports [f (Import Language Language f f)]
imports [f (Declaration Language Language f f)]
declarations) =
      String -> Doc
Ppr.text String
"module" Doc -> Doc -> Doc
<+> ModuleName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH ModuleName Language
ModuleName Language
name Doc -> Doc -> Doc
<+> Doc
-> ([f (Export Language Language f f)] -> Doc)
-> Maybe [f (Export Language Language f f)]
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Ppr.empty [f (Export Language Language f f)] -> Doc
forall {b} {f :: * -> *}.
(PrettyViaTH b, TemplateWrapper f) =>
[f b] -> Doc
showExports Maybe [f (Export Language Language f f)]
Maybe [f (Export Language Language f f)]
exports Doc -> Doc -> Doc
<+> String -> Doc
Ppr.text String
"where"
      Doc -> Doc -> Doc
$$ Module Language Language f f -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH ([f (Import Language Language f f)]
-> [f (Declaration Language Language f f)]
-> Module Language Language f f
forall λ l (d :: * -> *) (s :: * -> *).
[s (Import l l d d)] -> [s (Declaration l l d d)] -> Module λ l d s
AnonymousModule [f (Import Language Language f f)]
imports [f (Declaration Language Language f f)]
declarations :: Module Language Language f f)
      where showExports :: [f b] -> Doc
showExports [f b]
xs = Doc -> Doc
Ppr.parens ([Doc] -> Doc
Ppr.sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
Ppr.punctuate Doc
Ppr.comma (b -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (b -> Doc) -> (f b -> b) -> f b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> b
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f b -> Doc) -> [f b] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f b]
xs))
   prettyViaTH (ExtendedModule [ExtensionSwitch]
extensions f (Module Language Language f f)
body) =
      [Doc] -> Doc
Ppr.vcat [String -> Doc
Ppr.text String
"{-# LANGUAGE" Doc -> Doc -> Doc
<+> [Doc] -> Doc
Ppr.sep (Doc -> [Doc] -> [Doc]
Ppr.punctuate Doc
Ppr.comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ExtensionSwitch -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (ExtensionSwitch -> Doc) -> [ExtensionSwitch] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExtensionSwitch]
extensions)
                Doc -> Doc -> Doc
<+> String -> Doc
Ppr.text String
"#-}",
                Module Language Language f f -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (Module Language Language f f -> Doc)
-> Module Language Language f f -> Doc
forall a b. (a -> b) -> a -> b
$ f (Module Language Language f f) -> Module Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Module Language Language f f)
f (Module Language Language f f)
body]

instance PrettyViaTH ExtensionSwitch where
   prettyViaTH :: ExtensionSwitch -> Doc
prettyViaTH (ExtensionSwitch (Extension
Extensions.EmptyDataDeclarations, Bool
True)) = String -> Doc
Ppr.text String
"EmptyDataDecls"
   prettyViaTH (ExtensionSwitch (Extension
x, Bool
True)) = String -> Doc
Ppr.text (Extension -> String
forall a. Show a => a -> String
show Extension
x)
   prettyViaTH (ExtensionSwitch (Extension
x, Bool
False)) = String -> Doc
Ppr.text String
"No" Doc -> Doc -> Doc
Ppr.<> ExtensionSwitch -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH ((Extension, Bool) -> ExtensionSwitch
ExtensionSwitch (Extension
x, Bool
True))

instance PrettyViaTH (Export Language Language f f) where
   prettyViaTH :: Export Language Language f f -> Doc
prettyViaTH (ExportClassOrType name :: QualifiedName Language
name@(AST.QualifiedName Maybe (ModuleName Language)
_ (AST.Name Text
local)) Maybe (Members Language)
members)
      | (Char -> Bool) -> Text -> Bool
Text.all (\Char
c-> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
Char.isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
local =
        (if Int -> Text -> Text
Text.take Int
1 Text
local Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
":" then Doc -> Doc
forall a. a -> a
id else (String -> Doc
Ppr.text String
"type" Doc -> Doc -> Doc
<+>)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc -> Doc
Ppr.parens (QualifiedName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH QualifiedName Language
QualifiedName Language
name) Doc -> Doc -> Doc
Ppr.<> Doc
prettyMembers
      | Bool
otherwise = QualifiedName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH QualifiedName Language
QualifiedName Language
name Doc -> Doc -> Doc
Ppr.<> Doc
prettyMembers
      where prettyMembers :: Doc
prettyMembers = Doc -> (Members Language -> Doc) -> Maybe (Members Language) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Ppr.empty (Doc -> Doc
Ppr.parens (Doc -> Doc)
-> (Members Language -> Doc) -> Members Language -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Members Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH) Maybe (Members Language)
Maybe (Members Language)
members
   prettyViaTH (ExportVar name :: QualifiedName Language
name@(AST.QualifiedName Maybe (ModuleName Language)
_ (AST.Name Text
local)))
      | (Char -> Bool) -> Text -> Bool
Text.all (\Char
c-> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
Char.isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
local = Doc -> Doc
Ppr.parens (QualifiedName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH QualifiedName Language
QualifiedName Language
name)
      | Bool
otherwise = QualifiedName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH QualifiedName Language
QualifiedName Language
name
   prettyViaTH (ExportPattern name :: QualifiedName Language
name@(AST.QualifiedName Maybe (ModuleName Language)
_ (AST.Name Text
local)))
      | (Char -> Bool) -> Text -> Bool
Text.all (\Char
c-> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
Char.isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
local = Doc -> Doc
Ppr.parens (QualifiedName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH QualifiedName Language
QualifiedName Language
name)
      | Bool
otherwise = QualifiedName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH QualifiedName Language
QualifiedName Language
name
   prettyViaTH (ReExportModule ModuleName Language
name) = String -> Doc
Ppr.text String
"module" Doc -> Doc -> Doc
<+> ModuleName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH ModuleName Language
ModuleName Language
name

instance TemplateWrapper f => PrettyViaTH (Import Language Language f f) where
   prettyViaTH :: Import Language Language f f -> Doc
prettyViaTH (Import Bool
safe Bool
qualified Maybe Text
package ModuleName Language
name Maybe (ModuleName Language)
alias Maybe (f (ImportSpecification Language Language f f))
imports) =
      String -> Doc
Ppr.text String
"import" Doc -> Doc -> Doc
<+> (if Bool
safe then String -> Doc
Ppr.text String
"safe" else Doc
Ppr.empty)
      Doc -> Doc -> Doc
<+> (if Bool
qualified then String -> Doc
Ppr.text String
"qualified" else Doc
Ppr.empty)
      Doc -> Doc -> Doc
<+> Doc -> (Text -> Doc) -> Maybe Text -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Ppr.empty (Doc -> Doc
Ppr.doubleQuotes (Doc -> Doc) -> (Text -> Doc) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
Ppr.text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) Maybe Text
package
      Doc -> Doc -> Doc
<+> ModuleName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH ModuleName Language
ModuleName Language
name
      Doc -> Doc -> Doc
<+> Doc
-> (ModuleName Language -> Doc)
-> Maybe (ModuleName Language)
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Ppr.empty ((String -> Doc
Ppr.text String
"as" Doc -> Doc -> Doc
<+>) (Doc -> Doc)
-> (ModuleName Language -> Doc) -> ModuleName Language -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH) Maybe (ModuleName Language)
Maybe (ModuleName Language)
alias
      Doc -> Doc -> Doc
<+> Doc
-> (f (ImportSpecification Language Language f f) -> Doc)
-> Maybe (f (ImportSpecification Language Language f f))
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Ppr.empty (ImportSpecification Language Language f f -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (ImportSpecification Language Language f f -> Doc)
-> (f (ImportSpecification Language Language f f)
    -> ImportSpecification Language Language f f)
-> f (ImportSpecification Language Language f f)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (ImportSpecification Language Language f f)
-> ImportSpecification Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) Maybe (f (ImportSpecification Language Language f f))
Maybe (f (ImportSpecification Language Language f f))
imports

instance TemplateWrapper f => PrettyViaTH (ImportSpecification Language Language f f) where
   prettyViaTH :: ImportSpecification Language Language f f -> Doc
prettyViaTH (ImportSpecification Bool
inclusive [f (ImportItem Language Language f f)]
items) =
      (if Bool
inclusive then Doc -> Doc
forall a. a -> a
id else (String -> Doc
Ppr.text String
"hiding" Doc -> Doc -> Doc
<+>))
      (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
Ppr.parens ([Doc] -> Doc
Ppr.sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
Ppr.punctuate Doc
Ppr.comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ImportItem Language Language f f -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (ImportItem Language Language f f -> Doc)
-> (f (ImportItem Language Language f f)
    -> ImportItem Language Language f f)
-> f (ImportItem Language Language f f)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (ImportItem Language Language f f)
-> ImportItem Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (ImportItem Language Language f f) -> Doc)
-> [f (ImportItem Language Language f f)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (ImportItem Language Language f f)]
[f (ImportItem Language Language f f)]
items)

instance PrettyViaTH (ImportItem Language Language f f) where
   prettyViaTH :: ImportItem Language Language f f -> Doc
prettyViaTH (ImportClassOrType name :: Name Language
name@(AST.Name Text
local) Maybe (Members Language)
members)
      | (Char -> Bool) -> Text -> Bool
Text.all (\Char
c-> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
Char.isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
local =
        (if Int -> Text -> Text
Text.take Int
1 Text
local Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
":" then Doc -> Doc
forall a. a -> a
id else (String -> Doc
Ppr.text String
"type" Doc -> Doc -> Doc
<+>)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc -> Doc
Ppr.parens (Name Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH Name Language
Name Language
name) Doc -> Doc -> Doc
Ppr.<> Doc
prettyMembers
      | Bool
otherwise = Name Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH Name Language
Name Language
name Doc -> Doc -> Doc
Ppr.<> Doc
prettyMembers
      where prettyMembers :: Doc
prettyMembers = Doc -> (Members Language -> Doc) -> Maybe (Members Language) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Ppr.empty (Doc -> Doc
Ppr.parens (Doc -> Doc)
-> (Members Language -> Doc) -> Members Language -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Members Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH) Maybe (Members Language)
Maybe (Members Language)
members
   prettyViaTH (ImportVar name :: Name Language
name@(AST.Name Text
local)) = Name Language -> Doc
prettyIdentifier Name Language
Name Language
name
   prettyViaTH (ImportPattern name :: Name Language
name@(AST.Name Text
local)) = String -> Doc
Ppr.text String
"pattern" Doc -> Doc -> Doc
<+> Name Language -> Doc
prettyIdentifier Name Language
Name Language
name

instance PrettyViaTH (Members Language) where
   prettyViaTH :: Members Language -> Doc
prettyViaTH (MemberList [Name Language]
names) = [Doc] -> Doc
Ppr.sep (Doc -> [Doc] -> [Doc]
Ppr.punctuate Doc
Ppr.comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Name Language -> Doc
prettyIdentifier (Name Language -> Doc) -> [Name Language] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name Language]
names)
   prettyViaTH (ExplicitlyNamespacedMemberList () [ModuleMember Language]
members) = [Doc] -> Doc
Ppr.sep (Doc -> [Doc] -> [Doc]
Ppr.punctuate Doc
Ppr.comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ModuleMember Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (ModuleMember Language -> Doc) -> [ModuleMember Language] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleMember Language]
members)
   prettyViaTH Members Language
AllMembers = String -> Doc
Ppr.text String
".."
   prettyViaTH (AllMembersPlus [Name Language]
extras) = [Doc] -> Doc
Ppr.sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
Ppr.punctuate Doc
Ppr.comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> Doc
Ppr.text String
".." Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Name Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH (Name Language -> Doc) -> [Name Language] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name Language]
extras)

instance PrettyViaTH (ModuleMember Language) where
   prettyViaTH :: ModuleMember Language -> Doc
prettyViaTH (DefaultMember Name Language
name) = Name Language -> Doc
prettyIdentifier Name Language
name
   prettyViaTH (PatternMember Name Language
name) = String -> Doc
Ppr.text String
"pattern" Doc -> Doc -> Doc
<+> Name Language -> Doc
prettyIdentifier Name Language
name
   prettyViaTH (TypeMember Name Language
name) = String -> Doc
Ppr.text String
"type" Doc -> Doc -> Doc
<+> Name Language -> Doc
prettyIdentifier Name Language
name

prettyIdentifier :: AST.Name Language -> Ppr.Doc
prettyIdentifier :: Name Language -> Doc
prettyIdentifier name :: Name Language
name@(AST.Name Text
local)
   | Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
Text.uncons Text
local, Char -> Bool
Char.isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = Name Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH Name Language
name
   | Bool
otherwise = Doc -> Doc
Ppr.parens (Name Language -> Doc
forall a. PrettyViaTH a => a -> Doc
prettyViaTH Name Language
name)

instance TemplateWrapper f => PrettyViaTH (Declaration Language Language f f) where
   prettyViaTH :: Declaration Language Language f f -> Doc
prettyViaTH Declaration Language Language f f
x = [Doc] -> Doc
Ppr.vcat (Dec -> Doc
forall a. Ppr a => a -> Doc
Ppr.ppr (Dec -> Doc) -> [Dec] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates Declaration Language Language f f
x)

instance TemplateWrapper f => PrettyViaTH (Expression Language Language f f) where
   prettyViaTH :: Expression Language Language f f -> Doc
prettyViaTH Expression Language Language f f
x = Exp -> Doc
forall a. Ppr a => a -> Doc
Ppr.ppr (Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate Expression Language Language f f
x)

instance PrettyViaTH (ModuleName Language) where
   prettyViaTH :: ModuleName Language -> Doc
prettyViaTH (ModuleName NonEmpty (Name Language)
mods) = Name -> Doc
forall a. Ppr a => a -> Doc
Ppr.ppr (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name Language -> Text
forall λ. Name λ -> Text
nameText (Name Language -> Text) -> [Name Language] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
mods)

instance PrettyViaTH (AST.Name Language) where
   prettyViaTH :: Name Language -> Doc
prettyViaTH Name Language
x = Name -> Doc
Ppr.pprName (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
x)

instance PrettyViaTH (QualifiedName Language) where
   prettyViaTH :: QualifiedName Language -> Doc
prettyViaTH QualifiedName Language
x = Name -> Doc
Ppr.pprName (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
x)

expressionTemplate :: TemplateWrapper f => Expression Language Language f f -> Exp
expressionTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (ApplyExpression f (Expression Language Language f f)
f f (Expression Language Language f f)
x) = Exp -> Exp -> Exp
AppE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
f) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
x)
expressionTemplate (ConditionalExpression f (Expression Language Language f f)
test f (Expression Language Language f f)
true f (Expression Language Language f f)
false) =
   Exp -> Exp -> Exp -> Exp
CondE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
test) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
true) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
false)
expressionTemplate (ConstructorExpression f (Constructor Language Language f f)
con) = case (f (Constructor Language Language f f)
-> Constructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Constructor Language Language f f)
f (Constructor Language Language f f)
con)
   of ConstructorReference QualifiedName Language
name -> Name -> Exp
ConE (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)
      Constructor Language Language f f
EmptyListConstructor -> [Exp] -> Exp
ListE []
      TupleConstructor Int
n -> [Maybe Exp] -> Exp
TupE (Int -> Maybe Exp -> [Maybe Exp]
forall a. Int -> a -> [a]
replicate Int
n Maybe Exp
forall a. Maybe a
Nothing)
      UnboxedTupleConstructor () Int
n -> [Maybe Exp] -> Exp
UnboxedTupE (Int -> Maybe Exp -> [Maybe Exp]
forall a. Int -> a -> [a]
replicate Int
n Maybe Exp
forall a. Maybe a
Nothing)
      UnboxedSumConstructor{} -> String -> Exp
forall a. HasCallStack => String -> a
error String
"Unboxed sum constructor can't appear in an expression"
      Constructor Language Language f f
UnitConstructor -> [Maybe Exp] -> Exp
TupE []
expressionTemplate (CaseExpression f (Expression Language Language f f)
scrutinee [f (CaseAlternative Language Language f f)]
alternatives) =
   Exp -> [Match] -> Exp
CaseE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
scrutinee) (CaseAlternative Language Language f f -> Match
forall (f :: * -> *).
TemplateWrapper f =>
CaseAlternative Language Language f f -> Match
caseAlternativeTemplate (CaseAlternative Language Language f f -> Match)
-> (f (CaseAlternative Language Language f f)
    -> CaseAlternative Language Language f f)
-> f (CaseAlternative Language Language f f)
-> Match
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (CaseAlternative Language Language f f)
-> CaseAlternative Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (CaseAlternative Language Language f f) -> Match)
-> [f (CaseAlternative Language Language f f)] -> [Match]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (CaseAlternative Language Language f f)]
[f (CaseAlternative Language Language f f)]
alternatives)
expressionTemplate (MultiWayIfExpression [f (GuardedExpression Language Language f f)]
alternatives) = [(Guard, Exp)] -> Exp
MultiIfE (GuardedExpression Language Language f f -> (Guard, Exp)
forall (f :: * -> *) λ.
TemplateWrapper f =>
GuardedExpression λ Language f f -> (Guard, Exp)
guardedTemplatePair (GuardedExpression Language Language f f -> (Guard, Exp))
-> (f (GuardedExpression Language Language f f)
    -> GuardedExpression Language Language f f)
-> f (GuardedExpression Language Language f f)
-> (Guard, Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (GuardedExpression Language Language f f)
-> GuardedExpression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (GuardedExpression Language Language f f) -> (Guard, Exp))
-> [f (GuardedExpression Language Language f f)] -> [(Guard, Exp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (GuardedExpression Language Language f f)]
[f (GuardedExpression Language Language f f)]
alternatives)
expressionTemplate (LambdaCaseExpression () [f (CaseAlternative Language Language f f)]
alternatives) =
   [Match] -> Exp
LamCaseE (CaseAlternative Language Language f f -> Match
forall (f :: * -> *).
TemplateWrapper f =>
CaseAlternative Language Language f f -> Match
caseAlternativeTemplate (CaseAlternative Language Language f f -> Match)
-> (f (CaseAlternative Language Language f f)
    -> CaseAlternative Language Language f f)
-> f (CaseAlternative Language Language f f)
-> Match
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (CaseAlternative Language Language f f)
-> CaseAlternative Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (CaseAlternative Language Language f f) -> Match)
-> [f (CaseAlternative Language Language f f)] -> [Match]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (CaseAlternative Language Language f f)]
[f (CaseAlternative Language Language f f)]
alternatives)
expressionTemplate (LambdaCasesExpression () [f (LambdaCasesAlternative Language Language f f)]
alternatives) =
   [Clause] -> Exp
LamCasesE (LambdaCasesAlternative Language Language f f -> Clause
forall {λ} {f :: * -> *} {f :: * -> *}.
(If (Elem 'LambdaCase (ExtensionsSupportedBy λ)) () Void ~ (),
 TemplateWrapper f, TemplateWrapper f) =>
LambdaCasesAlternative λ Language f f -> Clause
casesAlternativeTemplate (LambdaCasesAlternative Language Language f f -> Clause)
-> (f (LambdaCasesAlternative Language Language f f)
    -> LambdaCasesAlternative Language Language f f)
-> f (LambdaCasesAlternative Language Language f f)
-> Clause
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (LambdaCasesAlternative Language Language f f)
-> LambdaCasesAlternative Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (LambdaCasesAlternative Language Language f f) -> Clause)
-> [f (LambdaCasesAlternative Language Language f f)] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (LambdaCasesAlternative Language Language f f)]
[f (LambdaCasesAlternative Language Language f f)]
alternatives)
   where casesAlternativeTemplate :: LambdaCasesAlternative λ Language f f -> Clause
casesAlternativeTemplate (LambdaCasesAlternative () [f (Pattern Language Language f f)]
lhs f (EquationRHS Language Language f f)
rhs) =
            [Pat] -> Body -> [Dec] -> Clause
Clause (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
lhs) (EquationRHS Language Language f f -> Body
forall (f :: * -> *).
TemplateWrapper f =>
EquationRHS Language Language f f -> Body
rhsTemplate (EquationRHS Language Language f f -> Body)
-> EquationRHS Language Language f f -> Body
forall a b. (a -> b) -> a -> b
$ f (EquationRHS Language Language f f)
-> EquationRHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (EquationRHS Language Language f f)
f (EquationRHS Language Language f f)
rhs) []
expressionTemplate (DoExpression f (GuardedExpression Language Language f f)
statements) = [Stmt] -> Exp
doE (GuardedExpression Language Language f f -> [Stmt]
forall (f :: * -> *).
TemplateWrapper f =>
GuardedExpression Language Language f f -> [Stmt]
guardedTemplate (GuardedExpression Language Language f f -> [Stmt])
-> GuardedExpression Language Language f f -> [Stmt]
forall a b. (a -> b) -> a -> b
$ f (GuardedExpression Language Language f f)
-> GuardedExpression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (GuardedExpression Language Language f f)
f (GuardedExpression Language Language f f)
statements)
expressionTemplate (MDoExpression f (GuardedExpression Language Language f f)
statements) = [Stmt] -> Exp
mdoE (GuardedExpression Language Language f f -> [Stmt]
forall (f :: * -> *).
TemplateWrapper f =>
GuardedExpression Language Language f f -> [Stmt]
guardedTemplate (GuardedExpression Language Language f f -> [Stmt])
-> GuardedExpression Language Language f f -> [Stmt]
forall a b. (a -> b) -> a -> b
$ f (GuardedExpression Language Language f f)
-> GuardedExpression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (GuardedExpression Language Language f f)
f (GuardedExpression Language Language f f)
statements)

#if MIN_VERSION_template_haskell(2,17,0)
expressionTemplate (QualifiedDoExpression () ModuleName Language
m f (GuardedExpression Language Language f f)
statements) =
   Maybe ModName -> [Stmt] -> Exp
DoE (ModName -> Maybe ModName
forall a. a -> Maybe a
Just (ModName -> Maybe ModName) -> ModName -> Maybe ModName
forall a b. (a -> b) -> a -> b
$ ModuleName Language -> ModName
forall l. ModuleName l -> ModName
moduleNameTemplate ModuleName Language
ModuleName Language
m) (GuardedExpression Language Language f f -> [Stmt]
forall (f :: * -> *).
TemplateWrapper f =>
GuardedExpression Language Language f f -> [Stmt]
guardedTemplate (GuardedExpression Language Language f f -> [Stmt])
-> GuardedExpression Language Language f f -> [Stmt]
forall a b. (a -> b) -> a -> b
$ f (GuardedExpression Language Language f f)
-> GuardedExpression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (GuardedExpression Language Language f f)
f (GuardedExpression Language Language f f)
statements)
expressionTemplate (MDoQualifiedExpression () () ModuleName Language
m f (GuardedExpression Language Language f f)
statements) =
   Maybe ModName -> [Stmt] -> Exp
MDoE (ModName -> Maybe ModName
forall a. a -> Maybe a
Just (ModName -> Maybe ModName) -> ModName -> Maybe ModName
forall a b. (a -> b) -> a -> b
$ ModuleName Language -> ModName
forall l. ModuleName l -> ModName
moduleNameTemplate ModuleName Language
ModuleName Language
m) (GuardedExpression Language Language f f -> [Stmt]
forall (f :: * -> *).
TemplateWrapper f =>
GuardedExpression Language Language f f -> [Stmt]
guardedTemplate (GuardedExpression Language Language f f -> [Stmt])
-> GuardedExpression Language Language f f -> [Stmt]
forall a b. (a -> b) -> a -> b
$ f (GuardedExpression Language Language f f)
-> GuardedExpression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (GuardedExpression Language Language f f)
f (GuardedExpression Language Language f f)
statements)
#endif

expressionTemplate (ImplicitParameterExpression SupportFor 'ImplicitParameters Language
_ Name Language
name) = String -> Exp
ImplicitParamVarE (Name Language -> String
forall λ. Name λ -> String
nameString Name Language
Name Language
name)
expressionTemplate (InfixExpression f (Expression Language Language f f)
left f (Expression Language Language f f)
op f (Expression Language Language f f)
right) =
   Exp -> Exp -> Exp -> Exp
UInfixE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
left) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
op) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
right)
expressionTemplate (LeftSectionExpression f (Expression Language Language f f)
left QualifiedName Language
op) =
   Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
left) (QualifiedName Language -> Exp
nameReferenceTemplate QualifiedName Language
QualifiedName Language
op) Maybe Exp
forall a. Maybe a
Nothing
expressionTemplate (LambdaExpression [f (Pattern Language Language f f)]
patterns f (Expression Language Language f f)
body) =
   [Pat] -> Exp -> Exp
LamE (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
patterns) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
body)
expressionTemplate (LetExpression [f (Declaration Language Language f f)]
bindings f (Expression Language Language f f)
body) =
   [Dec] -> Exp -> Exp
LetE ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
bindings) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
body)
expressionTemplate (ListComprehension f (Expression Language Language f f)
element NonEmpty (f (Statement Language Language f f))
guards) =
   [Stmt] -> Exp
CompE (Statement Language Language f f -> Stmt
forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (Statement Language Language f f -> Stmt)
-> [Statement Language Language f f] -> [Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((f (Statement Language Language f f)
-> Statement Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Statement Language Language f f)
 -> Statement Language Language f f)
-> [f (Statement Language Language f f)]
-> [Statement Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Statement Language Language f f))
-> [f (Statement Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Statement Language Language f f))
NonEmpty (f (Statement Language Language f f))
guards) [Statement Language Language f f]
-> [Statement Language Language f f]
-> [Statement Language Language f f]
forall a. [a] -> [a] -> [a]
++ [f (Expression Language Language f f)
-> Statement Language Language f f
forall λ l (d :: * -> *) (s :: * -> *).
s (Expression l l d d) -> Statement λ l d s
ExpressionStatement f (Expression Language Language f f)
element]))
expressionTemplate (ParallelListComprehension f (Expression Language Language f f)
element NonEmpty (f (Statement Language Language f f))
guards1 NonEmpty (f (Statement Language Language f f))
guards2 [NonEmpty (f (Statement Language Language f f))]
guardses) =
   [Stmt] -> Exp
CompE [[[Stmt]] -> Stmt
ParS (NonEmpty (f (Statement Language Language f f)) -> [Stmt]
forall {f :: * -> *} {f :: * -> *} {t :: * -> *}.
(TemplateWrapper f, TemplateWrapper f, Foldable t) =>
t (f (Statement Language Language f f)) -> [Stmt]
branch NonEmpty (f (Statement Language Language f f))
NonEmpty (f (Statement Language Language f f))
guards1 [Stmt] -> [[Stmt]] -> [[Stmt]]
forall a. a -> [a] -> [a]
: NonEmpty (f (Statement Language Language f f)) -> [Stmt]
forall {f :: * -> *} {f :: * -> *} {t :: * -> *}.
(TemplateWrapper f, TemplateWrapper f, Foldable t) =>
t (f (Statement Language Language f f)) -> [Stmt]
branch NonEmpty (f (Statement Language Language f f))
NonEmpty (f (Statement Language Language f f))
guards2 [Stmt] -> [[Stmt]] -> [[Stmt]]
forall a. a -> [a] -> [a]
: (NonEmpty (f (Statement Language Language f f)) -> [Stmt])
-> [NonEmpty (f (Statement Language Language f f))] -> [[Stmt]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty (f (Statement Language Language f f)) -> [Stmt]
forall {f :: * -> *} {f :: * -> *} {t :: * -> *}.
(TemplateWrapper f, TemplateWrapper f, Foldable t) =>
t (f (Statement Language Language f f)) -> [Stmt]
branch [NonEmpty (f (Statement Language Language f f))]
[NonEmpty (f (Statement Language Language f f))]
guardses),
          Statement Language Language f f -> Stmt
forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (f (Expression Language Language f f)
-> Statement Language Language f f
forall λ l (d :: * -> *) (s :: * -> *).
s (Expression l l d d) -> Statement λ l d s
ExpressionStatement f (Expression Language Language f f)
element)]
   where branch :: t (f (Statement Language Language f f)) -> [Stmt]
branch t (f (Statement Language Language f f))
statements = Statement Language Language f f -> Stmt
forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (Statement Language Language f f -> Stmt)
-> [Statement Language Language f f] -> [Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f (Statement Language Language f f)
-> Statement Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Statement Language Language f f)
 -> Statement Language Language f f)
-> [f (Statement Language Language f f)]
-> [Statement Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (f (Statement Language Language f f))
-> [f (Statement Language Language f f)]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (f (Statement Language Language f f))
statements)
expressionTemplate (ListExpression [f (Expression Language Language f f)]
items) = [Exp] -> Exp
ListE (Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Exp)
-> [f (Expression Language Language f f)] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Expression Language Language f f)]
[f (Expression Language Language f f)]
items)
expressionTemplate (LiteralExpression f (Value Language Language f f)
value) = Lit -> Exp
LitE (Value Language Language f f -> Lit
forall (f :: * -> *).
TemplateWrapper f =>
Value Language Language f f -> Lit
literalTemplate (Value Language Language f f -> Lit)
-> Value Language Language f f -> Lit
forall a b. (a -> b) -> a -> b
$ f (Value Language Language f f) -> Value Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Value Language Language f f)
f (Value Language Language f f)
value)
expressionTemplate Expression Language Language f f
Negate = Name -> Exp
VarE (String -> Name
mkName String
"Prelude.negate")
expressionTemplate (RecordExpression f (Expression Language Language f f)
record [f (FieldBinding Language Language f f)]
fields) =
   (case f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Expression Language Language f f)
f (Expression Language Language f f)
record
    of ConstructorExpression f (Constructor Language Language f f)
con | ConstructorReference QualifiedName Language
name <- f (Constructor Language Language f f)
-> Constructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Constructor Language Language f f)
f (Constructor Language Language f f)
con -> Name -> [FieldExp] -> Exp
RecConE (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)
       Expression Language Language f f
e -> Exp -> [FieldExp] -> Exp
RecUpdE (Exp -> [FieldExp] -> Exp) -> Exp -> [FieldExp] -> Exp
forall a b. (a -> b) -> a -> b
$ Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate Expression Language Language f f
e)
   (FieldBinding Language Language f f -> FieldExp
forall (f :: * -> *).
TemplateWrapper f =>
FieldBinding Language Language f f -> FieldExp
fieldBindingTemplate (FieldBinding Language Language f f -> FieldExp)
-> (f (FieldBinding Language Language f f)
    -> FieldBinding Language Language f f)
-> f (FieldBinding Language Language f f)
-> FieldExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FieldBinding Language Language f f)
-> FieldBinding Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (FieldBinding Language Language f f) -> FieldExp)
-> [f (FieldBinding Language Language f f)] -> [FieldExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (FieldBinding Language Language f f)]
[f (FieldBinding Language Language f f)]
fields)
expressionTemplate WildcardRecordExpression{} = String -> Exp
forall a. HasCallStack => String -> a
error String
"TH doesn't support record wildcards"
expressionTemplate (ReferenceExpression QualifiedName Language
name) = Name -> Exp
VarE (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)
expressionTemplate (RightSectionExpression QualifiedName Language
op f (Expression Language Language f f)
right) =
   Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
forall a. Maybe a
Nothing (QualifiedName Language -> Exp
nameReferenceTemplate QualifiedName Language
QualifiedName Language
op) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
right)
expressionTemplate (SequenceExpression f (Expression Language Language f f)
start Maybe (f (Expression Language Language f f))
next Maybe (f (Expression Language Language f f))
end) = Range -> Exp
ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$
   case (Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Exp)
-> Maybe (f (Expression Language Language f f)) -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Expression Language Language f f))
Maybe (f (Expression Language Language f f))
next, Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Exp)
-> Maybe (f (Expression Language Language f f)) -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Expression Language Language f f))
Maybe (f (Expression Language Language f f))
end)
   of (Maybe Exp
Nothing, Maybe Exp
Nothing) -> Exp -> Range
FromR Exp
s
      (Just Exp
n, Maybe Exp
Nothing) -> Exp -> Exp -> Range
FromThenR Exp
s Exp
n
      (Maybe Exp
Nothing, Just Exp
e) -> Exp -> Exp -> Range
FromToR Exp
s Exp
e
      (Just Exp
n, Just Exp
e) -> Exp -> Exp -> Exp -> Range
FromThenToR Exp
s Exp
n Exp
e
   where s :: Exp
s = f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
start
expressionTemplate (TupleExpression NonEmpty (f (Expression Language Language f f))
items) = [Maybe Exp] -> Exp
TupE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> (f (Expression Language Language f f) -> Exp)
-> f (Expression Language Language f f)
-> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Maybe Exp)
-> [f (Expression Language Language f f)] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Expression Language Language f f))
-> [f (Expression Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Expression Language Language f f))
NonEmpty (f (Expression Language Language f f))
items)
expressionTemplate (TupleSectionExpression NonEmpty (Maybe (f (Expression Language Language f f)))
items) = [Maybe Exp] -> Exp
TupE ((Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Exp)
-> Maybe (f (Expression Language Language f f)) -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (f (Expression Language Language f f)) -> Maybe Exp)
-> [Maybe (f (Expression Language Language f f))] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Maybe (f (Expression Language Language f f)))
-> [Maybe (f (Expression Language Language f f))]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Maybe (f (Expression Language Language f f)))
NonEmpty (Maybe (f (Expression Language Language f f)))
items)
expressionTemplate (UnboxedTupleExpression () NonEmpty (f (Expression Language Language f f))
items) =
   [Maybe Exp] -> Exp
UnboxedTupE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> (f (Expression Language Language f f) -> Exp)
-> f (Expression Language Language f f)
-> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Maybe Exp)
-> [f (Expression Language Language f f)] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Expression Language Language f f))
-> [f (Expression Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Expression Language Language f f))
NonEmpty (f (Expression Language Language f f))
items)
expressionTemplate (UnboxedTupleSectionExpression () NonEmpty (Maybe (f (Expression Language Language f f)))
items) =
   [Maybe Exp] -> Exp
UnboxedTupE ((Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> (f (Expression Language Language f f)
    -> Expression Language Language f f)
-> f (Expression Language Language f f)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Expression Language Language f f) -> Exp)
-> Maybe (f (Expression Language Language f f)) -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (f (Expression Language Language f f)) -> Maybe Exp)
-> [Maybe (f (Expression Language Language f f))] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Maybe (f (Expression Language Language f f)))
-> [Maybe (f (Expression Language Language f f))]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Maybe (f (Expression Language Language f f)))
NonEmpty (Maybe (f (Expression Language Language f f)))
items)
expressionTemplate (UnboxedSumExpression () Int
before f (Expression Language Language f f)
branch Int
after) =
   Exp -> Int -> Int -> Exp
UnboxedSumE (Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> Expression Language Language f f -> Exp
forall a b. (a -> b) -> a -> b
$ f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Expression Language Language f f)
f (Expression Language Language f f)
branch) (Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
after Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
expressionTemplate (TypedExpression f (Expression Language Language f f)
e f (Type Language Language f f)
signature) = Exp -> Type -> Exp
SigE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
e) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
signature)
expressionTemplate (VisibleTypeApplication f (Expression Language Language f f)
e f (Type Language Language f f)
t) = Exp -> Type -> Exp
AppTypeE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
e) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
expressionTemplate (ExplicitTypeExpression () f (Type Language Language f f)
t) = Type -> Exp
TypeE (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
expressionTemplate (GetField f (Expression Language Language f f)
e (Name Text
field)) = Exp -> String -> Exp
GetFieldE (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
e) (Text -> String
Text.unpack Text
field)
expressionTemplate (OverloadedLabel Text
l) = String -> Exp
LabelE (Text -> String
Text.unpack Text
l)
expressionTemplate (FieldProjection NonEmpty (Name Language)
fields) = NonEmpty String -> Exp
ProjectionE (Name Language -> String
forall λ. Name λ -> String
nameString (Name Language -> String)
-> NonEmpty (Name Language) -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language)
NonEmpty (Name Language)
fields)

guardedTemplate :: TemplateWrapper f => GuardedExpression Language Language f f -> [Stmt]
guardedTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
GuardedExpression Language Language f f -> [Stmt]
guardedTemplate (GuardedExpression [f (Statement Language Language f f)]
statements f (Expression Language Language f f)
result) =
   (Statement Language Language f f -> Stmt
forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (Statement Language Language f f -> Stmt)
-> (f (Statement Language Language f f)
    -> Statement Language Language f f)
-> f (Statement Language Language f f)
-> Stmt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Statement Language Language f f)
-> Statement Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Statement Language Language f f) -> Stmt)
-> [f (Statement Language Language f f)] -> [Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Statement Language Language f f)]
[f (Statement Language Language f f)]
statements) [Stmt] -> [Stmt] -> [Stmt]
forall a. [a] -> [a] -> [a]
++ [Exp -> Stmt
NoBindS (Exp -> Stmt) -> Exp -> Stmt
forall a b. (a -> b) -> a -> b
$ f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
result]

guardedTemplatePair :: TemplateWrapper f => GuardedExpression λ Language f f -> (Guard, Exp)
guardedTemplatePair :: forall (f :: * -> *) λ.
TemplateWrapper f =>
GuardedExpression λ Language f f -> (Guard, Exp)
guardedTemplatePair (GuardedExpression [f (Statement Language Language f f)]
statements f (Expression Language Language f f)
result) = ([Stmt] -> Guard
PatG ([Stmt] -> Guard) -> [Stmt] -> Guard
forall a b. (a -> b) -> a -> b
$ Statement Language Language f f -> Stmt
forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (Statement Language Language f f -> Stmt)
-> (f (Statement Language Language f f)
    -> Statement Language Language f f)
-> f (Statement Language Language f f)
-> Stmt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Statement Language Language f f)
-> Statement Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Statement Language Language f f) -> Stmt)
-> [f (Statement Language Language f f)] -> [Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Statement Language Language f f)]
[f (Statement Language Language f f)]
statements,
                                                             f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
result)

wrappedExpressionTemplate :: TemplateWrapper f => f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
x = if f (Expression Language Language f f) -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. TemplateWrapper f => f a -> Bool
isParenthesized f (Expression Language Language f f)
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Expression Language Language f f -> Bool
forall {λ} {l} {d :: * -> *} {s :: * -> *}.
Expression λ l d s -> Bool
syntactic Expression Language Language f f
e) then Exp -> Exp
ParensE Exp
template else Exp
template
   where syntactic :: Expression λ l d s -> Bool
syntactic LeftSectionExpression{} = Bool
True
         syntactic RightSectionExpression{} = Bool
True
         syntactic ReferenceExpression{} = Bool
True
         syntactic TupleExpression{} = Bool
True
         syntactic Expression λ l d s
_ = Bool
False
         template :: Exp
template = Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate Expression Language Language f f
e
         e :: Expression Language Language f f
e = f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Expression Language Language f f)
x

caseAlternativeTemplate :: TemplateWrapper f => CaseAlternative Language Language f f -> Match
caseAlternativeTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
CaseAlternative Language Language f f -> Match
caseAlternativeTemplate (CaseAlternative f (Pattern Language Language f f)
lhs f (EquationRHS Language Language f f)
rhs [f (Declaration Language Language f f)]
wheres) =
   Pat -> Body -> [Dec] -> Match
Match (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
lhs) (EquationRHS Language Language f f -> Body
forall (f :: * -> *).
TemplateWrapper f =>
EquationRHS Language Language f f -> Body
rhsTemplate (EquationRHS Language Language f f -> Body)
-> EquationRHS Language Language f f -> Body
forall a b. (a -> b) -> a -> b
$ f (EquationRHS Language Language f f)
-> EquationRHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (EquationRHS Language Language f f)
f (EquationRHS Language Language f f)
rhs) ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
wheres)

declarationTemplates :: TemplateWrapper f => Declaration Language Language f f -> [Dec]
declarationTemplates :: forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (ClassDeclaration f (Context Language Language f f)
context f (TypeLHS Language Language f f)
lhs [f (Declaration Language Language f f)]
members)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Cxt -> Name -> [TyVarBndrVis] -> [FunDep] -> [Dec] -> Dec
ClassD (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars []
             ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
members)]
declarationTemplates (FunDepClassDeclaration () f (Context Language Language f f)
context f (TypeLHS Language Language f f)
lhs [f (FunctionalDependency Language Language f f)]
fundeps [f (Declaration Language Language f f)]
members)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Cxt -> Name -> [TyVarBndrVis] -> [FunDep] -> [Dec] -> Dec
ClassD (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (FunctionalDependency Language Language f f -> FunDep
forall l (f :: * -> *).
FunctionalDependency Language l f f -> FunDep
fundepTemplate (FunctionalDependency Language Language f f -> FunDep)
-> (f (FunctionalDependency Language Language f f)
    -> FunctionalDependency Language Language f f)
-> f (FunctionalDependency Language Language f f)
-> FunDep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FunctionalDependency Language Language f f)
-> FunctionalDependency Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (FunctionalDependency Language Language f f) -> FunDep)
-> [f (FunctionalDependency Language Language f f)] -> [FunDep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (FunctionalDependency Language Language f f)]
[f (FunctionalDependency Language Language f f)]
fundeps)
             ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
members)]
declarationTemplates (DataDeclaration f (Context Language Language f f)
context f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (DataConstructor Language Language f f)]
constructors [f (DerivingClause Language Language f f)]
derivings)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Cxt
-> Name
-> [TyVarBndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars
            (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind) (DataConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate (DataConstructor Language Language f f -> Con)
-> (f (DataConstructor Language Language f f)
    -> DataConstructor Language Language f f)
-> f (DataConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DataConstructor Language Language f f) -> Con)
-> [f (DataConstructor Language Language f f)] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DataConstructor Language Language f f)]
[f (DataConstructor Language Language f f)]
constructors)
            ([DerivClause] -> Dec) -> [DerivClause] -> Dec
forall a b. (a -> b) -> a -> b
$ [DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings]
declarationTemplates (GADTDeclaration f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (GADTConstructor Language Language f f)]
constructors [f (DerivingClause Language Language f f)]
derivings)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Cxt
-> Name
-> [TyVarBndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD [] (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
            (GADTConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructor Language Language f f -> Con)
-> (f (GADTConstructor Language Language f f)
    -> GADTConstructor Language Language f f)
-> f (GADTConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (GADTConstructor Language Language f f)
-> GADTConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (GADTConstructor Language Language f f) -> Con)
-> [f (GADTConstructor Language Language f f)] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (GADTConstructor Language Language f f)]
[f (GADTConstructor Language Language f f)]
constructors)
            ([DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings)]
#if MIN_VERSION_template_haskell(2,20,0)
declarationTemplates (TypeDataDeclaration () f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (DataConstructor Language Language f f)]
constructors)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Name -> [TyVarBndrVis] -> Maybe Type -> [Con] -> Dec
TypeDataD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars
            (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind) (DataConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate (DataConstructor Language Language f f -> Con)
-> (f (DataConstructor Language Language f f)
    -> DataConstructor Language Language f f)
-> f (DataConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DataConstructor Language Language f f) -> Con)
-> [f (DataConstructor Language Language f f)] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DataConstructor Language Language f f)]
[f (DataConstructor Language Language f f)]
constructors)]
declarationTemplates (TypeGADTDeclaration () () f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (GADTConstructor Language Language f f)]
constructors)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Name -> [TyVarBndrVis] -> Maybe Type -> [Con] -> Dec
TypeDataD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
            (GADTConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructor Language Language f f -> Con)
-> (f (GADTConstructor Language Language f f)
    -> GADTConstructor Language Language f f)
-> f (GADTConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (GADTConstructor Language Language f f)
-> GADTConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (GADTConstructor Language Language f f) -> Con)
-> [f (GADTConstructor Language Language f f)] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (GADTConstructor Language Language f f)]
[f (GADTConstructor Language Language f f)]
constructors)]
#endif
declarationTemplates (DefaultDeclaration [f (Type Language Language f f)]
types) =
#if MIN_VERSION_template_haskell(2,19,0)
   [Cxt -> Dec
DefaultD (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
types)]
#else
   error "Template Haskell <2.19 can't represent a default declaration"
#endif
declarationTemplates (NamedDefaultDeclaration () QualifiedName Language
name [f (Type Language Language f f)]
types) =
#if MIN_VERSION_template_haskell(2,19,0)
   [Cxt -> Dec
DefaultD (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
types)]
#else
   error "Template Haskell <2.19 can't represent a default declaration"
#endif
declarationTemplates (EquationDeclaration f (EquationLHS Language Language f f)
lhs f (EquationRHS Language Language f f)
rhs [f (Declaration Language Language f f)]
wheres) = case f (EquationLHS Language Language f f)
-> EquationLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (EquationLHS Language Language f f)
f (EquationLHS Language Language f f)
lhs of
   VariableLHS Name Language
name -> [Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP (Name -> Pat) -> Name -> Pat
forall a b. (a -> b) -> a -> b
$ Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) Body
rhs' [Dec]
declarations]
   PatternLHS f (Pattern Language Language f f)
pat -> [Pat -> Body -> [Dec] -> Dec
ValD (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat) Body
rhs' [Dec]
declarations]
   InfixLHS f (Pattern Language Language f f)
left Name Language
name f (Pattern Language Language f f)
right ->
      [Name -> [Clause] -> Dec
FunD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)
            [[Pat] -> Body -> [Dec] -> Clause
Clause [Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
left, Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
right] Body
rhs' [Dec]
declarations]]
   PrefixLHS f (EquationLHS Language Language f f)
lhs' NonEmpty (f (Pattern Language Language f f))
pats -> case Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (f (EquationLHS Language Language f f)
-> f (EquationRHS Language Language f f)
-> [f (Declaration Language Language f f)]
-> Declaration Language Language f f
forall λ l (d :: * -> *) (s :: * -> *).
s (EquationLHS l l d d)
-> s (EquationRHS l l d d)
-> [s (Declaration l l d d)]
-> Declaration λ l d s
EquationDeclaration f (EquationLHS Language Language f f)
lhs' f (EquationRHS Language Language f f)
rhs [f (Declaration Language Language f f)]
wheres) of
      [FunD Name
name [Clause [Pat]
args Body
body [Dec]
decs]] ->
         [Name -> [Clause] -> Dec
FunD Name
name [[Pat] -> Body -> [Dec] -> Clause
Clause ([Pat]
args [Pat] -> [Pat] -> [Pat]
forall a. [a] -> [a] -> [a]
++ (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Pattern Language Language f f))
-> [f (Pattern Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Pattern Language Language f f))
NonEmpty (f (Pattern Language Language f f))
pats)) Body
body [Dec]
decs]]
      [ValD (VarP Name
name) Body
body [Dec]
decs] ->
         [Name -> [Clause] -> Dec
FunD Name
name [[Pat] -> Body -> [Dec] -> Clause
Clause (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Pattern Language Language f f))
-> [f (Pattern Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Pattern Language Language f f))
NonEmpty (f (Pattern Language Language f f))
pats) Body
body [Dec]
decs]]
      [Dec]
ds -> String -> [Dec]
forall a. HasCallStack => String -> a
error (String
"An equation declaration should translate to a FunD or ValD, not " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Dec] -> String
forall a. Show a => a -> String
show [Dec]
ds)
   where rhs' :: Body
rhs' = EquationRHS Language Language f f -> Body
forall (f :: * -> *).
TemplateWrapper f =>
EquationRHS Language Language f f -> Body
rhsTemplate (f (EquationRHS Language Language f f)
-> EquationRHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (EquationRHS Language Language f f)
f (EquationRHS Language Language f f)
rhs)
         declarations :: [Dec]
declarations = (f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
wheres
declarationTemplates (FixityDeclaration Associativity Language
fixity Maybe Int
precedence NonEmpty (Name Language)
names) =
   Name -> Dec
infixD (Name -> Dec) -> (Name Language -> Name) -> Name Language -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Dec) -> [Name Language] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names
#if MIN_VERSION_template_haskell(2,22,0)
   where infixD :: Name -> Dec
infixD = Fixity -> NamespaceSpecifier -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
9 Maybe Int
precedence) (Associativity Language -> FixityDirection
forall l. Associativity l -> FixityDirection
fixityTemplate Associativity Language
fixity)) NamespaceSpecifier
NoNamespaceSpecifier
declarationTemplates (ExplicitTypeFixityDeclaration () Associativity Language
fixity Maybe Int
precedence NonEmpty (Name Language)
names) =
   Fixity -> NamespaceSpecifier -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
9 Maybe Int
precedence) (Associativity Language -> FixityDirection
forall l. Associativity l -> FixityDirection
fixityTemplate Associativity Language
fixity)) NamespaceSpecifier
TypeNamespaceSpecifier (Name -> Dec) -> (Name Language -> Name) -> Name Language -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Language -> Name
forall l. Name l -> Name
nameTemplate
   (Name Language -> Dec) -> [Name Language] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names
declarationTemplates (ExplicitDataFixityDeclaration () Associativity Language
fixity Maybe Int
precedence NonEmpty (Name Language)
names) =
   Fixity -> NamespaceSpecifier -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
9 Maybe Int
precedence) (Associativity Language -> FixityDirection
forall l. Associativity l -> FixityDirection
fixityTemplate Associativity Language
fixity)) NamespaceSpecifier
DataNamespaceSpecifier (Name -> Dec) -> (Name Language -> Name) -> Name Language -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Language -> Name
forall l. Name l -> Name
nameTemplate
   (Name Language -> Dec) -> [Name Language] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names
#else
   where infixD = InfixD (Fixity (fromMaybe 9 precedence) (fixityTemplate fixity))
#endif
declarationTemplates (ForeignExport CallingConvention Language
convention Maybe Text
identification Name Language
name f (Type Language Language f f)
t) =
   [Foreign -> Dec
ForeignD (Callconv -> String -> Name -> Type -> Foreign
ExportF (CallingConvention Language -> Callconv
forall l.
ExtendedWith '[ 'CApiFFI] l =>
CallingConvention l -> Callconv
conventionTemplate CallingConvention Language
convention) ((Text -> String) -> Maybe Text -> String
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> String
unpack Maybe Text
identification) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)
                      (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t))]
declarationTemplates (ForeignImport CallingConvention Language
convention Maybe (CallSafety Language)
safety Maybe Text
identification Name Language
name f (Type Language Language f f)
t) =
   [Foreign -> Dec
ForeignD (Callconv -> Safety -> String -> Name -> Type -> Foreign
ImportF (CallingConvention Language -> Callconv
forall l.
ExtendedWith '[ 'CApiFFI] l =>
CallingConvention l -> Callconv
conventionTemplate CallingConvention Language
convention) (Safety
-> (CallSafety Language -> Safety)
-> Maybe (CallSafety Language)
-> Safety
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Safety
Safe CallSafety Language -> Safety
forall {λ}.
(If (Elem 'InterruptibleFFI (ExtensionsSupportedBy λ)) () Void
 ~ ()) =>
CallSafety λ -> Safety
safetyTemplate Maybe (CallSafety Language)
safety) ((Text -> String) -> Maybe Text -> String
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> String
unpack Maybe Text
identification)
                      (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t))]
   where safetyTemplate :: CallSafety λ -> Safety
safetyTemplate CallSafety λ
SafeCall = Safety
Safe
         safetyTemplate CallSafety λ
UnsafeCall = Safety
Unsafe
         safetyTemplate (InterruptibleCall ()) = Safety
Interruptible
declarationTemplates (ImplicitParameterDeclaration SupportFor 'ImplicitParameters Language
_ Name Language
name f (Expression Language Language f f)
value) =
   [String -> Exp -> Dec
ImplicitParamBindD (Name Language -> String
forall λ. Name λ -> String
nameString Name Language
Name Language
name) (Expression Language Language f f -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
Expression Language Language f f -> Exp
expressionTemplate (Expression Language Language f f -> Exp)
-> Expression Language Language f f -> Exp
forall a b. (a -> b) -> a -> b
$ f (Expression Language Language f f)
-> Expression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Expression Language Language f f)
f (Expression Language Language f f)
value)]
declarationTemplates (InstanceDeclaration [TypeVarBinding Language Language f f]
_vars f (Context Language Language f f)
context f (ClassInstanceLHS Language Language f f)
lhs [f (Declaration Language Language f f)]
wheres) =
     [Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)
                ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
wheres)]
declarationTemplates (NewtypeDeclaration f (Context Language Language f f)
context f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind f (DataConstructor Language Language f f)
constructor [f (DerivingClause Language Language f f)]
derivings)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Cxt
-> Name
-> [TyVarBndrVis]
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeD (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars
               (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind) (DataConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate (DataConstructor Language Language f f -> Con)
-> (f (DataConstructor Language Language f f)
    -> DataConstructor Language Language f f)
-> f (DataConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DataConstructor Language Language f f) -> Con)
-> f (DataConstructor Language Language f f) -> Con
forall a b. (a -> b) -> a -> b
$ f (DataConstructor Language Language f f)
constructor)
               ([DerivClause] -> Dec) -> [DerivClause] -> Dec
forall a b. (a -> b) -> a -> b
$ [DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings]
declarationTemplates (GADTNewtypeDeclaration f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind f (GADTConstructor Language Language f f)
constructor [f (DerivingClause Language Language f f)]
derivings)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs =
     [Cxt
-> Name
-> [TyVarBndrVis]
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeD [] (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
            (GADTConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructor Language Language f f -> Con)
-> (f (GADTConstructor Language Language f f)
    -> GADTConstructor Language Language f f)
-> f (GADTConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (GADTConstructor Language Language f f)
-> GADTConstructor Language Language f f
f (GADTConstructor Language Language f f)
-> GADTConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (GADTConstructor Language Language f f) -> Con)
-> f (GADTConstructor Language Language f f) -> Con
forall a b. (a -> b) -> a -> b
$ f (GADTConstructor Language Language f f)
constructor)
            ([DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings)]
declarationTemplates (TypeSynonymDeclaration f (TypeLHS Language Language f f)
lhs f (Type Language Language f f)
t)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs = [Name -> [TyVarBndrVis] -> Type -> Dec
TySynD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)]
declarationTemplates (TypeSignature NonEmpty (Name Language)
names f (Context Language Language f f)
context f (Type Language Language f f)
t) =
   [Name -> Type -> Dec
SigD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name) (f (Context Language Language f f) -> Type -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Context Language Language f f) -> Type -> Type
inContext f (Context Language Language f f)
f (Context Language Language f f)
context (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t) | Name Language
name <- NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names]
declarationTemplates (KindSignature Name Language
name f (Kind Language Language f f)
k) = [Name -> Type -> Dec
KiSigD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
k)]
declarationTemplates (DefaultMethodSignature () Name Language
name f (Context Language Language f f)
context f (Type Language Language f f)
t) =
   [Name -> Type -> Dec
DefaultSigD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name) (f (Context Language Language f f) -> Type -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Context Language Language f f) -> Type -> Type
inContext f (Context Language Language f f)
f (Context Language Language f f)
context (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)]

declarationTemplates (DataFamilyDeclaration f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs
   = [Name -> [TyVarBndrVis] -> Maybe Type -> Dec
DataFamilyD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)]
declarationTemplates (OpenTypeFamilyDeclaration f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs
   = [TypeFamilyHead -> Dec
OpenTypeFamilyD (TypeFamilyHead -> Dec) -> TypeFamilyHead -> Dec
forall a b. (a -> b) -> a -> b
$ Name
-> [TyVarBndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Maybe (f (Type Language Language f f)) -> FamilyResultSig
forall (f :: * -> *).
TemplateWrapper f =>
Maybe (f (Type Language Language f f)) -> FamilyResultSig
familyKindTemplate Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind) Maybe InjectivityAnn
forall a. Maybe a
Nothing]
declarationTemplates (ClosedTypeFamilyDeclaration f (TypeLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (Declaration Language Language f f)]
constructors)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs
   = [TypeFamilyHead -> [TySynEqn] -> Dec
ClosedTypeFamilyD (Name
-> [TyVarBndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (Maybe (f (Type Language Language f f)) -> FamilyResultSig
forall (f :: * -> *).
TemplateWrapper f =>
Maybe (f (Type Language Language f f)) -> FamilyResultSig
familyKindTemplate Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind) Maybe InjectivityAnn
forall a. Maybe a
Nothing)
                        (Declaration Language Language f f -> TySynEqn
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> TySynEqn
typeFamilyInstanceTemplate (Declaration Language Language f f -> TySynEqn)
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> TySynEqn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Declaration Language Language f f) -> TySynEqn)
-> [f (Declaration Language Language f f)] -> [TySynEqn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
constructors)]
declarationTemplates (InjectiveOpenTypeFamilyDeclaration f (TypeLHS Language Language f f)
lhs TypeVarBinding Language Language f f
binding Maybe (Name Language, NonEmpty (Name Language))
injectivity)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs
   = [TypeFamilyHead -> Dec
OpenTypeFamilyD (Name
-> [TyVarBndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (TyVarBndr () -> FamilyResultSig
TyVarSig (TyVarBndr () -> FamilyResultSig)
-> TyVarBndr () -> FamilyResultSig
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate TypeVarBinding Language Language f f
binding)
                                      ((Name -> [Name] -> InjectivityAnn)
-> (Name, [Name]) -> InjectivityAnn
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> [Name] -> InjectivityAnn
InjectivityAnn ((Name, [Name]) -> InjectivityAnn)
-> ((Name Language, NonEmpty (Name Language)) -> (Name, [Name]))
-> (Name Language, NonEmpty (Name Language))
-> InjectivityAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Language -> Name)
-> (NonEmpty (Name Language) -> [Name])
-> (Name Language, NonEmpty (Name Language))
-> (Name, [Name])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Name Language -> Name
forall l. Name l -> Name
nameTemplate ((Name Language -> Name) -> [Name Language] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name Language -> Name
forall l. Name l -> Name
nameTemplate ([Name Language] -> [Name])
-> (NonEmpty (Name Language) -> [Name Language])
-> NonEmpty (Name Language)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
                                       ((Name Language, NonEmpty (Name Language)) -> InjectivityAnn)
-> Maybe (Name Language, NonEmpty (Name Language))
-> Maybe InjectivityAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Name Language, NonEmpty (Name Language))
Maybe (Name Language, NonEmpty (Name Language))
injectivity))]
declarationTemplates (InjectiveClosedTypeFamilyDeclaration f (TypeLHS Language Language f f)
lhs TypeVarBinding Language Language f f
binding Maybe (Name Language, NonEmpty (Name Language))
injectivity [f (Declaration Language Language f f)]
constructors)
   | (Name Language
con, [TyVarBndrVis]
vars) <- f (TypeLHS Language Language f f)
-> (Name Language, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS Language Language f f)
f (TypeLHS Language Language f f)
lhs
   = [TypeFamilyHead -> [TySynEqn] -> Dec
ClosedTypeFamilyD (Name
-> [TyVarBndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
con) [TyVarBndrVis]
vars (TyVarBndr () -> FamilyResultSig
TyVarSig (TyVarBndr () -> FamilyResultSig)
-> TyVarBndr () -> FamilyResultSig
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate TypeVarBinding Language Language f f
binding)
                                        ((Name -> [Name] -> InjectivityAnn)
-> (Name, [Name]) -> InjectivityAnn
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> [Name] -> InjectivityAnn
InjectivityAnn ((Name, [Name]) -> InjectivityAnn)
-> ((Name Language, NonEmpty (Name Language)) -> (Name, [Name]))
-> (Name Language, NonEmpty (Name Language))
-> InjectivityAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Language -> Name)
-> (NonEmpty (Name Language) -> [Name])
-> (Name Language, NonEmpty (Name Language))
-> (Name, [Name])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Name Language -> Name
forall l. Name l -> Name
nameTemplate ((Name Language -> Name) -> [Name Language] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name Language -> Name
forall l. Name l -> Name
nameTemplate ([Name Language] -> [Name])
-> (NonEmpty (Name Language) -> [Name Language])
-> NonEmpty (Name Language)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
                                         ((Name Language, NonEmpty (Name Language)) -> InjectivityAnn)
-> Maybe (Name Language, NonEmpty (Name Language))
-> Maybe InjectivityAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Name Language, NonEmpty (Name Language))
Maybe (Name Language, NonEmpty (Name Language))
injectivity))
                        (Declaration Language Language f f -> TySynEqn
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> TySynEqn
typeFamilyInstanceTemplate (Declaration Language Language f f -> TySynEqn)
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> TySynEqn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Declaration Language Language f f) -> TySynEqn)
-> [f (Declaration Language Language f f)] -> [TySynEqn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
constructors)]
declarationTemplates (DataFamilyInstance [TypeVarBinding Language Language f f]
vars f (Context Language Language f f)
context f (ClassInstanceLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (DataConstructor Language Language f f)]
constructors [f (DerivingClause Language Language f f)]
derivings) =
   [Cxt
-> Maybe [TyVarBndr ()]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context)
              (if [TypeVarBinding Language Language f f] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVarBinding Language Language f f]
vars then Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing else [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a. a -> Maybe a
Just ([TyVarBndr ()] -> Maybe [TyVarBndr ()])
-> [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (TypeVarBinding Language Language f f -> TyVarBndr ())
-> [TypeVarBinding Language Language f f] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
              (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)
              (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
              (DataConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate (DataConstructor Language Language f f -> Con)
-> (f (DataConstructor Language Language f f)
    -> DataConstructor Language Language f f)
-> f (DataConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DataConstructor Language Language f f) -> Con)
-> [f (DataConstructor Language Language f f)] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DataConstructor Language Language f f)]
[f (DataConstructor Language Language f f)]
constructors)
              ([DerivClause] -> Dec) -> [DerivClause] -> Dec
forall a b. (a -> b) -> a -> b
$ [DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings]
declarationTemplates (NewtypeFamilyInstance [TypeVarBinding Language Language f f]
vars f (Context Language Language f f)
context f (ClassInstanceLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind f (DataConstructor Language Language f f)
constructor [f (DerivingClause Language Language f f)]
derivings) =
   [Cxt
-> Maybe [TyVarBndr ()]
-> Type
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeInstD (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context)
                 (if [TypeVarBinding Language Language f f] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVarBinding Language Language f f]
vars then Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing else [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a. a -> Maybe a
Just ([TyVarBndr ()] -> Maybe [TyVarBndr ()])
-> [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (TypeVarBinding Language Language f f -> TyVarBndr ())
-> [TypeVarBinding Language Language f f] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
                 (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)
                 (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
                 (DataConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate (DataConstructor Language Language f f -> Con)
-> DataConstructor Language Language f f -> Con
forall a b. (a -> b) -> a -> b
$ f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (DataConstructor Language Language f f)
f (DataConstructor Language Language f f)
constructor)
                 ([DerivClause] -> Dec) -> [DerivClause] -> Dec
forall a b. (a -> b) -> a -> b
$ [DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings]
declarationTemplates (GADTDataFamilyInstance [TypeVarBinding Language Language f f]
vars f (ClassInstanceLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind [f (GADTConstructor Language Language f f)]
constructors [f (DerivingClause Language Language f f)]
derivings) =
   [Cxt
-> Maybe [TyVarBndr ()]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD []
              (if [TypeVarBinding Language Language f f] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVarBinding Language Language f f]
vars then Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing else [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a. a -> Maybe a
Just ([TyVarBndr ()] -> Maybe [TyVarBndr ()])
-> [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (TypeVarBinding Language Language f f -> TyVarBndr ())
-> [TypeVarBinding Language Language f f] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
              (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)
              (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
              (GADTConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructor Language Language f f -> Con)
-> (f (GADTConstructor Language Language f f)
    -> GADTConstructor Language Language f f)
-> f (GADTConstructor Language Language f f)
-> Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (GADTConstructor Language Language f f)
-> GADTConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (GADTConstructor Language Language f f) -> Con)
-> [f (GADTConstructor Language Language f f)] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (GADTConstructor Language Language f f)]
[f (GADTConstructor Language Language f f)]
constructors)
              ([DerivClause] -> Dec) -> [DerivClause] -> Dec
forall a b. (a -> b) -> a -> b
$ [DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings]
declarationTemplates (GADTNewtypeFamilyInstance [TypeVarBinding Language Language f f]
vars f (ClassInstanceLHS Language Language f f)
lhs Maybe (f (Kind Language Language f f))
kind f (GADTConstructor Language Language f f)
constructor [f (DerivingClause Language Language f f)]
derivings) =
   [Cxt
-> Maybe [TyVarBndr ()]
-> Type
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeInstD []
                 (if [TypeVarBinding Language Language f f] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVarBinding Language Language f f]
vars then Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing else [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a. a -> Maybe a
Just ([TyVarBndr ()] -> Maybe [TyVarBndr ()])
-> [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (TypeVarBinding Language Language f f -> TyVarBndr ())
-> [TypeVarBinding Language Language f f] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
                 (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)
                 (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> Maybe (f (Type Language Language f f)) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f (Kind Language Language f f))
Maybe (f (Type Language Language f f))
kind)
                 (GADTConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructor Language Language f f -> Con)
-> GADTConstructor Language Language f f -> Con
forall a b. (a -> b) -> a -> b
$ f (GADTConstructor Language Language f f)
-> GADTConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (GADTConstructor Language Language f f)
f (GADTConstructor Language Language f f)
constructor)
                 ([DerivClause] -> Dec) -> [DerivClause] -> Dec
forall a b. (a -> b) -> a -> b
$ [DerivingClause Language Language f f] -> [DerivClause]
forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate ([DerivingClause Language Language f f] -> [DerivClause])
-> [DerivingClause Language Language f f] -> [DerivClause]
forall a b. (a -> b) -> a -> b
$ f (DerivingClause Language Language f f)
-> DerivingClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (DerivingClause Language Language f f)
 -> DerivingClause Language Language f f)
-> [f (DerivingClause Language Language f f)]
-> [DerivingClause Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (DerivingClause Language Language f f)]
[f (DerivingClause Language Language f f)]
derivings]
declarationTemplates d :: Declaration Language Language f f
d@TypeFamilyInstance{} = [TySynEqn -> Dec
TySynInstD (TySynEqn -> Dec) -> TySynEqn -> Dec
forall a b. (a -> b) -> a -> b
$ Declaration Language Language f f -> TySynEqn
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> TySynEqn
typeFamilyInstanceTemplate Declaration Language Language f f
d]
declarationTemplates (TypeRoleDeclaration QualifiedName Language
name [TypeRole Language]
roles) =
   [Name -> [Role] -> Dec
RoleAnnotD (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name) (TypeRole Language -> Role
forall {λ}. TypeRole λ -> Role
roleTemplate (TypeRole Language -> Role) -> [TypeRole Language] -> [Role]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeRole Language]
[TypeRole Language]
roles)]
   where roleTemplate :: TypeRole λ -> Role
roleTemplate TypeRole λ
NominalRole = Role
NominalR
         roleTemplate TypeRole λ
RepresentationalRole = Role
RepresentationalR
         roleTemplate TypeRole λ
PhantomRole = Role
PhantomR
         roleTemplate TypeRole λ
InferredRole = Role
InferR
declarationTemplates (StandaloneDerivingDeclaration () [TypeVarBinding Language Language f f]
_vars f (Context Language Language f f)
context f (ClassInstanceLHS Language Language f f)
lhs) =
   [Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD Maybe DerivStrategy
forall a. Maybe a
Nothing (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)]
declarationTemplates (StandaloneStrategicDerivingDeclaration () () f (DerivingStrategy Language Language f f)
strategy [TypeVarBinding Language Language f f]
_vars f (Context Language Language f f)
context f (ClassInstanceLHS Language Language f f)
lhs) =
   [Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD (DerivingStrategy Language Language f f -> Maybe DerivStrategy
forall (f :: * -> *).
TemplateWrapper f =>
DerivingStrategy Language Language f f -> Maybe DerivStrategy
strategyTemplate (DerivingStrategy Language Language f f -> Maybe DerivStrategy)
-> DerivingStrategy Language Language f f -> Maybe DerivStrategy
forall a b. (a -> b) -> a -> b
$ f (DerivingStrategy Language Language f f)
-> DerivingStrategy Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (DerivingStrategy Language Language f f)
f (DerivingStrategy Language Language f f)
strategy) (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context)
                     (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)]

declarationTemplates (ImplicitPatternSynonym () f (PatternLHS Language Language f f)
lhs f (Pattern Language Language f f)
rhs) =
   [Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
PatSynD Name
name PatSynArgs
args PatSynDir
TH.ImplBidir (Pat -> Dec) -> Pat -> Dec
forall a b. (a -> b) -> a -> b
$ Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
rhs]
   where (Name
name, PatSynArgs
args) = PatternLHS Language Language f f -> (Name, PatSynArgs)
forall (f :: * -> *).
PatternLHS Language Language f f -> (Name, PatSynArgs)
lhsPatternTemplate (f (PatternLHS Language Language f f)
-> PatternLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (PatternLHS Language Language f f)
f (PatternLHS Language Language f f)
lhs)
declarationTemplates (UnidirectionalPatternSynonym () f (PatternLHS Language Language f f)
lhs f (Pattern Language Language f f)
rhs) =
   [Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
PatSynD Name
name PatSynArgs
args PatSynDir
TH.Unidir (Pat -> Dec) -> Pat -> Dec
forall a b. (a -> b) -> a -> b
$ Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
rhs]
   where (Name
name, PatSynArgs
args) = PatternLHS Language Language f f -> (Name, PatSynArgs)
forall (f :: * -> *).
PatternLHS Language Language f f -> (Name, PatSynArgs)
lhsPatternTemplate (f (PatternLHS Language Language f f)
-> PatternLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (PatternLHS Language Language f f)
f (PatternLHS Language Language f f)
lhs)
declarationTemplates (ExplicitPatternSynonym () f (PatternLHS Language Language f f)
lhs f (Pattern Language Language f f)
rhs [f (PatternEquationClause Language Language f f)]
clauses) =
   [Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
PatSynD Name
name PatSynArgs
args ([Clause] -> PatSynDir
TH.ExplBidir ([Clause] -> PatSynDir) -> [Clause] -> PatSynDir
forall a b. (a -> b) -> a -> b
$ PatternEquationClause Language Language f f -> Clause
forall {λ} {f :: * -> *} {f :: * -> *}.
(If (Elem 'PatternSynonyms (ExtensionsSupportedBy λ)) () Void ~ (),
 TemplateWrapper f, TemplateWrapper f) =>
PatternEquationClause λ Language f f -> Clause
clauseTemplate (PatternEquationClause Language Language f f -> Clause)
-> (f (PatternEquationClause Language Language f f)
    -> PatternEquationClause Language Language f f)
-> f (PatternEquationClause Language Language f f)
-> Clause
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (PatternEquationClause Language Language f f)
-> PatternEquationClause Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (PatternEquationClause Language Language f f) -> Clause)
-> [f (PatternEquationClause Language Language f f)] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (PatternEquationClause Language Language f f)]
[f (PatternEquationClause Language Language f f)]
clauses) (Pat -> Dec) -> Pat -> Dec
forall a b. (a -> b) -> a -> b
$ Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
rhs]
   where (Name
name, PatSynArgs
args) = PatternLHS Language Language f f -> (Name, PatSynArgs)
forall (f :: * -> *).
PatternLHS Language Language f f -> (Name, PatSynArgs)
lhsPatternTemplate (f (PatternLHS Language Language f f)
-> PatternLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (PatternLHS Language Language f f)
f (PatternLHS Language Language f f)
lhs)
         clauseTemplate :: PatternEquationClause λ Language f f -> Clause
clauseTemplate (PatternEquationClause () f (PatternEquationLHS Language Language f f)
lhs f (EquationRHS Language Language f f)
rhs [f (Declaration Language Language f f)]
wheres) =
            [Pat] -> Body -> [Dec] -> Clause
TH.Clause (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
patterns) (EquationRHS Language Language f f -> Body
forall (f :: * -> *).
TemplateWrapper f =>
EquationRHS Language Language f f -> Body
rhsTemplate (EquationRHS Language Language f f -> Body)
-> EquationRHS Language Language f f -> Body
forall a b. (a -> b) -> a -> b
$ f (EquationRHS Language Language f f)
-> EquationRHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (EquationRHS Language Language f f)
f (EquationRHS Language Language f f)
rhs)
                      ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
wheres)
            where patterns :: [f (Pattern Language Language f f)]
patterns = case f (PatternEquationLHS Language Language f f)
-> PatternEquationLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (PatternEquationLHS Language Language f f)
f (PatternEquationLHS Language Language f f)
lhs
                             of PrefixPatternEquationLHS Name Language
_ [f (Pattern Language Language f f)]
pats -> [f (Pattern Language Language f f)]
pats
                                InfixPatternEquationLHS f (Pattern Language Language f f)
l Name Language
_ f (Pattern Language Language f f)
r -> [f (Pattern Language Language f f)
l, f (Pattern Language Language f f)
r]
declarationTemplates (PatternSynonymSignature () NonEmpty (Name Language)
names [TypeVarBinding Language Language f f]
vars1 f (Context Language Language f f)
ctx1 [TypeVarBinding Language Language f f]
vars2 f (Context Language Language f f)
ctx2 [f (Type Language Language f f)]
args f (Type Language Language f f)
result) =
   [Name -> Type -> Dec
PatSynSigD (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name) (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$
    [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT (TypeVarBinding Language Language f f -> TyVarBndr Specificity
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr Specificity
typeVarBindingSpecTemplate (TypeVarBinding Language Language f f -> TyVarBndr Specificity)
-> [TypeVarBinding Language Language f f]
-> [TyVarBndr Specificity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars1) (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
ctx1) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
    [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT (TypeVarBinding Language Language f f -> TyVarBndr Specificity
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr Specificity
typeVarBindingSpecTemplate (TypeVarBinding Language Language f f -> TyVarBndr Specificity)
-> [TypeVarBinding Language Language f f]
-> [TyVarBndr Specificity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars2) (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
ctx2) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
    (f (Type Language Language f f) -> Type -> Type)
-> Type -> [f (Type Language Language f f)] -> 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 -> Type -> Type
TH.AppT (Type -> Type -> Type)
-> (f (Type Language Language f f) -> Type)
-> f (Type Language Language f f)
-> Type
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Type
TH.AppT Type
TH.ArrowT (Type -> Type)
-> (f (Type Language Language f f) -> Type)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
result) [f (Type Language Language f f)]
[f (Type Language Language f f)]
args
   | Name Language
name <- NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names]

fixityTemplate :: Associativity l -> TH.FixityDirection
fixityTemplate :: forall l. Associativity l -> FixityDirection
fixityTemplate Associativity l
NonAssociative = FixityDirection
InfixN
fixityTemplate Associativity l
LeftAssociative = FixityDirection
InfixL
fixityTemplate Associativity l
RightAssociative = FixityDirection
InfixR

lhsPatternTemplate :: ExtAST.PatternLHS Language Language f f -> (TH.Name, TH.PatSynArgs)
lhsPatternTemplate :: forall (f :: * -> *).
PatternLHS Language Language f f -> (Name, PatSynArgs)
lhsPatternTemplate (PrefixPatternLHS Name Language
name [Name Language]
args) = (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name, [Name] -> PatSynArgs
TH.PrefixPatSyn ([Name] -> PatSynArgs) -> [Name] -> PatSynArgs
forall a b. (a -> b) -> a -> b
$ Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Name) -> [Name Language] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name Language]
args)
lhsPatternTemplate (InfixPatternLHS Name Language
l Name Language
name Name Language
r) = (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name, Name -> Name -> PatSynArgs
TH.InfixPatSyn (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
l) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
r))
lhsPatternTemplate (RecordPatternLHS Name Language
name [Name Language]
args) = (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name, [Name] -> PatSynArgs
TH.RecordPatSyn ([Name] -> PatSynArgs) -> [Name] -> PatSynArgs
forall a b. (a -> b) -> a -> b
$ Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Name) -> [Name Language] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name Language]
args)

lhsTypeTemplate :: TemplateWrapper f => ExtAST.ClassInstanceLHS Language Language f f -> TH.Type
lhsTypeTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (TypeClassInstanceLHS QualifiedName Language
name f (Type Language Language f f)
t) = Type -> Type -> Type
AppT (Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
lhsTypeTemplate (ClassReferenceInstanceLHS QualifiedName Language
name) = Name -> Type
ConT (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)
lhsTypeTemplate (ClassInstanceLHSApplication f (ClassInstanceLHS Language Language f f)
left f (Type Language Language f f)
right) =
  Type -> Type -> Type
AppT (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
left) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right)
lhsTypeTemplate (ClassInstanceLHSKindApplication f (ClassInstanceLHS Language Language f f)
left f (Kind Language Language f f)
right) =
  Type -> Type -> Type
AppKindT (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
left) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
right)
lhsTypeTemplate (InfixTypeClassInstanceLHS f (Type Language Language f f)
left QualifiedName Language
name f (Type Language Language f f)
right) =
  Type -> Name -> Type -> Type
InfixT (f (Type Language Language f f) -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate f (Type Language Language f f)
f (Type Language Language f f)
left) (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name) (f (Type Language Language f f) -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate f (Type Language Language f f)
f (Type Language Language f f)
right)

familyKindTemplate :: TemplateWrapper f => Maybe (f (ExtAST.Type Language Language f f)) -> FamilyResultSig
familyKindTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Maybe (f (Type Language Language f f)) -> FamilyResultSig
familyKindTemplate = FamilyResultSig
-> (f (Type Language Language f f) -> FamilyResultSig)
-> Maybe (f (Type Language Language f f))
-> FamilyResultSig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FamilyResultSig
NoSig (Type -> FamilyResultSig
KindSig (Type -> FamilyResultSig)
-> (f (Type Language Language f f) -> Type)
-> f (Type Language Language f f)
-> FamilyResultSig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract)

typeFamilyInstanceTemplate :: TemplateWrapper f => Declaration Language Language f f -> TySynEqn
typeFamilyInstanceTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> TySynEqn
typeFamilyInstanceTemplate (TypeFamilyInstance [TypeVarBinding Language Language f f]
vars f (ClassInstanceLHS Language Language f f)
lhs f (Type Language Language f f)
rhs) =
   Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
TySynEqn (if [TypeVarBinding Language Language f f] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVarBinding Language Language f f]
vars then Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing else [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a. a -> Maybe a
Just ([TyVarBndr ()] -> Maybe [TyVarBndr ()])
-> [TyVarBndr ()] -> Maybe [TyVarBndr ()]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (TypeVarBinding Language Language f f -> TyVarBndr ())
-> [TypeVarBinding Language Language f f] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
            (ClassInstanceLHS Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
ClassInstanceLHS Language Language f f -> Type
lhsTypeTemplate (ClassInstanceLHS Language Language f f -> Type)
-> ClassInstanceLHS Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (ClassInstanceLHS Language Language f f)
-> ClassInstanceLHS Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (ClassInstanceLHS Language Language f f)
f (ClassInstanceLHS Language Language f f)
lhs)
            (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
rhs)
typeFamilyInstanceTemplate Declaration Language Language f f
d = String -> TySynEqn
forall a. HasCallStack => String -> a
error (String
"Expected a type family instance, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Declaration Language Language f (Const ()) -> String
forall a. Show a => a -> String
show (Const () a -> f a -> Const () a
forall a b. a -> b -> a
const (() -> Const () a
forall {k} a (b :: k). a -> Const a b
Const ()) (forall {a}. f a -> Const () a)
-> Declaration Language Language f f
-> Declaration Language Language f (Const ())
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a)
-> Declaration Language Language f p
-> Declaration Language Language f q
Rank2.<$> Declaration Language Language f f
d))

fundepTemplate :: FunctionalDependency Language l f f -> FunDep
fundepTemplate :: forall l (f :: * -> *).
FunctionalDependency Language l f f -> FunDep
fundepTemplate (FunctionalDependency [Name Language]
from [Name Language]
to) = [Name] -> [Name] -> FunDep
FunDep (Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Name) -> [Name Language] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name Language]
[Name Language]
from) (Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Name) -> [Name Language] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name Language]
[Name Language]
to)

derivingsTemplate :: TemplateWrapper f => [DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
[DerivingClause Language Language f f] -> [DerivClause]
derivingsTemplate = (DerivingClause Language Language f f
 -> [DerivClause] -> [DerivClause])
-> [DerivClause]
-> [DerivingClause Language Language f f]
-> [DerivClause]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DerivingClause Language Language f f
-> [DerivClause] -> [DerivClause]
forall {f :: * -> *}.
TemplateWrapper f =>
DerivingClause Language Language f f
-> [DerivClause] -> [DerivClause]
derived []
   where derived :: DerivingClause Language Language f f
-> [DerivClause] -> [DerivClause]
derived (SimpleDerive QualifiedName Language
name) (DerivClause Maybe DerivStrategy
Nothing Cxt
ctx : [DerivClause]
rest) =
            Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing (Name -> Type
ConT (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name) Type -> Cxt -> Cxt
forall a. a -> [a] -> [a]
: Cxt
ctx) DerivClause -> [DerivClause] -> [DerivClause]
forall a. a -> [a] -> [a]
: [DerivClause]
rest
         derived (SimpleDerive QualifiedName Language
name) [DerivClause]
templates = Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name] DerivClause -> [DerivClause] -> [DerivClause]
forall a. a -> [a] -> [a]
: [DerivClause]
templates
         derived (StrategicDerive () f (DerivingStrategy Language Language f f)
strategy [f (Type Language Language f f)]
types) [DerivClause]
templates =
            Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause (DerivingStrategy Language Language f f -> Maybe DerivStrategy
forall (f :: * -> *).
TemplateWrapper f =>
DerivingStrategy Language Language f f -> Maybe DerivStrategy
strategyTemplate (DerivingStrategy Language Language f f -> Maybe DerivStrategy)
-> DerivingStrategy Language Language f f -> Maybe DerivStrategy
forall a b. (a -> b) -> a -> b
$ f (DerivingStrategy Language Language f f)
-> DerivingStrategy Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (DerivingStrategy Language Language f f)
f (DerivingStrategy Language Language f f)
strategy) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
types) DerivClause -> [DerivClause] -> [DerivClause]
forall a. a -> [a] -> [a]
: [DerivClause]
templates
         derived (DeriveVia () [f (Type Language Language f f)]
types f (Type Language Language f f)
viaType) [DerivClause]
templates =
            Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause (DerivingStrategy Language Language f f -> Maybe DerivStrategy
forall (f :: * -> *).
TemplateWrapper f =>
DerivingStrategy Language Language f f -> Maybe DerivStrategy
strategyTemplate (DerivingStrategy Language Language f f -> Maybe DerivStrategy)
-> DerivingStrategy Language Language f f -> Maybe DerivStrategy
forall a b. (a -> b) -> a -> b
$ SupportFor 'DerivingVia Language
-> f (Type Language Language f f)
-> DerivingStrategy Language Language f f
forall λ l (d :: * -> *) (s :: * -> *).
SupportFor 'DerivingVia λ
-> s (Type l l d d) -> DerivingStrategy λ l d s
Via () f (Type Language Language f f)
viaType) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
types) DerivClause -> [DerivClause] -> [DerivClause]
forall a. a -> [a] -> [a]
: [DerivClause]
templates

strategyTemplate :: TemplateWrapper f => DerivingStrategy Language Language f f -> Maybe DerivStrategy
strategyTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
DerivingStrategy Language Language f f -> Maybe DerivStrategy
strategyTemplate DerivingStrategy Language Language f f
Default = Maybe DerivStrategy
forall a. Maybe a
Nothing
strategyTemplate DerivingStrategy Language Language f f
Stock = DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy
strategyTemplate DerivingStrategy Language Language f f
Newtype = DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
NewtypeStrategy
strategyTemplate DerivingStrategy Language Language f f
AnyClass = DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
AnyclassStrategy
strategyTemplate (Via () f (Type Language Language f f)
ty) = DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just (DerivStrategy -> Maybe DerivStrategy)
-> DerivStrategy -> Maybe DerivStrategy
forall a b. (a -> b) -> a -> b
$ Type -> DerivStrategy
ViaStrategy (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
ty)

contextTemplate :: TemplateWrapper f => ExtAST.Context Language Language f f -> Cxt
contextTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (ClassConstraint QualifiedName Language
cls f (Type Language Language f f)
t) = [Type -> Type -> Type
AppT (Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
cls) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)]
contextTemplate (ImplicitParameterConstraint SupportFor 'ImplicitParameters Language
_ Name Language
name f (Type Language Language f f)
t) = [String -> Type -> Type
ImplicitParamT (Name Language -> String
forall λ. Name λ -> String
nameString Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)]
contextTemplate (TypeConstraint f (Type Language Language f f)
t) = case f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t of
   ConstructorType f (Constructor Language Language f f)
c | Constructor Language Language f f
UnitConstructor <- f (Constructor Language Language f f)
-> Constructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Constructor Language Language f f)
f (Constructor Language Language f f)
c -> []
   TupleType NonEmpty (f (Type Language Language f f))
ts -> f (Type Language Language f f) -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Type Language Language f f))
-> [f (Type Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
ts
   Type Language Language f f
_ -> [f (Type Language Language f f) -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate f (Type Language Language f f)
f (Type Language Language f f)
t]
contextTemplate (TypeEquality f (Type Language Language f f)
t1 f (Type Language Language f f)
t2) = [Type
EqualityT Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t1) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t2)]
contextTemplate (Constraints [f (Context Language Language f f)]
cs) = (f (Context Language Language f f) -> Cxt)
-> [f (Context Language Language f f)] -> Cxt
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> (f (Context Language Language f f)
    -> Context Language Language f f)
-> f (Context Language Language f f)
-> Cxt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Context Language Language f f)]
[f (Context Language Language f f)]
cs
contextTemplate Context Language Language f f
NoContext = []

freeContextVars :: TemplateWrapper f => ExtAST.Context Language Language f f -> [TH.Name]
freeContextVars :: forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> [Name]
freeContextVars (ClassConstraint QualifiedName Language
_cls f (Type Language Language f f)
t) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
freeContextVars (Constraints [f (Context Language Language f f)]
cs) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (Context Language Language f f) -> [Name])
-> [f (Context Language Language f f)] -> [Name]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Context Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> [Name]
freeContextVars (Context Language Language f f -> [Name])
-> (f (Context Language Language f f)
    -> Context Language Language f f)
-> f (Context Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Context Language Language f f)]
[f (Context Language Language f f)]
cs)
freeContextVars (ImplicitParameterConstraint SupportFor 'ImplicitParameters Language
_ Name Language
_ f (Type Language Language f f)
t) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
freeContextVars (TypeConstraint f (Type Language Language f f)
t) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
freeContextVars (TypeEquality f (Type Language Language f f)
left f (Type Language Language f f)
right) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right))
freeContextVars Context Language Language f f
NoContext = []

conventionTemplate :: Abstract.ExtendedWith '[ 'Extensions.CApiFFI ] l => CallingConvention l -> Callconv
conventionTemplate :: forall l.
ExtendedWith '[ 'CApiFFI] l =>
CallingConvention l -> Callconv
conventionTemplate CallingConvention l
ExtAST.CCall = Callconv
TH.CCall
conventionTemplate CallingConvention l
ExtAST.StdCall = Callconv
TH.StdCall
conventionTemplate (ExtAST.CApiCall ()) = Callconv
TH.CApi
conventionTemplate CallingConvention l
convention = String -> Callconv
forall a. HasCallStack => String -> a
error (String
"Calling Convention " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CallingConvention l -> String
forall a. Show a => a -> String
show CallingConvention l
convention String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not supported by GHC")

dataConstructorTemplate :: TemplateWrapper f => DataConstructor Language Language f f -> Con
dataConstructorTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate (Constructor name :: Name Language
name@(AST.Name Text
local) [f (Type Language Language f f)
left, f (Type Language Language f f)
right]) | Text
":" Text -> Text -> Bool
`Text.isPrefixOf` Text
local =
   BangType -> Name -> BangType -> Con
InfixC (Type Language Language f f -> BangType
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> BangType
bangTypeTemplate (Type Language Language f f -> BangType)
-> Type Language Language f f -> BangType
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> BangType
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> BangType
bangTypeTemplate (Type Language Language f f -> BangType)
-> Type Language Language f f -> BangType
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right)
dataConstructorTemplate (Constructor Name Language
name [f (Type Language Language f f)]
argTypes) =
   Name -> [BangType] -> Con
NormalC (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> BangType
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> BangType
bangTypeTemplate (Type Language Language f f -> BangType)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> BangType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> BangType)
-> [f (Type Language Language f f)] -> [BangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
argTypes)
dataConstructorTemplate (RecordConstructor Name Language
recName [f (FieldDeclaration Language Language f f)]
fieldTypes) =
   Name -> [VarBangType] -> Con
RecC (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
recName) ((f (FieldDeclaration Language Language f f) -> [VarBangType])
-> [f (FieldDeclaration Language Language f f)] -> [VarBangType]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (FieldDeclaration Language Language f f -> [VarBangType]
forall (f :: * -> *).
TemplateWrapper f =>
FieldDeclaration Language Language f f -> [VarBangType]
fieldTypeTemplate (FieldDeclaration Language Language f f -> [VarBangType])
-> (f (FieldDeclaration Language Language f f)
    -> FieldDeclaration Language Language f f)
-> f (FieldDeclaration Language Language f f)
-> [VarBangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FieldDeclaration Language Language f f)
-> FieldDeclaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (FieldDeclaration Language Language f f)]
[f (FieldDeclaration Language Language f f)]
fieldTypes)
dataConstructorTemplate (ExistentialConstructor [TypeVarBinding Language Language f f]
vars f (Context Language Language f f)
context f (DataConstructor Language Language f f)
con) =
  [TyVarBndr Specificity] -> Cxt -> Con -> Con
ForallC ([TyVarBndr Specificity] -> [TyVarBndr Specificity]
forall a. Eq a => [a] -> [a]
nub ([TyVarBndr Specificity] -> [TyVarBndr Specificity])
-> [TyVarBndr Specificity] -> [TyVarBndr Specificity]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr Specificity
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr Specificity
typeVarBindingSpecTemplate (TypeVarBinding Language Language f f -> TyVarBndr Specificity)
-> [TypeVarBinding Language Language f f]
-> [TyVarBndr Specificity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
          (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context)
          (DataConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> Con
dataConstructorTemplate DataConstructor Language Language f f
con')
  where con' :: DataConstructor Language Language f f
con' = f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (DataConstructor Language Language f f)
f (DataConstructor Language Language f f)
con

gadtConstructorTemplate :: TemplateWrapper f => GADTConstructor Language Language f f -> Con
gadtConstructorTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructors NonEmpty (Name Language)
names [TypeVarBinding Language Language f f]
vars f (Context Language Language f f)
context f (Type Language Language f f)
t)
   | [TypeVarBinding Language Language f f] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVarBinding Language Language f f]
vars, Context Language Language f f
NoContext <- f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context = case f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t of
      FunctionType f (Type Language Language f f)
arg f (Type Language Language f f)
result -> ([Type Language Language f f] -> [Type Language Language f f])
-> Type Language Language f f -> Con
normalTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
arg Type Language Language f f
-> [Type Language Language f f] -> [Type Language Language f f]
forall a. a -> [a] -> [a]
:) (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
result)
      RecordFunctionType [f (FieldDeclaration Language Language f f)]
fields f (Type Language Language f f)
result -> [FieldDeclaration Language Language f f]
-> Type Language Language f f -> Con
recordTemplate (f (FieldDeclaration Language Language f f)
-> FieldDeclaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (FieldDeclaration Language Language f f)
 -> FieldDeclaration Language Language f f)
-> [f (FieldDeclaration Language Language f f)]
-> [FieldDeclaration Language Language f f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (FieldDeclaration Language Language f f)]
[f (FieldDeclaration Language Language f f)]
fields) (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
result)
      Type Language Language f f
result -> ([Type Language Language f f] -> [Type Language Language f f])
-> Type Language Language f f -> Con
normalTemplate [Type Language Language f f] -> [Type Language Language f f]
forall a. a -> a
id Type Language Language f f
result
   | Bool
otherwise = [TyVarBndr Specificity] -> Cxt -> Con -> Con
ForallC ([TyVarBndr Specificity] -> [TyVarBndr Specificity]
forall a. Eq a => [a] -> [a]
nub ([TyVarBndr Specificity] -> [TyVarBndr Specificity])
-> [TyVarBndr Specificity] -> [TyVarBndr Specificity]
forall a b. (a -> b) -> a -> b
$ TypeVarBinding Language Language f f -> TyVarBndr Specificity
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr Specificity
typeVarBindingSpecTemplate (TypeVarBinding Language Language f f -> TyVarBndr Specificity)
-> [TypeVarBinding Language Language f f]
-> [TyVarBndr Specificity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
                         (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context)
                         (GADTConstructor Language Language f f -> Con
forall (f :: * -> *).
TemplateWrapper f =>
GADTConstructor Language Language f f -> Con
gadtConstructorTemplate (GADTConstructor Language Language f f -> Con)
-> GADTConstructor Language Language f f -> Con
forall a b. (a -> b) -> a -> b
$ NonEmpty (Name Language)
-> [TypeVarBinding Language Language f f]
-> f (Context Language Language f f)
-> f (Type Language Language f f)
-> GADTConstructor Language Language f f
forall λ l (d :: * -> *) (s :: * -> *).
NonEmpty (Name λ)
-> [TypeVarBinding λ l d s]
-> s (Context l l d d)
-> s (Type l l d d)
-> GADTConstructor λ l d s
GADTConstructors NonEmpty (Name Language)
names [] (Context Language Language f f
forall λ l (d :: * -> *) (s :: * -> *). Context λ l d s
NoContext Context Language Language f f
-> f (Context Language Language f f)
-> f (Context Language Language f f)
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f (Context Language Language f f)
f (Context Language Language f f)
context) f (Type Language Language f f)
t)
   where normalTemplate :: ([Type Language Language f f] -> [Type Language Language f f])
-> Type Language Language f f -> Con
normalTemplate [Type Language Language f f] -> [Type Language Language f f]
args (FunctionType f (Type Language Language f f)
arg f (Type Language Language f f)
result) = ([Type Language Language f f] -> [Type Language Language f f])
-> Type Language Language f f -> Con
normalTemplate ([Type Language Language f f] -> [Type Language Language f f]
args ([Type Language Language f f] -> [Type Language Language f f])
-> ([Type Language Language f f] -> [Type Language Language f f])
-> [Type Language Language f f]
-> [Type Language Language f f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
arg Type Language Language f f
-> [Type Language Language f f] -> [Type Language Language f f]
forall a. a -> [a] -> [a]
:)) (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
result)
         normalTemplate [Type Language Language f f] -> [Type Language Language f f]
args Type Language Language f f
result =
            [Name] -> [BangType] -> Type -> Con
GadtC (Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Name) -> [Name Language] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names) (Type Language Language f f -> BangType
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> BangType
bangTypeTemplate (Type Language Language f f -> BangType)
-> [Type Language Language f f] -> [BangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type Language Language f f] -> [Type Language Language f f]
args []) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate Type Language Language f f
result)
         recordTemplate :: [FieldDeclaration Language Language f f]
-> Type Language Language f f -> Con
recordTemplate [FieldDeclaration Language Language f f]
fields Type Language Language f f
result =
            [Name] -> [VarBangType] -> Type -> Con
RecGadtC (Name Language -> Name
forall l. Name l -> Name
nameTemplate (Name Language -> Name) -> [Name Language] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names) ((FieldDeclaration Language Language f f -> [VarBangType])
-> [FieldDeclaration Language Language f f] -> [VarBangType]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FieldDeclaration Language Language f f -> [VarBangType]
forall (f :: * -> *).
TemplateWrapper f =>
FieldDeclaration Language Language f f -> [VarBangType]
fieldTypeTemplate [FieldDeclaration Language Language f f]
fields) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate Type Language Language f f
result)

fieldTypeTemplate :: TemplateWrapper f => FieldDeclaration Language Language f f -> [VarBangType]
fieldTypeTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
FieldDeclaration Language Language f f -> [VarBangType]
fieldTypeTemplate (ConstructorFields NonEmpty (Name Language)
names f (Type Language Language f f)
t)
   | LazyType{} <- f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t = SourceStrictness
-> f (Type Language Language f f) -> Name Language -> VarBangType
forall {f :: * -> *} {f :: * -> *} {l}.
(TemplateWrapper f, TemplateWrapper f) =>
SourceStrictness
-> f (Type Language Language f f) -> Name l -> VarBangType
varBang SourceStrictness
SourceLazy f (Type Language Language f f)
f (Type Language Language f f)
t (Name Language -> VarBangType) -> [Name Language] -> [VarBangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names
   | StrictType{} <- f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t = SourceStrictness
-> f (Type Language Language f f) -> Name Language -> VarBangType
forall {f :: * -> *} {f :: * -> *} {l}.
(TemplateWrapper f, TemplateWrapper f) =>
SourceStrictness
-> f (Type Language Language f f) -> Name l -> VarBangType
varBang SourceStrictness
SourceStrict f (Type Language Language f f)
f (Type Language Language f f)
t (Name Language -> VarBangType) -> [Name Language] -> [VarBangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names
   | Bool
otherwise = SourceStrictness
-> f (Type Language Language f f) -> Name Language -> VarBangType
forall {f :: * -> *} {f :: * -> *} {l}.
(TemplateWrapper f, TemplateWrapper f) =>
SourceStrictness
-> f (Type Language Language f f) -> Name l -> VarBangType
varBang SourceStrictness
NoSourceStrictness f (Type Language Language f f)
f (Type Language Language f f)
t (Name Language -> VarBangType) -> [Name Language] -> [VarBangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
NonEmpty (Name Language)
names
   where varBang :: SourceStrictness
-> f (Type Language Language f f) -> Name l -> VarBangType
varBang SourceStrictness
strictness f (Type Language Language f f)
t Name l
name = (Name l -> Name
forall l. Name l -> Name
nameTemplate Name l
name, SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
strictness, Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
t)

freeConstructorVars :: TemplateWrapper f => DataConstructor Language Language f f -> [TyVarBndrSpec]
freeConstructorVars :: forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> [TyVarBndr Specificity]
freeConstructorVars (Constructor Name Language
_ [f (Type Language Language f f)]
argTypes) = (f (Type Language Language f f) -> [TyVarBndr Specificity])
-> [f (Type Language Language f f)] -> [TyVarBndr Specificity]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [TyVarBndr Specificity]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [TyVarBndr Specificity]
freeTypeVarBindings (Type Language Language f f -> [TyVarBndr Specificity])
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> [TyVarBndr Specificity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Type Language Language f f)]
[f (Type Language Language f f)]
argTypes
freeConstructorVars (RecordConstructor Name Language
_ [f (FieldDeclaration Language Language f f)]
fieldTypes) = (f (FieldDeclaration Language Language f f)
 -> [TyVarBndr Specificity])
-> [f (FieldDeclaration Language Language f f)]
-> [TyVarBndr Specificity]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [TyVarBndr Specificity]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [TyVarBndr Specificity]
freeTypeVarBindings (Type Language Language f f -> [TyVarBndr Specificity])
-> (f (FieldDeclaration Language Language f f)
    -> Type Language Language f f)
-> f (FieldDeclaration Language Language f f)
-> [TyVarBndr Specificity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDeclaration Language Language f f
-> Type Language Language f f
FieldDeclaration Language Language f f
-> Type Language Language f f
forall {f :: * -> *} {λ} {l} {d :: * -> *}.
TemplateWrapper f =>
FieldDeclaration λ l d f -> Type l l d d
fieldsType (FieldDeclaration Language Language f f
 -> Type Language Language f f)
-> (f (FieldDeclaration Language Language f f)
    -> FieldDeclaration Language Language f f)
-> f (FieldDeclaration Language Language f f)
-> Type Language Language f f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FieldDeclaration Language Language f f)
-> FieldDeclaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (FieldDeclaration Language Language f f)]
[f (FieldDeclaration Language Language f f)]
fieldTypes
   where fieldsType :: FieldDeclaration λ l d f -> Type l l d d
fieldsType (ConstructorFields NonEmpty (Name λ)
_ f (Type l l d d)
t) = f (Type l l d d) -> Type l l d d
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type l l d d)
t
freeConstructorVars (ExistentialConstructor [TypeVarBinding Language Language f f]
_ f (Context Language Language f f)
_ f (DataConstructor Language Language f f)
con) = DataConstructor Language Language f f -> [TyVarBndr Specificity]
forall (f :: * -> *).
TemplateWrapper f =>
DataConstructor Language Language f f -> [TyVarBndr Specificity]
freeConstructorVars (f (DataConstructor Language Language f f)
-> DataConstructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (DataConstructor Language Language f f)
f (DataConstructor Language Language f f)
con)

fieldBindingTemplate :: TemplateWrapper f => FieldBinding Language Language f f -> FieldExp
fieldBindingTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
FieldBinding Language Language f f -> FieldExp
fieldBindingTemplate (FieldBinding QualifiedName Language
name f (Expression Language Language f f)
value) = (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name, f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
value)
fieldBindingTemplate (PunnedFieldBinding QualifiedName Language
name) = (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name, Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)

literalTemplate :: TemplateWrapper f => Value Language Language f f -> Lit
literalTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Value Language Language f f -> Lit
literalTemplate (CharLiteral Char
c) = Char -> Lit
CharL Char
c
literalTemplate (FloatingLiteral Rational
x) = Rational -> Lit
RationalL Rational
x
literalTemplate (IntegerLiteral Integer
n) = Integer -> Lit
IntegerL Integer
n
literalTemplate (StringLiteral Text
s) = String -> Lit
StringL (Text -> String
unpack Text
s)
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ (CharLiteral Char
c)) = Char -> Lit
CharPrimL Char
c
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ (FloatingLiteral Rational
x)) = Rational -> Lit
FloatPrimL Rational
x
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ (HashLiteral SupportFor 'MagicHash Language
_ (FloatingLiteral Rational
x))) = Rational -> Lit
DoublePrimL Rational
x
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ (IntegerLiteral Integer
n)) = Integer -> Lit
IntPrimL Integer
n
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ (HashLiteral SupportFor 'MagicHash Language
_ (IntegerLiteral Integer
n))) = Integer -> Lit
WordPrimL Integer
n
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ (StringLiteral Text
s))
  | (Char -> Bool) -> Text -> Bool
Text.all ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord) Text
s = [Word8] -> Lit
StringPrimL (ByteString -> [Word8]
ByteString.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
s)
literalTemplate (HashLiteral SupportFor 'MagicHash Language
_ Value Language Language f f
_) = String -> Lit
forall a. HasCallStack => String -> a
error String
"Unexpected HashLiteral"
-- TODO: TemplateHaskell doesn't support ExtendedLiterals
literalTemplate (ExtendedLiteral SupportFor 'ExtendedLiterals Language
_ Integer
n Name Language
ty) = Integer -> Lit
IntPrimL Integer
n

patternTemplate :: TemplateWrapper f => Pattern Language Language f f -> Pat
patternTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (AsPattern Name Language
name f (Pattern Language Language f f)
pat) = Name -> Pat -> Pat
AsP (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat)
patternTemplate (ConstructorPattern f (Constructor Language Language f f)
con [f (Type Language Language f f)]
typeApps [f (Pattern Language Language f f)]
args) = case (f (Constructor Language Language f f)
-> Constructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Constructor Language Language f f)
f (Constructor Language Language f f)
con) of
   ConstructorReference QualifiedName Language
name ->
#if MIN_VERSION_template_haskell(2,18,0)
      Name -> Cxt -> [Pat] -> Pat
ConP (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
typeApps) (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
args)
#else
      ConP (qnameTemplate name) (patternTemplate . extract <$> args)
#endif
   Constructor Language Language f f
EmptyListConstructor -> [Pat] -> Pat
ListP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
args)
   TupleConstructor{} -> [Pat] -> Pat
TupP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
-> [f (Pattern Language Language f f)]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
args)
   UnboxedTupleConstructor{} -> [Pat] -> Pat
UnboxedTupP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
-> [f (Pattern Language Language f f)]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
args)
   UnboxedSumConstructor{} -> String -> Pat
forall a. HasCallStack => String -> a
error String
"Unboxed sum constructor can't appear in a pattern"
   Constructor Language Language f f
UnitConstructor -> [Pat] -> Pat
TupP []
patternTemplate (InfixPattern f (Pattern Language Language f f)
left QualifiedName Language
op f (Pattern Language Language f f)
right) =
   Pat -> Name -> Pat -> Pat
InfixP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
left) (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
op) (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
right)
patternTemplate (IrrefutablePattern f (Pattern Language Language f f)
pat) = Pat -> Pat
TildeP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat)
patternTemplate (LazyPattern () f (Pattern Language Language f f)
pat) = Pat -> Pat
TildeP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat)
patternTemplate (BangPattern () f (Pattern Language Language f f)
pat) = Pat -> Pat
BangP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat)
patternTemplate (ViewPattern () f (Expression Language Language f f)
view f (Pattern Language Language f f)
pat) = Exp -> Pat -> Pat
ViewP (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
view) (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat)
patternTemplate (ListPattern [f (Pattern Language Language f f)]
items) = [Pat] -> Pat
ListP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Pattern Language Language f f)]
[f (Pattern Language Language f f)]
items)
patternTemplate (LiteralPattern f (Value Language Language f f)
value) = Lit -> Pat
LitP (Value Language Language f f -> Lit
forall (f :: * -> *).
TemplateWrapper f =>
Value Language Language f f -> Lit
literalTemplate (Value Language Language f f -> Lit)
-> Value Language Language f f -> Lit
forall a b. (a -> b) -> a -> b
$ f (Value Language Language f f) -> Value Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Value Language Language f f)
f (Value Language Language f f)
value)
patternTemplate (RecordPattern QualifiedName Language
constructor [f (FieldPattern Language Language f f)]
fields) =
   Name -> [FieldPat] -> Pat
RecP (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
constructor) (FieldPattern Language Language f f -> FieldPat
forall {f :: * -> *} {f :: * -> *}.
(TemplateWrapper f, TemplateWrapper f) =>
FieldPattern Language Language f f -> FieldPat
fieldPatternTemplate (FieldPattern Language Language f f -> FieldPat)
-> (f (FieldPattern Language Language f f)
    -> FieldPattern Language Language f f)
-> f (FieldPattern Language Language f f)
-> FieldPat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FieldPattern Language Language f f)
-> FieldPattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (FieldPattern Language Language f f) -> FieldPat)
-> [f (FieldPattern Language Language f f)] -> [FieldPat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (FieldPattern Language Language f f)]
[f (FieldPattern Language Language f f)]
fields)
   where
     fieldPatternTemplate :: FieldPattern Language Language f f -> FieldPat
fieldPatternTemplate (FieldPattern QualifiedName Language
name f (Pattern Language Language f f)
pat) = (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name, Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
pat)
     fieldPatternTemplate (PunnedFieldPattern q :: QualifiedName Language
q@(QualifiedName Maybe (ModuleName Language)
_ Name Language
name)) = (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
q, Name -> Pat
VarP (Name -> Pat) -> Name -> Pat
forall a b. (a -> b) -> a -> b
$ Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name)
patternTemplate WildcardRecordPattern{} = String -> Pat
forall a. HasCallStack => String -> a
error String
"TH doesn't support record wildcards"
patternTemplate NPlusKPattern{} = String -> Pat
forall a. HasCallStack => String -> a
error String
"TH doesn't support N+K patterns"
patternTemplate (TuplePattern NonEmpty (f (Pattern Language Language f f))
items) = [Pat] -> Pat
TupP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Pattern Language Language f f))
-> [f (Pattern Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Pattern Language Language f f))
NonEmpty (f (Pattern Language Language f f))
items)
patternTemplate (UnboxedTuplePattern () NonEmpty (f (Pattern Language Language f f))
items) = [Pat] -> Pat
UnboxedTupP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> (f (Pattern Language Language f f)
    -> Pattern Language Language f f)
-> f (Pattern Language Language f f)
-> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Pattern Language Language f f) -> Pat)
-> [f (Pattern Language Language f f)] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Pattern Language Language f f))
-> [f (Pattern Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (Pattern Language Language f f))
NonEmpty (f (Pattern Language Language f f))
items)
patternTemplate (UnboxedSumPattern () Int
before f (Pattern Language Language f f)
branch Int
after) =
   Pat -> Int -> Int -> Pat
UnboxedSumP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
branch) (Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
after Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
patternTemplate (VariablePattern Name Language
name) = Name -> Pat
VarP (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)
patternTemplate (TypedPattern f (Pattern Language Language f f)
p f (Type Language Language f f)
t) = Pat -> Type -> Pat
SigP (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
p) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
patternTemplate (ExplicitTypePattern () f (Type Language Language f f)
t) = Type -> Pat
TypeP (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
patternTemplate (InvisibleTypePattern () f (Type Language Language f f)
t) = Type -> Pat
InvisP (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
patternTemplate Pattern Language Language f f
WildcardPattern = Pat
WildP

rhsTemplate :: TemplateWrapper f => EquationRHS Language Language f f -> Body
rhsTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
EquationRHS Language Language f f -> Body
rhsTemplate (GuardedRHS NonEmpty (f (GuardedExpression Language Language f f))
guarded) = [(Guard, Exp)] -> Body
GuardedB (GuardedExpression Language Language f f -> (Guard, Exp)
forall (f :: * -> *) λ.
TemplateWrapper f =>
GuardedExpression λ Language f f -> (Guard, Exp)
guardedTemplatePair (GuardedExpression Language Language f f -> (Guard, Exp))
-> (f (GuardedExpression Language Language f f)
    -> GuardedExpression Language Language f f)
-> f (GuardedExpression Language Language f f)
-> (Guard, Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (GuardedExpression Language Language f f)
-> GuardedExpression Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (GuardedExpression Language Language f f) -> (Guard, Exp))
-> [f (GuardedExpression Language Language f f)] -> [(Guard, Exp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (GuardedExpression Language Language f f))
-> [f (GuardedExpression Language Language f f)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (f (GuardedExpression Language Language f f))
NonEmpty (f (GuardedExpression Language Language f f))
guarded)
rhsTemplate (NormalRHS f (Expression Language Language f f)
result) = Exp -> Body
NormalB (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
result)

statementTemplate :: TemplateWrapper f => Statement Language Language f f -> Stmt
statementTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (BindStatement f (Pattern Language Language f f)
left f (Expression Language Language f f)
right) =
   Pat -> Exp -> Stmt
BindS (Pattern Language Language f f -> Pat
forall (f :: * -> *).
TemplateWrapper f =>
Pattern Language Language f f -> Pat
patternTemplate (Pattern Language Language f f -> Pat)
-> Pattern Language Language f f -> Pat
forall a b. (a -> b) -> a -> b
$ f (Pattern Language Language f f) -> Pattern Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Pattern Language Language f f)
f (Pattern Language Language f f)
left) (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
right)
statementTemplate (ExpressionStatement f (Expression Language Language f f)
test) = Exp -> Stmt
NoBindS (f (Expression Language Language f f) -> Exp
forall (f :: * -> *).
TemplateWrapper f =>
f (Expression Language Language f f) -> Exp
wrappedExpressionTemplate f (Expression Language Language f f)
f (Expression Language Language f f)
test)
statementTemplate (LetStatement [f (Declaration Language Language f f)]
declarations) = [Dec] -> Stmt
LetS ((f (Declaration Language Language f f) -> [Dec])
-> [f (Declaration Language Language f f)] -> [Dec]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Declaration Language Language f f -> [Dec]
forall (f :: * -> *).
TemplateWrapper f =>
Declaration Language Language f f -> [Dec]
declarationTemplates (Declaration Language Language f f -> [Dec])
-> (f (Declaration Language Language f f)
    -> Declaration Language Language f f)
-> f (Declaration Language Language f f)
-> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Declaration Language Language f f)
-> Declaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Declaration Language Language f f)]
[f (Declaration Language Language f f)]
declarations)
statementTemplate (RecursiveStatement [f (Statement Language Language f f)]
statements) = [Stmt] -> Stmt
RecS (Statement Language Language f f -> Stmt
forall (f :: * -> *).
TemplateWrapper f =>
Statement Language Language f f -> Stmt
statementTemplate (Statement Language Language f f -> Stmt)
-> (f (Statement Language Language f f)
    -> Statement Language Language f f)
-> f (Statement Language Language f f)
-> Stmt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Statement Language Language f f)
-> Statement Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Statement Language Language f f) -> Stmt)
-> [f (Statement Language Language f f)] -> [Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Statement Language Language f f)]
[f (Statement Language Language f f)]
statements)

bangTypeTemplate :: TemplateWrapper f => ExtAST.Type Language Language f f -> (TH.Bang, TH.Type)
bangTypeTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> BangType
bangTypeTemplate (StrictType f (Type Language Language f f)
t) = (SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
SourceStrict, Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
bangTypeTemplate Type Language Language f f
t = (SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate Type Language Language f f
t)

typeTemplate :: TemplateWrapper f => ExtAST.Type Language Language f f -> TH.Type
typeTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (ConstructorType f (Constructor Language Language f f)
con) = case (f (Constructor Language Language f f)
-> Constructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Constructor Language Language f f)
f (Constructor Language Language f f)
con) of
   ConstructorReference QualifiedName Language
name -> Name -> Type
ConT (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)
   Constructor Language Language f f
EmptyListConstructor -> Type
ListT
   TupleConstructor Int
n -> Int -> Type
TupleT Int
n
   UnboxedTupleConstructor () Int
n -> Int -> Type
UnboxedTupleT Int
n
   UnboxedSumConstructor () Int
n -> Int -> Type
UnboxedSumT Int
n
   Constructor Language Language f f
UnitConstructor -> Int -> Type
TupleT Int
0
typeTemplate Type Language Language f f
FunctionConstructorType = Type
ArrowT
typeTemplate (FunctionType f (Type Language Language f f)
from f (Type Language Language f f)
to) = Type
ArrowT Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
from) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
to)
typeTemplate (RecordFunctionType [f (FieldDeclaration Language Language f f)]
fields f (Type Language Language f f)
result) = (f (FieldDeclaration Language Language f f) -> Type -> Type)
-> Type -> [f (FieldDeclaration Language Language f f)] -> Type
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FieldDeclaration Language Language f f -> Type -> Type
forall {f :: * -> *} {f :: * -> *} {λ}.
(TemplateWrapper f, TemplateWrapper f) =>
FieldDeclaration λ Language f f -> Type -> Type
fieldsArrow (FieldDeclaration Language Language f f -> Type -> Type)
-> (f (FieldDeclaration Language Language f f)
    -> FieldDeclaration Language Language f f)
-> f (FieldDeclaration Language Language f f)
-> Type
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FieldDeclaration Language Language f f)
-> FieldDeclaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
result) [f (FieldDeclaration Language Language f f)]
[f (FieldDeclaration Language Language f f)]
fields
   where fieldsArrow :: FieldDeclaration λ Language f f -> Type -> Type
fieldsArrow (ConstructorFields NonEmpty (Name λ)
names f (Type Language Language f f)
t) Type
rt = (Name λ -> Type -> Type) -> Type -> NonEmpty (Name λ) -> Type
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Name λ -> Type -> Type
forall {p}. Type -> p -> Type -> Type
fieldArrow (Type -> Name λ -> Type -> Type) -> Type -> Name λ -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t) Type
rt NonEmpty (Name λ)
names
         fieldArrow :: Type -> p -> Type -> Type
fieldArrow Type
t p
_ = (Type
ArrowT Type -> Type -> Type
`AppT` Type
t Type -> Type -> Type
`AppT`)
#if MIN_VERSION_template_haskell(2,17,0)
typeTemplate (LinearFunctionType f (Type Language Language f f)
from f (Type Language Language f f)
to) =
   Type
MulArrowT Type -> Type -> Type
`AppT` Name -> Type
PromotedT 'GHC.Types.One Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
from) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
to)
typeTemplate (MultiplicityFunctionType f (Type Language Language f f)
from f (Type Language Language f f)
mult f (Type Language Language f f)
to) =
   Type
MulArrowT Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
mult) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
from) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
to)
#endif
typeTemplate (ListType f (Type Language Language f f)
itemType) = Type -> Type -> Type
AppT Type
ListT (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
itemType)
typeTemplate (LazyType () f (Type Language Language f f)
t) = Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
typeTemplate (StrictType f (Type Language Language f f)
t) = Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
typeTemplate (TupleType NonEmpty (f (Type Language Language f f))
items) = (Type -> Type -> Type) -> Type -> NonEmpty Type -> Type
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT (Int -> Type
TupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$! NonEmpty (f (Type Language Language f f)) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> NonEmpty (f (Type Language Language f f)) -> NonEmpty Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items)
typeTemplate (UnboxedTupleType () NonEmpty (f (Type Language Language f f))
items) =
   (Type -> Type -> Type) -> Type -> NonEmpty Type -> Type
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT (Int -> Type
UnboxedTupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$! NonEmpty (f (Type Language Language f f)) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> NonEmpty (f (Type Language Language f f)) -> NonEmpty Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items)
typeTemplate (UnboxedSumType () NonEmpty (f (Type Language Language f f))
items) = (Type -> Type -> Type) -> Type -> NonEmpty Type -> Type
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT (Int -> Type
UnboxedSumT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$! NonEmpty (f (Type Language Language f f)) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> NonEmpty (f (Type Language Language f f)) -> NonEmpty Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items)
typeTemplate (TypeApplication f (Type Language Language f f)
left f (Type Language Language f f)
right) = Type -> Type -> Type
AppT (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right)
typeTemplate (InfixTypeApplication f (Type Language Language f f)
left QualifiedName Language
op f (Type Language Language f f)
right) =
   Type -> Name -> Type -> Type
InfixT (f (Type Language Language f f) -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate f (Type Language Language f f)
f (Type Language Language f f)
left) (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
op) (f (Type Language Language f f) -> Type
forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate f (Type Language Language f f)
f (Type Language Language f f)
right)
typeTemplate (TypeVariable Name Language
name) = Name -> Type
VarT (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)
typeTemplate Type Language Language f f
TypeWildcard = Type
WildCardT
typeTemplate (TypeKind f (Type Language Language f f)
t) = Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
typeTemplate (KindedType f (Type Language Language f f)
t f (Kind Language Language f f)
kind) = Type -> Type -> Type
SigT (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
typeTemplate (ForallType [TypeVarBinding Language Language f f]
vars f (Type Language Language f f)
body) =
   [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT [TyVarBndr Specificity]
varBindings [] (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate Type Language Language f f
type')
   where type' :: Type Language Language f f
type' = f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
body
         varBindings :: [TyVarBndr Specificity]
varBindings = TypeVarBinding Language Language f f -> TyVarBndr Specificity
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr Specificity
typeVarBindingSpecTemplate (TypeVarBinding Language Language f f -> TyVarBndr Specificity)
-> [TypeVarBinding Language Language f f]
-> [TyVarBndr Specificity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars
         bindingVars :: [Name]
bindingVars = TypeVarBinding Language Language f f -> Name
forall (f :: * -> *). TypeVarBinding Language Language f f -> Name
bindingVarName (TypeVarBinding Language Language f f -> Name)
-> [TypeVarBinding Language Language f f] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars
typeTemplate (ConstrainedType f (Context Language Language f f)
context f (Type Language Language f f)
body) =
   [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT [] (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (Context Language Language f f -> Cxt)
-> Context Language Language f f -> Cxt
forall a b. (a -> b) -> a -> b
$ f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
body)
typeTemplate (ConstraintType f (Context Language Language f f)
context) = case Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate (f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) of
   [Type
t] -> 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
foldl' Type -> Type -> Type
AppT (Int -> Type
TupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$! Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
ts) Cxt
ts
typeTemplate (VisibleDependentType [TypeVarBinding Language Language f f]
vars f (Type Language Language f f)
body) =
   [TyVarBndr ()] -> Type -> Type
ForallVisT ([TyVarBndr ()]
varBindings [TyVarBndr ()] -> [TyVarBndr ()] -> [TyVarBndr ()]
forall a. Semigroup a => a -> a -> a
<> (Name -> TyVarBndr ()
forall flag. DefaultBndrFlag flag => Name -> TyVarBndr flag
plainTV (Name -> TyVarBndr ()) -> [Name] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars Type Language Language f f
type') [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
bindingVars))
              (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate Type Language Language f f
type')
   where type' :: Type Language Language f f
type' = f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
body
         varBindings :: [TyVarBndr ()]
varBindings = TypeVarBinding Language Language f f -> TyVarBndr ()
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (TypeVarBinding Language Language f f -> TyVarBndr ())
-> [TypeVarBinding Language Language f f] -> [TyVarBndr ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars
         bindingVars :: [Name]
bindingVars = TypeVarBinding Language Language f f -> Name
forall (f :: * -> *). TypeVarBinding Language Language f f -> Name
bindingVarName (TypeVarBinding Language Language f f -> Name)
-> [TypeVarBinding Language Language f f] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars
typeTemplate Type Language Language f f
GroundTypeKind = Type
StarT
typeTemplate (PromotedConstructorType f (Constructor Language Language f f)
con) = case (f (Constructor Language Language f f)
-> Constructor Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Constructor Language Language f f)
f (Constructor Language Language f f)
con) of
   ConstructorReference QualifiedName Language
name -> Name -> Type
PromotedT (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
name)
   Constructor Language Language f f
EmptyListConstructor -> Type
PromotedNilT
   TupleConstructor Int
n -> Int -> Type
PromotedTupleT Int
n
   UnboxedTupleConstructor () Int
n -> Int -> Type
UnboxedTupleT Int
n
   UnboxedSumConstructor () Int
n -> Int -> Type
UnboxedSumT Int
n
   Constructor Language Language f f
UnitConstructor -> Int -> Type
PromotedTupleT Int
0
typeTemplate (PromotedTupleType [f (Type Language Language f f)]
items) =
   (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
foldl' Type -> Type -> Type
AppT (Int -> Type
PromotedTupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$! [f (Type Language Language f f)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [f (Type Language Language f f)]
[f (Type Language Language f f)]
items) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
items)
typeTemplate (PromotedListType [f (Type Language Language f f)]
items) =
   (Type -> Type -> Type) -> Type -> Cxt -> 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 -> Type -> Type
AppT (Type -> Type -> Type) -> (Type -> Type) -> Type -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Type
AppT Type
PromotedConsT) Type
PromotedNilT (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract (f (Type Language Language f f) -> Type)
-> [f (Type Language Language f f)] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Type Language Language f f)]
[f (Type Language Language f f)]
items)
typeTemplate (PromotedIntegerLiteral Integer
n) = TyLit -> Type
LitT (Integer -> TyLit
NumTyLit Integer
n)
typeTemplate (PromotedStringLiteral Text
s) = TyLit -> Type
LitT (String -> TyLit
StrTyLit (String -> TyLit) -> String -> TyLit
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
s)
#if MIN_VERSION_template_haskell(2,18,0)
typeTemplate (PromotedCharLiteral Char
c) = TyLit -> Type
LitT (Char -> TyLit
CharTyLit Char
c)
#endif
typeTemplate (PromotedInfixTypeApplication f (Type Language Language f f)
left QualifiedName Language
op f (Type Language Language f f)
right) =
   Name -> Type
PromotedT (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
QualifiedName Language
op) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) Type -> Type -> Type
`AppT` Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right)
typeTemplate (VisibleKindApplication f (Type Language Language f f)
t f (Kind Language Language f f)
k) = Type -> Type -> Type
AppKindT (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
k)

wrappedTypeTemplate :: TemplateWrapper f => f (ExtAST.Type Language Language f f) -> TH.Type
wrappedTypeTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
f (Type Language Language f f) -> Type
wrappedTypeTemplate f (Type Language Language f f)
x = (if f (Type Language Language f f) -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. TemplateWrapper f => f a -> Bool
isParenthesized f (Type Language Language f f)
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Type Language Language f f -> Bool
forall {λ} {l} {d :: * -> *} {s :: * -> *}. Type λ l d s -> Bool
isTuple Type Language Language f f
t) then Type -> Type
ParensT else Type -> Type
forall a. a -> a
id) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate Type Language Language f f
t)
   where isTuple :: Type λ l d s -> Bool
isTuple TupleType{} = Bool
True
         isTuple Type λ l d s
_ = Bool
False
         t :: Type Language Language f f
t = f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
x

freeTypeVarBindings :: TemplateWrapper f => ExtAST.Type Language Language f f -> [TyVarBndrSpec]
freeTypeVarBindings :: forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [TyVarBndr Specificity]
freeTypeVarBindings = (Name -> TyVarBndr Specificity)
-> [Name] -> [TyVarBndr Specificity]
forall a b. (a -> b) -> [a] -> [b]
map Name -> TyVarBndr Specificity
plainTVInferred ([Name] -> [TyVarBndr Specificity])
-> (Type Language Language f f -> [Name])
-> Type Language Language f f
-> [TyVarBndr Specificity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars

freeTypeVars :: TemplateWrapper f => ExtAST.Type Language Language f f -> [TH.Name]
freeTypeVars :: forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (ConstraintType f (Context Language Language f f)
c) = Context Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> [Name]
freeContextVars (f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
c)
freeTypeVars ConstructorType{} = []
freeTypeVars Type Language Language f f
FunctionConstructorType = []
freeTypeVars TypeWildcard{} = []
freeTypeVars GroundTypeKind{} = []
freeTypeVars (TypeKind f (Type Language Language f f)
t) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
freeTypeVars (FunctionType f (Type Language Language f f)
from f (Type Language Language f f)
to) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
from) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
to))
freeTypeVars (LinearFunctionType f (Type Language Language f f)
from f (Type Language Language f f)
to) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
from) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
to))
freeTypeVars (MultiplicityFunctionType f (Type Language Language f f)
from f (Type Language Language f f)
mult f (Type Language Language f f)
to) =
   [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
from) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
mult) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
to))
freeTypeVars (ListType f (Type Language Language f f)
itemType) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
itemType)
freeTypeVars (LazyType () f (Type Language Language f f)
t) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
freeTypeVars (StrictType f (Type Language Language f f)
t) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t)
freeTypeVars (TupleType NonEmpty (f (Type Language Language f f))
items) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (Type Language Language f f) -> [Name])
-> NonEmpty (f (Type Language Language f f)) -> [Name]
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items)
freeTypeVars (UnboxedTupleType () NonEmpty (f (Type Language Language f f))
items) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (Type Language Language f f) -> [Name])
-> NonEmpty (f (Type Language Language f f)) -> [Name]
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items)
freeTypeVars (UnboxedSumType () NonEmpty (f (Type Language Language f f))
items) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (Type Language Language f f) -> [Name])
-> NonEmpty (f (Type Language Language f f)) -> [Name]
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) NonEmpty (f (Type Language Language f f))
NonEmpty (f (Type Language Language f f))
items)
freeTypeVars (TypeApplication f (Type Language Language f f)
left f (Type Language Language f f)
right) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right))
freeTypeVars (VisibleKindApplication f (Type Language Language f f)
t f (Kind Language Language f f)
kind) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
freeTypeVars (InfixTypeApplication f (Type Language Language f f)
left QualifiedName Language
_op f (Type Language Language f f)
right) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right))
freeTypeVars (TypeVariable Name Language
name) = [Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name]
freeTypeVars (KindedType f (Type Language Language f f)
t f (Kind Language Language f f)
kind) = Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
t) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
freeTypeVars (ForallType [TypeVarBinding Language Language f f]
vars f (Type Language Language f f)
body) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> Type Language Language f f -> [Name]
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
body) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ (TypeVarBinding Language Language f f -> Name
forall (f :: * -> *). TypeVarBinding Language Language f f -> Name
bindingVarName (TypeVarBinding Language Language f f -> Name)
-> [TypeVarBinding Language Language f f] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
freeTypeVars (ConstrainedType f (Context Language Language f f)
context f (Type Language Language f f)
body) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Context Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> [Name]
freeContextVars (f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
f (Context Language Language f f)
context) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
body))
freeTypeVars (VisibleDependentType [TypeVarBinding Language Language f f]
vars f (Type Language Language f f)
body) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
body)) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ (TypeVarBinding Language Language f f -> Name
forall (f :: * -> *). TypeVarBinding Language Language f f -> Name
bindingVarName (TypeVarBinding Language Language f f -> Name)
-> [TypeVarBinding Language Language f f] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding Language Language f f]
vars)
freeTypeVars (RecordFunctionType [f (FieldDeclaration Language Language f f)]
fields f (Type Language Language f f)
result) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (FieldDeclaration Language Language f f) -> [Name])
-> [f (FieldDeclaration Language Language f f)] -> [Name]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> (f (FieldDeclaration Language Language f f)
    -> Type Language Language f f)
-> f (FieldDeclaration Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDeclaration Language Language f f
-> Type Language Language f f
FieldDeclaration Language Language f f
-> Type Language Language f f
forall {f :: * -> *} {λ} {l} {d :: * -> *}.
TemplateWrapper f =>
FieldDeclaration λ l d f -> Type l l d d
fieldType (FieldDeclaration Language Language f f
 -> Type Language Language f f)
-> (f (FieldDeclaration Language Language f f)
    -> FieldDeclaration Language Language f f)
-> f (FieldDeclaration Language Language f f)
-> Type Language Language f f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FieldDeclaration Language Language f f)
-> FieldDeclaration Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (FieldDeclaration Language Language f f)]
[f (FieldDeclaration Language Language f f)]
fields
                                                       [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
result))
   where fieldType :: FieldDeclaration λ l d f -> Type l l d d
fieldType (ConstructorFields NonEmpty (Name λ)
_names f (Type l l d d)
t) = f (Type l l d d) -> Type l l d d
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type l l d d)
t
freeTypeVars PromotedConstructorType{} = []
freeTypeVars (PromotedTupleType [f (Type Language Language f f)]
items) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (Type Language Language f f) -> [Name])
-> [f (Type Language Language f f)] -> [Name]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Type Language Language f f)]
[f (Type Language Language f f)]
items)
freeTypeVars (PromotedListType [f (Type Language Language f f)]
items) = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ((f (Type Language Language f f) -> [Name])
-> [f (Type Language Language f f)] -> [Name]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (Type Language Language f f -> [Name])
-> (f (Type Language Language f f) -> Type Language Language f f)
-> f (Type Language Language f f)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract) [f (Type Language Language f f)]
[f (Type Language Language f f)]
items)
freeTypeVars (PromotedInfixTypeApplication f (Type Language Language f f)
left QualifiedName Language
_op f (Type Language Language f f)
right) =
   [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
left) [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> Type Language Language f f -> [Name]
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> [Name]
freeTypeVars (f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Type Language Language f f)
f (Type Language Language f f)
right))
freeTypeVars PromotedIntegerLiteral{} = []
freeTypeVars PromotedCharLiteral{} = []
freeTypeVars PromotedStringLiteral{} = []

typeVarBindingUnitTemplate :: TemplateWrapper f => ExtAST.TypeVarBinding Language Language f f -> TyVarBndrUnit
typeVarBindingUnitTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr ()
typeVarBindingUnitTemplate (ExplicitlyKindedTypeVariable Bool
_ Name Language
name f (Kind Language Language f f)
kind) =
   Name -> Type -> TyVarBndr ()
forall flag. DefaultBndrFlag flag => Name -> Type -> TyVarBndr flag
kindedTV (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
typeVarBindingUnitTemplate (ImplicitlyKindedTypeVariable Bool
_ Name Language
name) = Name -> TyVarBndr ()
forall flag. DefaultBndrFlag flag => Name -> TyVarBndr flag
plainTV (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)

typeVarBindingVisibleTemplate :: TemplateWrapper f => ExtAST.TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingVisibleTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingVisibleTemplate (ExplicitlyKindedTypeVariable Bool
_ Name Language
name f (Kind Language Language f f)
kind) =
   Name -> Type -> TyVarBndrVis
forall flag. DefaultBndrFlag flag => Name -> Type -> TyVarBndr flag
kindedTV (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
typeVarBindingVisibleTemplate (ImplicitlyKindedTypeVariable Bool
_ Name Language
name) = Name -> TyVarBndrVis
forall flag. DefaultBndrFlag flag => Name -> TyVarBndr flag
plainTV (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)

typeVarBindingInvisibleTemplate :: TemplateWrapper f => ExtAST.TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingInvisibleTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingInvisibleTemplate (ExplicitlyKindedTypeVariable Bool
_ Name Language
name f (Kind Language Language f f)
kind) =
   Name -> Type -> TyVarBndrVis
kindedTVInvis (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
typeVarBindingInvisibleTemplate (ImplicitlyKindedTypeVariable Bool
_ Name Language
name) = Name -> TyVarBndrVis
plainTVInvis (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)

typeVarBindingSpecTemplate :: TemplateWrapper f => ExtAST.TypeVarBinding Language Language f f -> TyVarBndrSpec
typeVarBindingSpecTemplate :: forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndr Specificity
typeVarBindingSpecTemplate (ExplicitlyKindedTypeVariable Bool
False Name Language
name f (Kind Language Language f f)
kind) =
   Name -> Type -> TyVarBndr Specificity
kindedTVSpecified (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
typeVarBindingSpecTemplate (ImplicitlyKindedTypeVariable Bool
False Name Language
name) = Name -> TyVarBndr Specificity
plainTVSpecified (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)
typeVarBindingSpecTemplate (ExplicitlyKindedTypeVariable Bool
True Name Language
name f (Kind Language Language f f)
kind) =
   Name -> Type -> TyVarBndr Specificity
kindedTVInferred (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name) (Type Language Language f f -> Type
forall (f :: * -> *).
TemplateWrapper f =>
Type Language Language f f -> Type
typeTemplate (Type Language Language f f -> Type)
-> Type Language Language f f -> Type
forall a b. (a -> b) -> a -> b
$ f (Type Language Language f f) -> Type Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Kind Language Language f f)
f (Type Language Language f f)
kind)
typeVarBindingSpecTemplate (ImplicitlyKindedTypeVariable Bool
True Name Language
name) = Name -> TyVarBndr Specificity
plainTVInferred (Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name)

bindingVarName :: ExtAST.TypeVarBinding Language Language f f -> TH.Name
bindingVarName :: forall (f :: * -> *). TypeVarBinding Language Language f f -> Name
bindingVarName (ExplicitlyKindedTypeVariable Bool
_ Name Language
name f (Kind Language Language f f)
_) = Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name
bindingVarName (ImplicitlyKindedTypeVariable Bool
_ Name Language
name) = Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
Name Language
name

inContext :: TemplateWrapper f => f (ExtAST.Context Language Language f f) -> TH.Type -> TH.Type
inContext :: forall (f :: * -> *).
TemplateWrapper f =>
f (Context Language Language f f) -> Type -> Type
inContext f (Context Language Language f f)
context = case f (Context Language Language f f) -> Context Language Language f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract f (Context Language Language f f)
context
                     of Context Language Language f f
NoContext -> Type -> Type
forall a. a -> a
id
                        Context Language Language f f
ctx -> [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT [] (Context Language Language f f -> Cxt
forall (f :: * -> *).
TemplateWrapper f =>
Context Language Language f f -> Cxt
contextTemplate Context Language Language f f
ctx)

nameReferenceTemplate :: AST.QualifiedName Language -> Exp
nameReferenceTemplate :: QualifiedName Language -> Exp
nameReferenceTemplate name :: QualifiedName Language
name@(QualifiedName Maybe (ModuleName Language)
_ (AST.Name Text
local))
   | Bool -> Bool
not (Text -> Bool
Text.null Text
local), Char
c <- HasCallStack => Text -> Char
Text -> Char
Text.head Text
local, Char -> Bool
Char.isUpper Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' = Name -> Exp
ConE (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
name)
   | Bool
otherwise = Name -> Exp
VarE (QualifiedName Language -> Name
qnameTemplate QualifiedName Language
name)

moduleNameTemplate :: AST.ModuleName l -> ModName
moduleNameTemplate :: forall l. ModuleName l -> ModName
moduleNameTemplate (ModuleName NonEmpty (Name l)
ns) = String -> ModName
mkModName (String -> ModName) -> String -> ModName
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Name l -> Text) -> [Name l] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Text
forall λ. Name λ -> Text
getName ([Name l] -> [Text]) -> [Name l] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Name l) -> [Name l]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name l)
ns

nameTemplate :: AST.Name l -> TH.Name
nameTemplate :: forall l. Name l -> Name
nameTemplate (Name Text
s) = String -> Name
mkName (Text -> String
unpack Text
s)

qnameTemplate :: AST.QualifiedName Language -> TH.Name
qnameTemplate :: QualifiedName Language -> Name
qnameTemplate (QualifiedName Maybe (ModuleName Language)
Nothing Name Language
name) = Name Language -> Name
forall l. Name l -> Name
nameTemplate Name Language
name
qnameTemplate (QualifiedName (Just (ModuleName NonEmpty (Name Language)
m)) Name Language
name) = String -> Name
mkName (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"."
                                                                   ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name Language -> Text
forall λ. Name λ -> Text
nameText (Name Language -> Text) -> [Name Language] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name Language) -> [Name Language]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name Language)
m [Name Language] -> [Name Language] -> [Name Language]
forall a. [a] -> [a] -> [a]
++ [Name Language
name])

baseName :: AST.QualifiedName Language -> AST.Name Language
baseName :: QualifiedName Language -> Name Language
baseName (QualifiedName Maybe (ModuleName Language)
_ Name Language
name) = Name Language
name

extractSimpleTypeLHS :: forall l f. (Abstract.Name l ~ AST.Name l, Abstract.TypeLHS l ~ ExtAST.TypeLHS l,
                                     Abstract.Type l ~ ExtAST.Type l, l ~ Language, TemplateWrapper f)
               => f (ExtAST.TypeLHS l l f f) -> (AST.Name l, [TyVarBndrVis])
extractSimpleTypeLHS :: forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS = TypeLHS l l f f -> (Name l, [TyVarBndrVis])
fromTypeLHS (TypeLHS l l f f -> (Name l, [TyVarBndrVis]))
-> (f (TypeLHS l l f f) -> TypeLHS l l f f)
-> f (TypeLHS l l f f)
-> (Name l, [TyVarBndrVis])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (TypeLHS l l f f) -> TypeLHS l l f f
forall a. f a -> a
forall (f :: * -> *) a. TemplateWrapper f => f a -> a
extract
   where fromTypeLHS :: ExtAST.TypeLHS l l f f -> (AST.Name l, [TyVarBndrVis])
         fromTypeLHS :: TypeLHS l l f f -> (Name l, [TyVarBndrVis])
fromTypeLHS (SimpleTypeLHS Name l
con [TypeVarBinding l l f f]
vars) = (Name l
Name l
con, TypeVarBinding Language Language f f -> TyVarBndrVis
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingVisibleTemplate (TypeVarBinding Language Language f f -> TyVarBndrVis)
-> [TypeVarBinding Language Language f f] -> [TyVarBndrVis]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding l l f f]
[TypeVarBinding Language Language f f]
vars)
         fromTypeLHS (TypeLHSApplication f (TypeLHS l l f f)
t TypeVarBinding l l f f
var)
            | (Name l
con, [TyVarBndrVis]
vars) <- f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS l l f f)
f (TypeLHS l l f f)
t = (Name l
con, [TyVarBndrVis]
vars [TyVarBndrVis] -> [TyVarBndrVis] -> [TyVarBndrVis]
forall a. [a] -> [a] -> [a]
++ [TypeVarBinding Language Language f f -> TyVarBndrVis
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingVisibleTemplate TypeVarBinding l l f f
TypeVarBinding Language Language f f
var])
         fromTypeLHS (TypeLHSTypeApplication () f (TypeLHS l l f f)
t TypeVarBinding l l f f
var)
            | (Name l
con, [TyVarBndrVis]
vars) <- f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
forall l (f :: * -> *).
(Name l ~ Name l, TypeLHS l ~ TypeLHS l, Type l ~ Type l,
 l ~ Language, TemplateWrapper f) =>
f (TypeLHS l l f f) -> (Name l, [TyVarBndrVis])
extractSimpleTypeLHS f (TypeLHS l l f f)
f (TypeLHS l l f f)
t = (Name l
con, [TyVarBndrVis]
vars [TyVarBndrVis] -> [TyVarBndrVis] -> [TyVarBndrVis]
forall a. [a] -> [a] -> [a]
++ [TypeVarBinding Language Language f f -> TyVarBndrVis
forall (f :: * -> *).
TemplateWrapper f =>
TypeVarBinding Language Language f f -> TyVarBndrVis
typeVarBindingInvisibleTemplate TypeVarBinding l l f f
TypeVarBinding Language Language f f
var])

nameText :: AST.Name λ -> Text
nameText :: forall λ. Name λ -> Text
nameText (Name Text
s) = Text
s

nameString :: AST.Name λ -> String
nameString :: forall λ. Name λ -> String
nameString = Text -> String
Text.unpack (Text -> String) -> (Name λ -> Text) -> Name λ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name λ -> Text
forall λ. Name λ -> Text
nameText