{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Language.Haskell.Meta.Syntax.Translate (
module Language.Haskell.Meta.Syntax.Translate
) where
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Language.Haskell.Exts.SrcLoc as Exts.SrcLoc
import qualified Language.Haskell.Exts.Syntax as Exts
import qualified Language.Haskell.TH.Lib as TH
import qualified Language.Haskell.TH.Syntax as TH
#if MIN_VERSION_template_haskell(2,17,0)
type TyVarBndr_ flag = TH.TyVarBndr flag
#else
type TyVarBndr_ flag = TH.TyVarBndr
#endif
class ToName a where toName :: a -> TH.Name
class ToNames a where toNames :: a -> [TH.Name]
class ToLit a where toLit :: a -> TH.Lit
class ToType a where toType :: a -> TH.Type
class ToPat a where toPat :: a -> TH.Pat
class ToExp a where toExp :: a -> TH.Exp
class ToDecs a where toDecs :: a -> [TH.Dec]
class ToDec a where toDec :: a -> TH.Dec
class ToStmt a where toStmt :: a -> TH.Stmt
class ToLoc a where toLoc :: a -> TH.Loc
class ToCxt a where toCxt :: a -> TH.Cxt
class ToPred a where toPred :: a -> TH.Pred
class ToTyVars a where toTyVars :: a -> [TyVarBndr_ ()]
class ToMaybeKind a where toMaybeKind :: a -> Maybe TH.Kind
#if MIN_VERSION_template_haskell(2,11,0)
class ToInjectivityAnn a where toInjectivityAnn :: a -> TH.InjectivityAnn
#endif
#if MIN_VERSION_template_haskell(2,12,0)
type DerivClause = TH.DerivClause
#elif MIN_VERSION_template_haskell(2,11,0)
type DerivClause = TH.Pred
#else
type DerivClause = TH.Name
#endif
class ToDerivClauses a where toDerivClauses :: a -> [DerivClause]
moduleName :: String
moduleName :: String
moduleName = String
"Language.Haskell.Meta.Syntax.Translate"
noTH :: (Functor f, Show (f ())) => String -> f e -> a
noTH :: String -> f e -> a
noTH String
fun f e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun,
String
": template-haskell has no representation for: ", f () -> String
forall a. Show a => a -> String
show ((e -> ()) -> f e -> f ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> e -> ()
forall a b. a -> b -> a
const ()) f e
thing)]
noTHyet :: (Functor f, Show (f ())) => String -> String -> f e -> a
noTHyet :: String -> String -> f e -> a
noTHyet String
fun String
minVersion f e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun,
String
": template-haskell-", VERSION_template_haskell, " (< ", minVersion, ")",
String
" has no representation for: ", f () -> String
forall a. Show a => a -> String
show ((e -> ()) -> f e -> f ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> e -> ()
forall a b. a -> b -> a
const ()) f e
thing)]
todo :: (Functor f, Show (f ())) => String -> f e -> a
todo :: String -> f e -> a
todo String
fun f e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun,
String
": not implemented: ", f () -> String
forall a. Show a => a -> String
show ((e -> ()) -> f e -> f ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> e -> ()
forall a b. a -> b -> a
const ()) f e
thing)]
nonsense :: (Functor f, Show (f ())) => String -> String -> f e -> a
nonsense :: String -> String -> f e -> a
nonsense String
fun String
inparticular f e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun,
String
": nonsensical: ", String
inparticular, String
": ", f () -> String
forall a. Show a => a -> String
show ((e -> ()) -> f e -> f ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> e -> ()
forall a b. a -> b -> a
const ()) f e
thing)]
#if MIN_VERSION_template_haskell(2,16,0)
toTupEl :: ToExp a => a -> Maybe TH.Exp
toTupEl :: a -> Maybe Exp
toTupEl = Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> (a -> Exp) -> a -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Exp
forall a. ToExp a => a -> Exp
toExp
#else
toTupEl :: ToExp a => a -> TH.Exp
toTupEl = toExp
#endif
instance ToExp TH.Lit where
toExp :: Lit -> Exp
toExp = Lit -> Exp
TH.LitE
instance (ToExp a) => ToExp [a] where
toExp :: [a] -> Exp
toExp = [Exp] -> Exp
TH.ListE ([Exp] -> Exp) -> ([a] -> [Exp]) -> [a] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Exp) -> [a] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Exp
forall a. ToExp a => a -> Exp
toExp
instance (ToExp a, ToExp b) => ToExp (a,b) where
toExp :: (a, b) -> Exp
toExp (a
a,b
b) = [Maybe Exp] -> Exp
TH.TupE [a -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl a
a, b -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl b
b]
instance (ToExp a, ToExp b, ToExp c) => ToExp (a,b,c) where
toExp :: (a, b, c) -> Exp
toExp (a
a,b
b,c
c) = [Maybe Exp] -> Exp
TH.TupE [a -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl a
a, b -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl b
b, c -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl c
c]
instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a,b,c,d) where
toExp :: (a, b, c, d) -> Exp
toExp (a
a,b
b,c
c,d
d) = [Maybe Exp] -> Exp
TH.TupE [a -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl a
a, b -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl b
b, c -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl c
c, d -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl d
d]
instance ToPat TH.Lit where
toPat :: Lit -> Pat
toPat = Lit -> Pat
TH.LitP
instance (ToPat a) => ToPat [a] where
toPat :: [a] -> Pat
toPat = [Pat] -> Pat
TH.ListP ([Pat] -> Pat) -> ([a] -> [Pat]) -> [a] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Pat) -> [a] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Pat
forall a. ToPat a => a -> Pat
toPat
instance (ToPat a, ToPat b) => ToPat (a,b) where
toPat :: (a, b) -> Pat
toPat (a
a,b
b) = [Pat] -> Pat
TH.TupP [a -> Pat
forall a. ToPat a => a -> Pat
toPat a
a, b -> Pat
forall a. ToPat a => a -> Pat
toPat b
b]
instance (ToPat a, ToPat b, ToPat c) => ToPat (a,b,c) where
toPat :: (a, b, c) -> Pat
toPat (a
a,b
b,c
c) = [Pat] -> Pat
TH.TupP [a -> Pat
forall a. ToPat a => a -> Pat
toPat a
a, b -> Pat
forall a. ToPat a => a -> Pat
toPat b
b, c -> Pat
forall a. ToPat a => a -> Pat
toPat c
c]
instance (ToPat a, ToPat b, ToPat c, ToPat d) => ToPat (a,b,c,d) where
toPat :: (a, b, c, d) -> Pat
toPat (a
a,b
b,c
c,d
d) = [Pat] -> Pat
TH.TupP [a -> Pat
forall a. ToPat a => a -> Pat
toPat a
a, b -> Pat
forall a. ToPat a => a -> Pat
toPat b
b, c -> Pat
forall a. ToPat a => a -> Pat
toPat c
c, d -> Pat
forall a. ToPat a => a -> Pat
toPat d
d]
instance ToLit Char where
toLit :: Char -> Lit
toLit = Char -> Lit
TH.CharL
instance ToLit String where
toLit :: String -> Lit
toLit = String -> Lit
TH.StringL
instance ToLit Integer where
toLit :: Integer -> Lit
toLit = Integer -> Lit
TH.IntegerL
instance ToLit Int where
toLit :: Int -> Lit
toLit = Integer -> Lit
TH.IntegerL (Integer -> Lit) -> (Int -> Integer) -> Int -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToLit Float where
toLit :: Float -> Lit
toLit = Rational -> Lit
TH.RationalL (Rational -> Lit) -> (Float -> Rational) -> Float -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational
instance ToLit Double where
toLit :: Double -> Lit
toLit = Rational -> Lit
TH.RationalL (Rational -> Lit) -> (Double -> Rational) -> Double -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
instance ToName String where
toName :: String -> Name
toName = String -> Name
TH.mkName
instance ToName (Exts.Name l) where
toName :: Name l -> Name
toName (Exts.Ident l
_ String
s) = String -> Name
forall a. ToName a => a -> Name
toName String
s
toName (Exts.Symbol l
_ String
s) = String -> Name
forall a. ToName a => a -> Name
toName String
s
instance ToName (Exts.SpecialCon l) where
toName :: SpecialCon l -> Name
toName (Exts.UnitCon l
_) = String -> Name
TH.mkName String
"()"
toName (Exts.ListCon l
_) = ''[]
toName (Exts.FunCon l
_) = ''(->)
toName (Exts.TupleCon l
_ Boxed
_ Int
n) =
String -> Name
TH.mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(",Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
',',String
")"]
toName (Exts.Cons l
_) = '(:)
toName SpecialCon l
h = String -> SpecialCon l -> Name
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toName not implemented" SpecialCon l
h
instance ToName (Exts.QName l) where
toName :: QName l -> Name
toName (Exts.Qual l
_ (Exts.ModuleName l
_ []) Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
toName (Exts.Qual l
_ (Exts.ModuleName l
_ String
m) Name l
n) =
let m' :: String
m' = Name -> String
forall a. Show a => a -> String
show (Name -> String) -> (String -> Name) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
forall a. ToName a => a -> Name
toName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
m
n' :: String
n' = Name -> String
forall a. Show a => a -> String
show (Name -> String) -> (Name l -> Name) -> Name l -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name l -> Name
forall a. ToName a => a -> Name
toName (Name l -> String) -> Name l -> String
forall a b. (a -> b) -> a -> b
$ Name l
n
in String -> Name
forall a. ToName a => a -> Name
toName (String -> Name) -> ([String] -> String) -> [String] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> Name) -> [String] -> Name
forall a b. (a -> b) -> a -> b
$ [String
m',String
".",String
n']
toName (Exts.UnQual l
_ Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
toName (Exts.Special l
_ SpecialCon l
s) = SpecialCon l -> Name
forall a. ToName a => a -> Name
toName SpecialCon l
s
#if MIN_VERSION_haskell_src_exts(1,20,1)
instance ToName (Exts.MaybePromotedName l) where
toName :: MaybePromotedName l -> Name
toName (Exts.PromotedName l
_ QName l
qn) = QName l -> Name
forall a. ToName a => a -> Name
toName QName l
qn
toName (Exts.UnpromotedName l
_ QName l
qn) = QName l -> Name
forall a. ToName a => a -> Name
toName QName l
qn
#endif
instance ToName (Exts.Op l) where
toName :: Op l -> Name
toName (Exts.VarOp l
_ Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
toName (Exts.ConOp l
_ Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
instance ToLit (Exts.Literal l) where
toLit :: Literal l -> Lit
toLit (Exts.Char l
_ Char
a String
_) = Char -> Lit
TH.CharL Char
a
toLit (Exts.String l
_ String
a String
_) = String -> Lit
TH.StringL String
a
toLit (Exts.Int l
_ Integer
a String
_) = Integer -> Lit
TH.IntegerL Integer
a
toLit (Exts.Frac l
_ Rational
a String
_) = Rational -> Lit
TH.RationalL Rational
a
toLit l :: Literal l
l@Exts.PrimChar{} = String -> Literal l -> Lit
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toLit" Literal l
l
toLit (Exts.PrimString l
_ String
a String
_) = [Word8] -> Lit
TH.StringPrimL ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
toWord8 String
a)
where
toWord8 :: Char -> Word8
toWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord
toLit (Exts.PrimInt l
_ Integer
a String
_) = Integer -> Lit
TH.IntPrimL Integer
a
toLit (Exts.PrimFloat l
_ Rational
a String
_) = Rational -> Lit
TH.FloatPrimL Rational
a
toLit (Exts.PrimDouble l
_ Rational
a String
_) = Rational -> Lit
TH.DoublePrimL Rational
a
toLit (Exts.PrimWord l
_ Integer
a String
_) = Integer -> Lit
TH.WordPrimL Integer
a
instance ToPat (Exts.Pat l) where
toPat :: Pat l -> Pat
toPat (Exts.PVar l
_ Name l
n)
= Name -> Pat
TH.VarP (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n)
toPat (Exts.PLit l
_ (Exts.Signless l
_) Literal l
l)
= Lit -> Pat
TH.LitP (Literal l -> Lit
forall a. ToLit a => a -> Lit
toLit Literal l
l)
toPat (Exts.PLit l
_ (Exts.Negative l
_) Literal l
l) = Lit -> Pat
TH.LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ case Literal l -> Lit
forall a. ToLit a => a -> Lit
toLit Literal l
l of
TH.IntegerL Integer
z -> Integer -> Lit
TH.IntegerL (Integer -> Integer
forall a. Num a => a -> a
negate Integer
z)
TH.RationalL Rational
q -> Rational -> Lit
TH.RationalL (Rational -> Rational
forall a. Num a => a -> a
negate Rational
q)
TH.IntPrimL Integer
z' -> Integer -> Lit
TH.IntPrimL (Integer -> Integer
forall a. Num a => a -> a
negate Integer
z')
TH.FloatPrimL Rational
r' -> Rational -> Lit
TH.FloatPrimL (Rational -> Rational
forall a. Num a => a -> a
negate Rational
r')
TH.DoublePrimL Rational
r'' -> Rational -> Lit
TH.DoublePrimL (Rational -> Rational
forall a. Num a => a -> a
negate Rational
r'')
Lit
_ -> String -> String -> Literal l -> Lit
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> String -> f e -> a
nonsense String
"toPat" String
"negating wrong kind of literal" Literal l
l
toPat (Exts.PInfixApp l
_ Pat l
p QName l
n Pat l
q) = Pat -> Name -> Pat -> Pat
TH.UInfixP (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p) (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n) (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
q)
toPat (Exts.PApp l
_ QName l
n [Pat l]
ps) = Name -> [Pat] -> Pat
TH.ConP (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n) ((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat [Pat l]
ps)
toPat (Exts.PTuple l
_ Boxed
Exts.Boxed [Pat l]
ps) = [Pat] -> Pat
TH.TupP ((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat [Pat l]
ps)
toPat (Exts.PTuple l
_ Boxed
Exts.Unboxed [Pat l]
ps) = [Pat] -> Pat
TH.UnboxedTupP ((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat [Pat l]
ps)
toPat (Exts.PList l
_ [Pat l]
ps) = [Pat] -> Pat
TH.ListP ((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat [Pat l]
ps)
toPat (Exts.PParen l
_ Pat l
p) = Pat -> Pat
TH.ParensP (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p)
toPat (Exts.PRec l
_ QName l
n [PatField l]
pfs) = let toFieldPat :: PatField e -> (Name, Pat)
toFieldPat (Exts.PFieldPat e
_ QName e
n' Pat e
p) = (QName e -> Name
forall a. ToName a => a -> Name
toName QName e
n', Pat e -> Pat
forall a. ToPat a => a -> Pat
toPat Pat e
p)
toFieldPat PatField e
h = String -> PatField e -> (Name, Pat)
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toFieldPat" PatField e
h
in Name -> [(Name, Pat)] -> Pat
TH.RecP (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n) ((PatField l -> (Name, Pat)) -> [PatField l] -> [(Name, Pat)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatField l -> (Name, Pat)
forall e. PatField e -> (Name, Pat)
toFieldPat [PatField l]
pfs)
toPat (Exts.PAsPat l
_ Name l
n Pat l
p) = Name -> Pat -> Pat
TH.AsP (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p)
toPat (Exts.PWildCard l
_) = Pat
TH.WildP
toPat (Exts.PIrrPat l
_ Pat l
p) = Pat -> Pat
TH.TildeP (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p)
toPat (Exts.PatTypeSig l
_ Pat l
p Type l
t) = Pat -> Type -> Pat
TH.SigP (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
toPat (Exts.PViewPat l
_ Exp l
e Pat l
p) = Exp -> Pat -> Pat
TH.ViewP (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p)
toPat p :: Pat l
p@Exts.PRPat{} = String -> Pat l -> Pat
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toPat" Pat l
p
toPat p :: Pat l
p@Exts.PXTag{} = String -> Pat l -> Pat
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toPat" Pat l
p
toPat p :: Pat l
p@Exts.PXETag{} = String -> Pat l -> Pat
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toPat" Pat l
p
toPat p :: Pat l
p@Exts.PXPcdata{} = String -> Pat l -> Pat
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toPat" Pat l
p
toPat p :: Pat l
p@Exts.PXPatTag{} = String -> Pat l -> Pat
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toPat" Pat l
p
toPat (Exts.PBangPat l
_ Pat l
p) = Pat -> Pat
TH.BangP (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p)
toPat Pat l
p = String -> Pat l -> Pat
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toPat" Pat l
p
instance ToExp (Exts.QOp l) where
toExp :: QOp l -> Exp
toExp (Exts.QVarOp l
_ QName l
n) = Name -> Exp
TH.VarE (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n)
toExp (Exts.QConOp l
_ QName l
n) = Name -> Exp
TH.ConE (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n)
toFieldExp :: Exts.FieldUpdate l -> TH.FieldExp
toFieldExp :: FieldUpdate l -> FieldExp
toFieldExp (Exts.FieldUpdate l
_ QName l
n Exp l
e) = (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n, Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toFieldExp FieldUpdate l
h = String -> FieldUpdate l -> FieldExp
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toFieldExp" FieldUpdate l
h
instance ToExp (Exts.Exp l) where
toExp :: Exp l -> Exp
toExp (Exts.Var l
_ QName l
n) = Name -> Exp
TH.VarE (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n)
toExp e :: Exp l
e@Exts.IPVar{} = String -> Exp l -> Exp
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toExp" Exp l
e
toExp (Exts.Con l
_ QName l
n) = Name -> Exp
TH.ConE (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n)
toExp (Exts.Lit l
_ Literal l
l) = Lit -> Exp
TH.LitE (Literal l -> Lit
forall a. ToLit a => a -> Lit
toLit Literal l
l)
toExp (Exts.InfixApp l
_ Exp l
e QOp l
o Exp l
f) = Exp -> Exp -> Exp -> Exp
TH.UInfixE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (QOp l -> Exp
forall a. ToExp a => a -> Exp
toExp QOp l
o) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
f)
#if MIN_VERSION_template_haskell(2,12,0)
toExp (Exts.App l
_ Exp l
e (Exts.TypeApp l
_ Type l
t)) = Exp -> Type -> Exp
TH.AppTypeE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
#else
toExp (Exts.App _ _ e@Exts.TypeApp{}) = noTHyet "toExp" "2.12.0" e
#endif
toExp (Exts.App l
_ Exp l
e Exp l
f) = Exp -> Exp -> Exp
TH.AppE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
f)
toExp (Exts.NegApp l
_ Exp l
e) = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'negate) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toExp (Exts.Lambda l
_ [Pat l]
ps Exp l
e) = [Pat] -> Exp -> Exp
TH.LamE ((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat [Pat l]
ps) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toExp (Exts.Let l
_ Binds l
bs Exp l
e) = [Dec] -> Exp -> Exp
TH.LetE (Binds l -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Binds l
bs) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toExp (Exts.If l
_ Exp l
a Exp l
b Exp l
c) = Exp -> Exp -> Exp -> Exp
TH.CondE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
a) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
b) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
c)
toExp (Exts.MultiIf l
_ [GuardedRhs l]
ifs) = [(Guard, Exp)] -> Exp
TH.MultiIfE ((GuardedRhs l -> (Guard, Exp)) -> [GuardedRhs l] -> [(Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs l -> (Guard, Exp)
forall l. GuardedRhs l -> (Guard, Exp)
toGuard [GuardedRhs l]
ifs)
toExp (Exts.Case l
_ Exp l
e [Alt l]
alts) = Exp -> [Match] -> Exp
TH.CaseE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) ((Alt l -> Match) -> [Alt l] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map Alt l -> Match
forall l. Alt l -> Match
toMatch [Alt l]
alts)
#if MIN_VERSION_template_haskell(2,17,0)
toExp (Exts.Do _ ss) = TH.DoE Nothing (map toStmt ss)
#else
toExp (Exts.Do l
_ [Stmt l]
ss) = [Stmt] -> Exp
TH.DoE ((Stmt l -> Stmt) -> [Stmt l] -> [Stmt]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Stmt
forall a. ToStmt a => a -> Stmt
toStmt [Stmt l]
ss)
#endif
toExp e :: Exp l
e@Exts.MDo{} = String -> Exp l -> Exp
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toExp" Exp l
e
toExp (Exts.Tuple l
_ Boxed
Exts.Boxed [Exp l]
xs) = [Maybe Exp] -> Exp
TH.TupE ((Exp l -> Maybe Exp) -> [Exp l] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp l -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl [Exp l]
xs)
toExp (Exts.Tuple l
_ Boxed
Exts.Unboxed [Exp l]
xs) = [Maybe Exp] -> Exp
TH.UnboxedTupE ((Exp l -> Maybe Exp) -> [Exp l] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp l -> Maybe Exp
forall a. ToExp a => a -> Maybe Exp
toTupEl [Exp l]
xs)
toExp e :: Exp l
e@Exts.TupleSection{} = String -> Exp l -> Exp
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toExp" Exp l
e
toExp (Exts.List l
_ [Exp l]
xs) = [Exp] -> Exp
TH.ListE ((Exp l -> Exp) -> [Exp l] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp [Exp l]
xs)
toExp (Exts.Paren l
_ Exp l
e) = Exp -> Exp
TH.ParensE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toExp (Exts.LeftSection l
_ Exp l
e QOp l
o) = Maybe Exp -> Exp -> Maybe Exp -> Exp
TH.InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> (Exp l -> Exp) -> Exp l -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp (Exp l -> Maybe Exp) -> Exp l -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Exp l
e) (QOp l -> Exp
forall a. ToExp a => a -> Exp
toExp QOp l
o) Maybe Exp
forall a. Maybe a
Nothing
toExp (Exts.RightSection l
_ QOp l
o Exp l
f) = Maybe Exp -> Exp -> Maybe Exp -> Exp
TH.InfixE Maybe Exp
forall a. Maybe a
Nothing (QOp l -> Exp
forall a. ToExp a => a -> Exp
toExp QOp l
o) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> (Exp l -> Exp) -> Exp l -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp (Exp l -> Maybe Exp) -> Exp l -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Exp l
f)
toExp (Exts.RecConstr l
_ QName l
n [FieldUpdate l]
xs) = Name -> [FieldExp] -> Exp
TH.RecConE (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n) ((FieldUpdate l -> FieldExp) -> [FieldUpdate l] -> [FieldExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldUpdate l -> FieldExp
forall l. FieldUpdate l -> FieldExp
toFieldExp [FieldUpdate l]
xs)
toExp (Exts.RecUpdate l
_ Exp l
e [FieldUpdate l]
xs) = Exp -> [FieldExp] -> Exp
TH.RecUpdE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) ((FieldUpdate l -> FieldExp) -> [FieldUpdate l] -> [FieldExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldUpdate l -> FieldExp
forall l. FieldUpdate l -> FieldExp
toFieldExp [FieldUpdate l]
xs)
toExp (Exts.EnumFrom l
_ Exp l
e) = Range -> Exp
TH.ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Range
TH.FromR (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toExp (Exts.EnumFromTo l
_ Exp l
e Exp l
f) = Range -> Exp
TH.ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Range
TH.FromToR (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
f)
toExp (Exts.EnumFromThen l
_ Exp l
e Exp l
f) = Range -> Exp
TH.ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Range
TH.FromThenR (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
f)
toExp (Exts.EnumFromThenTo l
_ Exp l
e Exp l
f Exp l
g) = Range -> Exp
TH.ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Range
TH.FromThenToR (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
f) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
g)
toExp (Exts.ListComp l
_ Exp l
e [QualStmt l]
ss) = [Stmt] -> Exp
TH.CompE ([Stmt] -> Exp) -> [Stmt] -> Exp
forall a b. (a -> b) -> a -> b
$ (QualStmt l -> Stmt) -> [QualStmt l] -> [Stmt]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Stmt
forall e. QualStmt e -> Stmt
convert [QualStmt l]
ss [Stmt] -> [Stmt] -> [Stmt]
forall a. [a] -> [a] -> [a]
++ [Exp -> Stmt
TH.NoBindS (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)]
where
convert :: QualStmt e -> Stmt
convert (Exts.QualStmt e
_ Stmt e
st) = Stmt e -> Stmt
forall a. ToStmt a => a -> Stmt
toStmt Stmt e
st
convert QualStmt e
s = String -> QualStmt e -> Stmt
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toExp ListComp" QualStmt e
s
toExp (Exts.ExpTypeSig l
_ Exp l
e Type l
t) = Exp -> Type -> Exp
TH.SigE (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
toExp Exp l
e = String -> Exp l -> Exp
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toExp" Exp l
e
toMatch :: Exts.Alt l -> TH.Match
toMatch :: Alt l -> Match
toMatch (Exts.Alt l
_ Pat l
p Rhs l
rhs Maybe (Binds l)
ds) = Pat -> Body -> [Dec] -> Match
TH.Match (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p) (Rhs l -> Body
forall l. Rhs l -> Body
toBody Rhs l
rhs) (Maybe (Binds l) -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Maybe (Binds l)
ds)
toBody :: Exts.Rhs l -> TH.Body
toBody :: Rhs l -> Body
toBody (Exts.UnGuardedRhs l
_ Exp l
e) = Exp -> Body
TH.NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e
toBody (Exts.GuardedRhss l
_ [GuardedRhs l]
rhss) = [(Guard, Exp)] -> Body
TH.GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ (GuardedRhs l -> (Guard, Exp)) -> [GuardedRhs l] -> [(Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs l -> (Guard, Exp)
forall l. GuardedRhs l -> (Guard, Exp)
toGuard [GuardedRhs l]
rhss
toGuard :: Exts.GuardedRhs l -> (TH.Guard, TH.Exp)
toGuard :: GuardedRhs l -> (Guard, Exp)
toGuard (Exts.GuardedRhs l
_ [Stmt l]
stmts Exp l
e) = (Guard
g, Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
where
g :: Guard
g = case (Stmt l -> Stmt) -> [Stmt l] -> [Stmt]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Stmt
forall a. ToStmt a => a -> Stmt
toStmt [Stmt l]
stmts of
[TH.NoBindS Exp
x] -> Exp -> Guard
TH.NormalG Exp
x
[Stmt]
xs -> [Stmt] -> Guard
TH.PatG [Stmt]
xs
instance ToDecs a => ToDecs (Maybe a) where
toDecs :: Maybe a -> [Dec]
toDecs Maybe a
Nothing = []
toDecs (Just a
a) = a -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs a
a
instance ToDecs (Exts.Binds l) where
toDecs :: Binds l -> [Dec]
toDecs (Exts.BDecls l
_ [Decl l]
ds) = [Decl l] -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs [Decl l]
ds
toDecs a :: Binds l
a@(Exts.IPBinds {}) = String -> Binds l -> [Dec]
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"ToDecs Exts.Binds" Binds l
a
instance ToDecs (Exts.ClassDecl l) where
toDecs :: ClassDecl l -> [Dec]
toDecs (Exts.ClsDecl l
_ Decl l
d) = Decl l -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Decl l
d
toDecs ClassDecl l
x = String -> ClassDecl l -> [Dec]
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"classDecl" ClassDecl l
x
instance ToLoc Exts.SrcLoc.SrcLoc where
toLoc :: SrcLoc -> Loc
toLoc (Exts.SrcLoc.SrcLoc String
fn Int
l Int
c) =
String -> String -> String -> CharPos -> CharPos -> Loc
TH.Loc String
fn [] [] (Int
l,Int
c) (-Int
1,-Int
1)
instance ToName (Exts.TyVarBind l) where
toName :: TyVarBind l -> Name
toName (Exts.KindedVar l
_ Name l
n Kind l
_) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
toName (Exts.UnkindedVar l
_ Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
instance ToName TH.Name where
toName :: Name -> Name
toName = Name -> Name
forall a. a -> a
id
instance ToName (TyVarBndr_ flag) where
#if MIN_VERSION_template_haskell(2,17,0)
toName (TH.PlainTV n _) = n
toName (TH.KindedTV n _ _) = n
#else
toName :: TyVarBndr_ flag -> Name
toName (TH.PlainTV Name
n) = Name
n
toName (TH.KindedTV Name
n Type
_) = Name
n
#endif
#if !MIN_VERSION_haskell_src_exts(1,21,0)
instance ToType (Exts.Kind l) where
toType (Exts.KindStar _) = TH.StarT
toType (Exts.KindFn _ k1 k2) = toType k1 .->. toType k2
toType (Exts.KindParen _ kp) = toType kp
toType (Exts.KindVar _ n) = TH.VarT (toName n)
toType (Exts.KindApp _ k1 k2) = toType k1 `TH.AppT` toType k2
toType (Exts.KindTuple _ ks) = foldr (\k pt -> pt `TH.AppT` toType k) (TH.TupleT $ length ks) ks
toType (Exts.KindList _ k) = TH.ListT `TH.AppT` toType k
#endif
toKind :: Exts.Kind l -> TH.Kind
toKind :: Kind l -> Type
toKind = Kind l -> Type
forall a. ToType a => a -> Type
toType
toTyVar :: Exts.TyVarBind l -> TyVarBndr_ ()
#if MIN_VERSION_template_haskell(2,17,0)
toTyVar (Exts.KindedVar _ n k) = TH.KindedTV (toName n) () (toKind k)
toTyVar (Exts.UnkindedVar _ n) = TH.PlainTV (toName n) ()
#else
toTyVar :: TyVarBind l -> TyVarBndr_ flag
toTyVar (Exts.KindedVar l
_ Name l
n Kind l
k) = Name -> Type -> TyVarBndr_ flag
TH.KindedTV (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) (Kind l -> Type
forall l. Kind l -> Type
toKind Kind l
k)
toTyVar (Exts.UnkindedVar l
_ Name l
n) = Name -> TyVarBndr_ flag
TH.PlainTV (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n)
#endif
#if MIN_VERSION_template_haskell(2,17,0)
toTyVarSpec :: TyVarBndr_ () -> TH.TyVarBndrSpec
toTyVarSpec (TH.KindedTV n () k) = TH.KindedTV n TH.SpecifiedSpec k
toTyVarSpec (TH.PlainTV n ()) = TH.PlainTV n TH.SpecifiedSpec
#else
toTyVarSpec :: TyVarBndr_ flag -> TyVarBndr_ flag
toTyVarSpec :: TyVarBndr_ flag -> TyVarBndr_ flag
toTyVarSpec = TyVarBndr_ flag -> TyVarBndr_ flag
forall a. a -> a
id
#endif
instance ToType (Exts.Type l) where
toType :: Type l -> Type
toType (Exts.TyForall l
_ Maybe [TyVarBind l]
tvbM Maybe (Context l)
cxt Type l
t) = [TyVarBndr_ flag] -> Cxt -> Type -> Type
TH.ForallT ([TyVarBndr_ flag]
-> ([TyVarBind l] -> [TyVarBndr_ flag])
-> Maybe [TyVarBind l]
-> [TyVarBndr_ flag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((TyVarBind l -> TyVarBndr_ flag)
-> [TyVarBind l] -> [TyVarBndr_ flag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TyVarBndr_ flag -> TyVarBndr_ flag
forall flag. TyVarBndr_ flag -> TyVarBndr_ flag
toTyVarSpec (TyVarBndr_ flag -> TyVarBndr_ flag)
-> (TyVarBind l -> TyVarBndr_ flag)
-> TyVarBind l
-> TyVarBndr_ flag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBind l -> TyVarBndr_ flag
forall l. TyVarBind l -> TyVarBndr_ flag
toTyVar)) Maybe [TyVarBind l]
tvbM) (Maybe (Context l) -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt Maybe (Context l)
cxt) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
toType (Exts.TyFun l
_ Type l
a Type l
b) = Type l -> Type
forall a. ToType a => a -> Type
toType Type l
a Type -> Type -> Type
.->. Type l -> Type
forall a. ToType a => a -> Type
toType Type l
b
toType (Exts.TyList l
_ Type l
t) = Type
TH.ListT Type -> Type -> Type
`TH.AppT` Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t
toType (Exts.TyTuple l
_ Boxed
b [Type l]
ts) = Type -> Cxt -> Type
foldAppT (Int -> Type
tuple (Int -> Type) -> ([Type l] -> Int) -> [Type l] -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type l] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Type l] -> Type) -> [Type l] -> Type
forall a b. (a -> b) -> a -> b
$ [Type l]
ts) ((Type l -> Type) -> [Type l] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type l -> Type
forall a. ToType a => a -> Type
toType [Type l]
ts)
where
tuple :: Int -> Type
tuple = case Boxed
b of
Boxed
Exts.Boxed -> Int -> Type
TH.TupleT
Boxed
Exts.Unboxed -> Int -> Type
TH.UnboxedTupleT
toType (Exts.TyApp l
_ Type l
a Type l
b) = Type -> Type -> Type
TH.AppT (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
a) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
b)
toType (Exts.TyVar l
_ Name l
n) = Name -> Type
TH.VarT (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n)
toType (Exts.TyCon l
_ QName l
qn) = Name -> Type
TH.ConT (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
qn)
toType (Exts.TyParen l
_ Type l
t) = Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t
#if MIN_VERSION_haskell_src_exts(1,20,0)
toType (Exts.TyInfix l
_ Type l
a (Exts.UnpromotedName l
_ QName l
o) Type l
b) =
Type -> Type -> Type
TH.AppT (Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
o)) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
a)) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
b)
#else
toType (Exts.TyInfix _ a o b) =
TH.AppT (TH.AppT (TH.ConT (toName o)) (toType a)) (toType b)
#endif
toType (Exts.TyKind l
_ Type l
t Type l
k) = Type -> Type -> Type
TH.SigT (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t) (Type l -> Type
forall l. Kind l -> Type
toKind Type l
k)
toType (Exts.TyPromoted l
_ Promoted l
p) = case Promoted l
p of
Exts.PromotedInteger l
_ Integer
i String
_ -> TyLit -> Type
TH.LitT (TyLit -> Type) -> TyLit -> Type
forall a b. (a -> b) -> a -> b
$ Integer -> TyLit
TH.NumTyLit Integer
i
Exts.PromotedString l
_ String
_ String
s -> TyLit -> Type
TH.LitT (TyLit -> Type) -> TyLit -> Type
forall a b. (a -> b) -> a -> b
$ String -> TyLit
TH.StrTyLit String
s
Exts.PromotedCon l
_ Bool
_q QName l
n -> Name -> Type
TH.PromotedT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n
Exts.PromotedList l
_ Bool
_q [Type l]
ts -> (Type l -> Type -> Type) -> Type -> [Type l] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Type l
t Type
pl -> Type
TH.PromotedConsT Type -> Type -> Type
`TH.AppT` Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t Type -> Type -> Type
`TH.AppT` Type
pl) Type
TH.PromotedNilT [Type l]
ts
Exts.PromotedTuple l
_ [Type l]
ts -> (Type l -> Type -> Type) -> Type -> [Type l] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Type l
t Type
pt -> Type
pt Type -> Type -> Type
`TH.AppT` Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t) (Int -> Type
TH.PromotedTupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$ [Type l] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type l]
ts) [Type l]
ts
Exts.PromotedUnit l
_ -> Name -> Type
TH.PromotedT ''()
toType (Exts.TyEquals l
_ Type l
t1 Type l
t2) = Type
TH.EqualityT Type -> Type -> Type
`TH.AppT` Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t1 Type -> Type -> Type
`TH.AppT` Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t2
toType t :: Type l
t@Exts.TySplice{} = String -> Type l -> Type
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toType" Type l
t
toType t :: Type l
t@Exts.TyBang{} =
String -> String -> Type l -> Type
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> String -> f e -> a
nonsense String
"toType" String
"type cannot have strictness annotations in this context" Type l
t
toType t :: Type l
t@Exts.TyWildCard{} = String -> Type l -> Type
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toType" Type l
t
toType Type l
t = String -> Type l -> Type
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toType" Type l
t
toStrictType :: Exts.Type l -> TH.StrictType
#if MIN_VERSION_template_haskell(2,11,0)
toStrictType :: Type l -> StrictType
toStrictType (Exts.TyBang l
_ BangType l
s Unpackedness l
u Type l
t) = (SourceUnpackedness -> SourceStrictness -> Bang
TH.Bang (Unpackedness l -> SourceUnpackedness
forall l. Unpackedness l -> SourceUnpackedness
toUnpack Unpackedness l
u) (BangType l -> SourceStrictness
forall l. BangType l -> SourceStrictness
toStrict BangType l
s), Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
where
toStrict :: BangType l -> SourceStrictness
toStrict (Exts.LazyTy l
_) = SourceStrictness
TH.SourceLazy
toStrict (Exts.BangedTy l
_) = SourceStrictness
TH.SourceStrict
toStrict (Exts.NoStrictAnnot l
_) = SourceStrictness
TH.NoSourceStrictness
toUnpack :: Unpackedness l -> SourceUnpackedness
toUnpack (Exts.Unpack l
_) = SourceUnpackedness
TH.SourceUnpack
toUnpack (Exts.NoUnpack l
_) = SourceUnpackedness
TH.SourceNoUnpack
toUnpack (Exts.NoUnpackPragma l
_) = SourceUnpackedness
TH.NoSourceUnpackedness
toStrictType Type l
x = (SourceUnpackedness -> SourceStrictness -> Bang
TH.Bang SourceUnpackedness
TH.NoSourceUnpackedness SourceStrictness
TH.NoSourceStrictness, Type l -> Type
forall a. ToType a => a -> Type
toType Type l
x)
#else
toStrictType (Exts.TyBang _ b u t) = (toStrict b u, toType t)
where
toStrict :: Exts.BangType l -> Exts.Unpackedness l -> TH.Strict
toStrict (Exts.BangedTy _) _ = TH.IsStrict
toStrict _ (Exts.Unpack _) = TH.Unpacked
toStrict _ _ = TH.NotStrict
toStrictType x = (TH.NotStrict, toType x)
#endif
(.->.) :: TH.Type -> TH.Type -> TH.Type
Type
a .->. :: Type -> Type -> Type
.->. Type
b = Type -> Type -> Type
TH.AppT (Type -> Type -> Type
TH.AppT Type
TH.ArrowT Type
a) Type
b
instance ToPred (Exts.Asst l) where
#if MIN_VERSION_haskell_src_exts(1,22,0)
toPred :: Asst l -> Type
toPred (Exts.TypeA l
_ Type l
t) = Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t
#else
toPred (Exts.ClassA _ n ts) = List.foldl' TH.AppT (TH.ConT (toName n)) (fmap toType ts)
toPred (Exts.InfixA _ t1 n t2) = List.foldl' TH.AppT (TH.ConT (toName n)) (fmap toType [t1,t2])
toPred (Exts.EqualP _ t1 t2) = List.foldl' TH.AppT TH.EqualityT (fmap toType [t1,t2])
toPred a@Exts.AppA{} = todo "toPred" a
toPred a@Exts.WildCardA{} = todo "toPred" a
#endif
toPred (Exts.ParenA l
_ Asst l
asst) = Asst l -> Type
forall a. ToPred a => a -> Type
toPred Asst l
asst
toPred a :: Asst l
a@Exts.IParam{} = String -> Asst l -> Type
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toPred" Asst l
a
instance ToDerivClauses (Exts.Deriving l) where
#if MIN_VERSION_template_haskell(2,12,0)
#if MIN_VERSION_haskell_src_exts(1,20,0)
toDerivClauses :: Deriving l -> [DerivClause]
toDerivClauses (Exts.Deriving l
_ Maybe (DerivStrategy l)
strat [InstRule l]
irules) = [Maybe DerivStrategy -> Cxt -> DerivClause
TH.DerivClause ((DerivStrategy l -> DerivStrategy)
-> Maybe (DerivStrategy l) -> Maybe DerivStrategy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DerivStrategy l -> DerivStrategy
forall l. DerivStrategy l -> DerivStrategy
toDerivStrategy Maybe (DerivStrategy l)
strat) ((InstRule l -> Type) -> [InstRule l] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map InstRule l -> Type
forall a. ToType a => a -> Type
toType [InstRule l]
irules)]
#else
toDerivClauses (Exts.Deriving _ irules) = [TH.DerivClause Nothing (map toType irules)]
#endif
#elif MIN_VERSION_template_haskell(2,11,0)
#if MIN_VERSION_haskell_src_exts(1,20,0)
toDerivClauses (Exts.Deriving _ _ irules) = map toType irules
#else
toDerivClauses (Exts.Deriving _ irules) = map toType irules
#endif
#else
#if MIN_VERSION_haskell_src_exts(1,20,0)
toDerivClauses (Exts.Deriving _ _ irules) = concatMap toNames irules
#else
toDerivClauses (Exts.Deriving _ irules) = concatMap toNames irules
#endif
#endif
instance ToDerivClauses a => ToDerivClauses (Maybe a) where
toDerivClauses :: Maybe a -> [DerivClause]
toDerivClauses Maybe a
Nothing = []
toDerivClauses (Just a
a) = a -> [DerivClause]
forall a. ToDerivClauses a => a -> [DerivClause]
toDerivClauses a
a
instance ToDerivClauses a => ToDerivClauses [a] where
toDerivClauses :: [a] -> [DerivClause]
toDerivClauses = (a -> [DerivClause]) -> [a] -> [DerivClause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [DerivClause]
forall a. ToDerivClauses a => a -> [DerivClause]
toDerivClauses
#if MIN_VERSION_template_haskell(2,12,0) && MIN_VERSION_haskell_src_exts(1,20,0)
toDerivStrategy :: (Exts.DerivStrategy l) -> TH.DerivStrategy
toDerivStrategy :: DerivStrategy l -> DerivStrategy
toDerivStrategy (Exts.DerivStock l
_) = DerivStrategy
TH.StockStrategy
toDerivStrategy (Exts.DerivAnyclass l
_) = DerivStrategy
TH.AnyclassStrategy
toDerivStrategy (Exts.DerivNewtype l
_) = DerivStrategy
TH.NewtypeStrategy
#if MIN_VERSION_haskell_src_exts(1,21,0)
#if MIN_VERSION_template_haskell(2,14,0)
toDerivStrategy (Exts.DerivVia l
_ Type l
t) = Type -> DerivStrategy
TH.ViaStrategy (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
#else
toDerivStrategy d@Exts.DerivVia{} = noTHyet "toDerivStrategy" "2.14" d
#endif
#endif
#endif
foldAppT :: TH.Type -> [TH.Type] -> TH.Type
foldAppT :: Type -> Cxt -> Type
foldAppT Type
t Cxt
ts = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Type -> Type -> Type
TH.AppT Type
t Cxt
ts
instance ToStmt (Exts.Stmt l) where
toStmt :: Stmt l -> Stmt
toStmt (Exts.Generator l
_ Pat l
p Exp l
e) = Pat -> Exp -> Stmt
TH.BindS (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toStmt (Exts.Qualifier l
_ Exp l
e) = Exp -> Stmt
TH.NoBindS (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
toStmt _a :: Stmt l
_a@(Exts.LetStmt l
_ Binds l
bnds) = [Dec] -> Stmt
TH.LetS (Binds l -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Binds l
bnds)
toStmt s :: Stmt l
s@Exts.RecStmt{} = String -> Stmt l -> Stmt
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toStmt" Stmt l
s
instance ToDec (Exts.Decl l) where
toDec :: Decl l -> Dec
toDec (Exts.TypeDecl l
_ DeclHead l
h Type l
t)
= Name -> [TyVarBndr_ flag] -> Type -> Dec
TH.TySynD (DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h) (DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t)
toDec a :: Decl l
a@(Exts.DataDecl l
_ DataOrNew l
dOrN Maybe (Context l)
cxt DeclHead l
h [QualConDecl l]
qcds [Deriving l]
qns)
= case DataOrNew l
dOrN of
Exts.DataType l
_ -> Cxt
-> Name
-> [TyVarBndr_ flag]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
TH.DataD (Maybe (Context l) -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt Maybe (Context l)
cxt)
(DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h)
(DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h)
#if MIN_VERSION_template_haskell(2,11,0)
Maybe Type
forall a. Maybe a
Nothing
#endif
((QualConDecl l -> Con) -> [QualConDecl l] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QualConDecl l -> Con
forall l. QualConDecl l -> Con
qualConDeclToCon [QualConDecl l]
qcds)
([Deriving l] -> [DerivClause]
forall a. ToDerivClauses a => a -> [DerivClause]
toDerivClauses [Deriving l]
qns)
Exts.NewType l
_ -> let qcd :: QualConDecl l
qcd = case [QualConDecl l]
qcds of
[QualConDecl l
x] -> QualConDecl l
x
[QualConDecl l]
_ -> String -> String -> Decl l -> QualConDecl l
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> String -> f e -> a
nonsense String
"toDec" (String
"newtype with " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"wrong number of constructors") Decl l
a
in Cxt
-> Name
-> [TyVarBndr_ flag]
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
TH.NewtypeD (Maybe (Context l) -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt Maybe (Context l)
cxt)
(DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h)
(DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h)
#if MIN_VERSION_template_haskell(2,11,0)
Maybe Type
forall a. Maybe a
Nothing
#endif
(QualConDecl l -> Con
forall l. QualConDecl l -> Con
qualConDeclToCon QualConDecl l
qcd)
([Deriving l] -> [DerivClause]
forall a. ToDerivClauses a => a -> [DerivClause]
toDerivClauses [Deriving l]
qns)
toDec _a :: Decl l
_a@(Exts.TypeSig l
_ [Name l]
ns Type l
t)
= let xs :: [Dec]
xs = (Name l -> Dec) -> [Name l] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Type -> Dec) -> Type -> Name -> Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Type -> Dec
TH.SigD (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t) (Name -> Dec) -> (Name l -> Name) -> Name l -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name l -> Name
forall a. ToName a => a -> Name
toName) [Name l]
ns
in case [Dec]
xs of Dec
x:[Dec]
_ -> Dec
x; [] -> String -> Dec
forall a. HasCallStack => String -> a
error String
"toDec: malformed TypeSig!"
toDec (Exts.InlineConlikeSig l
_ Maybe (Activation l)
act QName l
qn) = Pragma -> Dec
TH.PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$
Name -> Inline -> RuleMatch -> Phases -> Pragma
TH.InlineP (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
qn) Inline
TH.Inline RuleMatch
TH.ConLike (Maybe (Activation l) -> Phases
forall l. Maybe (Activation l) -> Phases
transAct Maybe (Activation l)
act)
toDec (Exts.InlineSig l
_ Bool
b Maybe (Activation l)
act QName l
qn) = Pragma -> Dec
TH.PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$
Name -> Inline -> RuleMatch -> Phases -> Pragma
TH.InlineP (QName l -> Name
forall a. ToName a => a -> Name
toName QName l
qn) Inline
inline RuleMatch
TH.FunLike (Maybe (Activation l) -> Phases
forall l. Maybe (Activation l) -> Phases
transAct Maybe (Activation l)
act)
where
inline :: Inline
inline | Bool
b = Inline
TH.Inline | Bool
otherwise = Inline
TH.NoInline
#if MIN_VERSION_template_haskell(2,11,0)
toDec (Exts.TypeFamDecl l
_ DeclHead l
h Maybe (ResultSig l)
sig Maybe (InjectivityInfo l)
inj)
= TypeFamilyHead -> Dec
TH.OpenTypeFamilyD (TypeFamilyHead -> Dec) -> TypeFamilyHead -> Dec
forall a b. (a -> b) -> a -> b
$ Name
-> [TyVarBndr_ flag]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TH.TypeFamilyHead (DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h)
(DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h)
(FamilyResultSig
-> (Type -> FamilyResultSig) -> Maybe Type -> FamilyResultSig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FamilyResultSig
TH.NoSig Type -> FamilyResultSig
TH.KindSig (Maybe Type -> FamilyResultSig)
-> (Maybe (ResultSig l) -> Maybe Type)
-> Maybe (ResultSig l)
-> FamilyResultSig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (ResultSig l) -> Maybe Type
forall a. ToMaybeKind a => a -> Maybe Type
toMaybeKind (Maybe (ResultSig l) -> FamilyResultSig)
-> Maybe (ResultSig l) -> FamilyResultSig
forall a b. (a -> b) -> a -> b
$ Maybe (ResultSig l)
sig)
((InjectivityInfo l -> InjectivityAnn)
-> Maybe (InjectivityInfo l) -> Maybe InjectivityAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InjectivityInfo l -> InjectivityAnn
forall a. ToInjectivityAnn a => a -> InjectivityAnn
toInjectivityAnn Maybe (InjectivityInfo l)
inj)
toDec (Exts.DataFamDecl l
_ Maybe (Context l)
_ DeclHead l
h Maybe (ResultSig l)
sig)
= Name -> [TyVarBndr_ flag] -> Maybe Type -> Dec
TH.DataFamilyD (DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h) (DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h) (Maybe (ResultSig l) -> Maybe Type
forall a. ToMaybeKind a => a -> Maybe Type
toMaybeKind Maybe (ResultSig l)
sig)
#else
toDec (Exts.TypeFamDecl _ h sig inj)
= TH.FamilyD TH.TypeFam (toName h) (toTyVars h) (toMaybeKind sig)
toDec (Exts.DataFamDecl _ _ h sig)
= TH.FamilyD TH.DataFam (toName h) (toTyVars h) (toMaybeKind sig)
#endif
toDec _a :: Decl l
_a@(Exts.FunBind l
_ [Match l]
mtchs) = [Match l] -> Dec
forall l. [Match l] -> Dec
hsMatchesToFunD [Match l]
mtchs
toDec (Exts.PatBind l
_ Pat l
p Rhs l
rhs Maybe (Binds l)
bnds) = Pat -> Body -> [Dec] -> Dec
TH.ValD (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p)
(Rhs l -> Body
forall l. Rhs l -> Body
hsRhsToBody Rhs l
rhs)
(Maybe (Binds l) -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Maybe (Binds l)
bnds)
toDec i :: Decl l
i@(Exts.InstDecl l
_ (Just Overlap l
overlap) InstRule l
_ Maybe [InstDecl l]
_) =
String -> (Overlap (), Decl l) -> Dec
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
noTH String
"toDec" ((l -> ()) -> Overlap l -> Overlap ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> l -> ()
forall a b. a -> b -> a
const ()) Overlap l
overlap, Decl l
i)
#if MIN_VERSION_template_haskell(2,11,0)
toDec (Exts.InstDecl l
_ Maybe (Overlap l)
Nothing InstRule l
irule Maybe [InstDecl l]
ids) = Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
TH.InstanceD
Maybe Overlap
forall a. Maybe a
Nothing
(InstRule l -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt InstRule l
irule)
(InstRule l -> Type
forall a. ToType a => a -> Type
toType InstRule l
irule)
(Maybe [InstDecl l] -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Maybe [InstDecl l]
ids)
#else
toDec (Exts.InstDecl _ Nothing irule ids) = TH.InstanceD
(toCxt irule)
(toType irule)
(toDecs ids)
#endif
toDec (Exts.ClassDecl l
_ Maybe (Context l)
cxt DeclHead l
h [FunDep l]
fds Maybe [ClassDecl l]
decls) = Cxt -> Name -> [TyVarBndr_ flag] -> [FunDep] -> [Dec] -> Dec
TH.ClassD
(Maybe (Context l) -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt Maybe (Context l)
cxt)
(DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h)
(DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h)
((FunDep l -> FunDep) -> [FunDep l] -> [FunDep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunDep l -> FunDep
forall l. FunDep l -> FunDep
toFunDep [FunDep l]
fds)
(Maybe [ClassDecl l] -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Maybe [ClassDecl l]
decls)
where
toFunDep :: FunDep l -> FunDep
toFunDep (Exts.FunDep l
_ [Name l]
ls [Name l]
rs) = [Name] -> [Name] -> FunDep
TH.FunDep ((Name l -> Name) -> [Name l] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name l -> Name
forall a. ToName a => a -> Name
toName [Name l]
ls) ((Name l -> Name) -> [Name l] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name l -> Name
forall a. ToName a => a -> Name
toName [Name l]
rs)
toDec Decl l
x = String -> Decl l -> Dec
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toDec" Decl l
x
instance ToMaybeKind (Exts.ResultSig l) where
toMaybeKind :: ResultSig l -> Maybe Type
toMaybeKind (Exts.KindSig l
_ Kind l
k) = Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Kind l -> Type
forall l. Kind l -> Type
toKind Kind l
k
toMaybeKind (Exts.TyVarSig l
_ TyVarBind l
_) = Maybe Type
forall a. Maybe a
Nothing
instance ToMaybeKind a => ToMaybeKind (Maybe a) where
toMaybeKind :: Maybe a -> Maybe Type
toMaybeKind Maybe a
Nothing = Maybe Type
forall a. Maybe a
Nothing
toMaybeKind (Just a
a) = a -> Maybe Type
forall a. ToMaybeKind a => a -> Maybe Type
toMaybeKind a
a
#if MIN_VERSION_template_haskell(2,11,0)
instance ToInjectivityAnn (Exts.InjectivityInfo l) where
toInjectivityAnn :: InjectivityInfo l -> InjectivityAnn
toInjectivityAnn (Exts.InjectivityInfo l
_ Name l
n [Name l]
ns) = Name -> [Name] -> InjectivityAnn
TH.InjectivityAnn (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) ((Name l -> Name) -> [Name l] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name l -> Name
forall a. ToName a => a -> Name
toName [Name l]
ns)
#endif
transAct :: Maybe (Exts.Activation l) -> TH.Phases
transAct :: Maybe (Activation l) -> Phases
transAct Maybe (Activation l)
Nothing = Phases
TH.AllPhases
transAct (Just (Exts.ActiveFrom l
_ Int
n)) = Int -> Phases
TH.FromPhase Int
n
transAct (Just (Exts.ActiveUntil l
_ Int
n)) = Int -> Phases
TH.BeforePhase Int
n
instance ToName (Exts.DeclHead l) where
toName :: DeclHead l -> Name
toName (Exts.DHead l
_ Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
toName (Exts.DHInfix l
_ TyVarBind l
_ Name l
n) = Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n
toName (Exts.DHParen l
_ DeclHead l
h) = DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h
toName (Exts.DHApp l
_ DeclHead l
h TyVarBind l
_) = DeclHead l -> Name
forall a. ToName a => a -> Name
toName DeclHead l
h
instance ToTyVars (Exts.DeclHead l) where
toTyVars :: DeclHead l -> [TyVarBndr_ flag]
toTyVars (Exts.DHead l
_ Name l
_) = []
toTyVars (Exts.DHParen l
_ DeclHead l
h) = DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h
toTyVars (Exts.DHInfix l
_ TyVarBind l
tvb Name l
_) = [TyVarBind l -> TyVarBndr_ flag
forall l. TyVarBind l -> TyVarBndr_ flag
toTyVar TyVarBind l
tvb]
toTyVars (Exts.DHApp l
_ DeclHead l
h TyVarBind l
tvb) = DeclHead l -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars DeclHead l
h [TyVarBndr_ flag] -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
forall a. [a] -> [a] -> [a]
++ [TyVarBind l -> TyVarBndr_ flag
forall l. TyVarBind l -> TyVarBndr_ flag
toTyVar TyVarBind l
tvb]
instance ToNames a => ToNames (Maybe a) where
toNames :: Maybe a -> [Name]
toNames Maybe a
Nothing = []
toNames (Just a
a) = a -> [Name]
forall a. ToNames a => a -> [Name]
toNames a
a
instance ToNames (Exts.Deriving l) where
#if MIN_VERSION_haskell_src_exts(1,20,0)
toNames :: Deriving l -> [Name]
toNames (Exts.Deriving l
_ Maybe (DerivStrategy l)
_ [InstRule l]
irules) = (InstRule l -> [Name]) -> [InstRule l] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstRule l -> [Name]
forall a. ToNames a => a -> [Name]
toNames [InstRule l]
irules
#else
toNames (Exts.Deriving _ irules) = concatMap toNames irules
#endif
instance ToNames (Exts.InstRule l) where
toNames :: InstRule l -> [Name]
toNames (Exts.IParen l
_ InstRule l
irule) = InstRule l -> [Name]
forall a. ToNames a => a -> [Name]
toNames InstRule l
irule
toNames (Exts.IRule l
_ Maybe [TyVarBind l]
_mtvbs Maybe (Context l)
_mcxt InstHead l
mihd) = InstHead l -> [Name]
forall a. ToNames a => a -> [Name]
toNames InstHead l
mihd
instance ToNames (Exts.InstHead l) where
toNames :: InstHead l -> [Name]
toNames (Exts.IHCon l
_ QName l
n) = [QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n]
toNames (Exts.IHInfix l
_ Type l
_ QName l
n) = [QName l -> Name
forall a. ToName a => a -> Name
toName QName l
n]
toNames (Exts.IHParen l
_ InstHead l
h) = InstHead l -> [Name]
forall a. ToNames a => a -> [Name]
toNames InstHead l
h
toNames (Exts.IHApp l
_ InstHead l
h Type l
_) = InstHead l -> [Name]
forall a. ToNames a => a -> [Name]
toNames InstHead l
h
instance ToCxt (Exts.InstRule l) where
toCxt :: InstRule l -> Cxt
toCxt (Exts.IRule l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
cxt InstHead l
_) = Maybe (Context l) -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt Maybe (Context l)
cxt
toCxt (Exts.IParen l
_ InstRule l
irule) = InstRule l -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt InstRule l
irule
instance ToCxt (Exts.Context l) where
toCxt :: Context l -> Cxt
toCxt Context l
x = case Context l
x of
Exts.CxEmpty l
_ -> []
Exts.CxSingle l
_ Asst l
x' -> [Asst l -> Type
forall a. ToPred a => a -> Type
toPred Asst l
x']
Exts.CxTuple l
_ [Asst l]
xs -> (Asst l -> Type) -> [Asst l] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Asst l -> Type
forall a. ToPred a => a -> Type
toPred [Asst l]
xs
instance ToCxt a => ToCxt (Maybe a) where
toCxt :: Maybe a -> Cxt
toCxt Maybe a
Nothing = []
toCxt (Just a
a) = a -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt a
a
instance ToType (Exts.InstRule l) where
toType :: InstRule l -> Type
toType (Exts.IRule l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ InstHead l
h) = InstHead l -> Type
forall a. ToType a => a -> Type
toType InstHead l
h
toType (Exts.IParen l
_ InstRule l
irule) = InstRule l -> Type
forall a. ToType a => a -> Type
toType InstRule l
irule
instance ToType (Exts.InstHead l) where
toType :: InstHead l -> Type
toType (Exts.IHCon l
_ QName l
qn) = QName l -> Type
forall a. ToType a => a -> Type
toType QName l
qn
toType (Exts.IHInfix l
_ Type l
typ QName l
qn) = Type -> Type -> Type
TH.AppT (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
typ) (QName l -> Type
forall a. ToType a => a -> Type
toType QName l
qn)
toType (Exts.IHParen l
_ InstHead l
hd) = InstHead l -> Type
forall a. ToType a => a -> Type
toType InstHead l
hd
toType (Exts.IHApp l
_ InstHead l
hd Type l
typ) = Type -> Type -> Type
TH.AppT (InstHead l -> Type
forall a. ToType a => a -> Type
toType InstHead l
hd) (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
typ)
qualConDeclToCon :: Exts.QualConDecl l -> TH.Con
qualConDeclToCon :: QualConDecl l -> Con
qualConDeclToCon (Exts.QualConDecl l
_ Maybe [TyVarBind l]
Nothing Maybe (Context l)
Nothing ConDecl l
cdecl) = ConDecl l -> Con
forall l. ConDecl l -> Con
conDeclToCon ConDecl l
cdecl
qualConDeclToCon (Exts.QualConDecl l
_ Maybe [TyVarBind l]
ns Maybe (Context l)
cxt ConDecl l
cdecl) = [TyVarBndr_ flag] -> Cxt -> Con -> Con
TH.ForallC (TyVarBndr_ flag -> TyVarBndr_ flag
forall flag. TyVarBndr_ flag -> TyVarBndr_ flag
toTyVarSpec (TyVarBndr_ flag -> TyVarBndr_ flag)
-> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [TyVarBind l] -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars Maybe [TyVarBind l]
ns)
(Maybe (Context l) -> Cxt
forall a. ToCxt a => a -> Cxt
toCxt Maybe (Context l)
cxt)
(ConDecl l -> Con
forall l. ConDecl l -> Con
conDeclToCon ConDecl l
cdecl)
instance ToTyVars a => ToTyVars (Maybe a) where
toTyVars :: Maybe a -> [TyVarBndr_ flag]
toTyVars Maybe a
Nothing = []
toTyVars (Just a
a) = a -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars a
a
instance ToTyVars a => ToTyVars [a] where
toTyVars :: [a] -> [TyVarBndr_ flag]
toTyVars = (a -> [TyVarBndr_ flag]) -> [a] -> [TyVarBndr_ flag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [TyVarBndr_ flag]
forall a. ToTyVars a => a -> [TyVarBndr_ flag]
toTyVars
instance ToTyVars (Exts.TyVarBind l) where
toTyVars :: TyVarBind l -> [TyVarBndr_ flag]
toTyVars TyVarBind l
tvb = [TyVarBind l -> TyVarBndr_ flag
forall l. TyVarBind l -> TyVarBndr_ flag
toTyVar TyVarBind l
tvb]
instance ToType (Exts.QName l) where
toType :: QName l -> Type
toType = Name -> Type
TH.ConT (Name -> Type) -> (QName l -> Name) -> QName l -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName l -> Name
forall a. ToName a => a -> Name
toName
conDeclToCon :: Exts.ConDecl l -> TH.Con
conDeclToCon :: ConDecl l -> Con
conDeclToCon (Exts.ConDecl l
_ Name l
n [Type l]
tys)
= Name -> [StrictType] -> Con
TH.NormalC (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) ((Type l -> StrictType) -> [Type l] -> [StrictType]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> StrictType
forall l. Type l -> StrictType
toStrictType [Type l]
tys)
conDeclToCon (Exts.RecDecl l
_ Name l
n [FieldDecl l]
fieldDecls)
= Name -> [VarBangType] -> Con
TH.RecC (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) ((FieldDecl l -> [VarBangType]) -> [FieldDecl l] -> [VarBangType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldDecl l -> [VarBangType]
forall l. FieldDecl l -> [VarBangType]
convField [FieldDecl l]
fieldDecls)
where
convField :: Exts.FieldDecl l -> [TH.VarStrictType]
convField :: FieldDecl l -> [VarBangType]
convField (Exts.FieldDecl l
_ [Name l]
ns Type l
t) =
let (Bang
strict, Type
ty) = Type l -> StrictType
forall l. Type l -> StrictType
toStrictType Type l
t
in (Name l -> VarBangType) -> [Name l] -> [VarBangType]
forall a b. (a -> b) -> [a] -> [b]
map (\Name l
n' -> (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n', Bang
strict, Type
ty)) [Name l]
ns
conDeclToCon ConDecl l
h = String -> ConDecl l -> Con
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"conDeclToCon" ConDecl l
h
hsMatchesToFunD :: [Exts.Match l] -> TH.Dec
hsMatchesToFunD :: [Match l] -> Dec
hsMatchesToFunD [] = Name -> [Clause] -> Dec
TH.FunD (String -> Name
TH.mkName []) []
hsMatchesToFunD xs :: [Match l]
xs@(Exts.Match l
_ Name l
n [Pat l]
_ Rhs l
_ Maybe (Binds l)
_ : [Match l]
_) = Name -> [Clause] -> Dec
TH.FunD (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) ((Match l -> Clause) -> [Match l] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Match l -> Clause
forall l. Match l -> Clause
hsMatchToClause [Match l]
xs)
hsMatchesToFunD xs :: [Match l]
xs@(Exts.InfixMatch l
_ Pat l
_ Name l
n [Pat l]
_ Rhs l
_ Maybe (Binds l)
_ : [Match l]
_) = Name -> [Clause] -> Dec
TH.FunD (Name l -> Name
forall a. ToName a => a -> Name
toName Name l
n) ((Match l -> Clause) -> [Match l] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Match l -> Clause
forall l. Match l -> Clause
hsMatchToClause [Match l]
xs)
hsMatchToClause :: Exts.Match l -> TH.Clause
hsMatchToClause :: Match l -> Clause
hsMatchToClause (Exts.Match l
_ Name l
_ [Pat l]
ps Rhs l
rhs Maybe (Binds l)
bnds) = [Pat] -> Body -> [Dec] -> Clause
TH.Clause
((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat [Pat l]
ps)
(Rhs l -> Body
forall l. Rhs l -> Body
hsRhsToBody Rhs l
rhs)
(Maybe (Binds l) -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Maybe (Binds l)
bnds)
hsMatchToClause (Exts.InfixMatch l
_ Pat l
p Name l
_ [Pat l]
ps Rhs l
rhs Maybe (Binds l)
bnds) = [Pat] -> Body -> [Dec] -> Clause
TH.Clause
((Pat l -> Pat) -> [Pat l] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat (Pat l
pPat l -> [Pat l] -> [Pat l]
forall a. a -> [a] -> [a]
:[Pat l]
ps))
(Rhs l -> Body
forall l. Rhs l -> Body
hsRhsToBody Rhs l
rhs)
(Maybe (Binds l) -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Maybe (Binds l)
bnds)
hsRhsToBody :: Exts.Rhs l -> TH.Body
hsRhsToBody :: Rhs l -> Body
hsRhsToBody (Exts.UnGuardedRhs l
_ Exp l
e) = Exp -> Body
TH.NormalB (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
hsRhsToBody (Exts.GuardedRhss l
_ [GuardedRhs l]
hsgrhs) =
let fromGuardedB :: Body -> [(Guard, Exp)]
fromGuardedB (TH.GuardedB [(Guard, Exp)]
a) = [(Guard, Exp)]
a
fromGuardedB Body
h = String -> [Body] -> [(Guard, Exp)]
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"fromGuardedB" [Body
h]
in [(Guard, Exp)] -> Body
TH.GuardedB ([(Guard, Exp)] -> Body)
-> ([GuardedRhs l] -> [(Guard, Exp)]) -> [GuardedRhs l] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Guard, Exp)]] -> [(Guard, Exp)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([[(Guard, Exp)]] -> [(Guard, Exp)])
-> ([GuardedRhs l] -> [[(Guard, Exp)]])
-> [GuardedRhs l]
-> [(Guard, Exp)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuardedRhs l -> [(Guard, Exp)])
-> [GuardedRhs l] -> [[(Guard, Exp)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Body -> [(Guard, Exp)]
fromGuardedB (Body -> [(Guard, Exp)])
-> (GuardedRhs l -> Body) -> GuardedRhs l -> [(Guard, Exp)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs l -> Body
forall l. GuardedRhs l -> Body
hsGuardedRhsToBody)
([GuardedRhs l] -> Body) -> [GuardedRhs l] -> Body
forall a b. (a -> b) -> a -> b
$ [GuardedRhs l]
hsgrhs
hsGuardedRhsToBody :: Exts.GuardedRhs l -> TH.Body
hsGuardedRhsToBody :: GuardedRhs l -> Body
hsGuardedRhsToBody (Exts.GuardedRhs l
_ [] Exp l
e) = Exp -> Body
TH.NormalB (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
hsGuardedRhsToBody (Exts.GuardedRhs l
_ [Stmt l
s] Exp l
e) = [(Guard, Exp)] -> Body
TH.GuardedB [(Stmt l -> Guard
forall l. Stmt l -> Guard
hsStmtToGuard Stmt l
s, Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)]
hsGuardedRhsToBody (Exts.GuardedRhs l
_ [Stmt l]
ss Exp l
e) = let ss' :: [Guard]
ss' = (Stmt l -> Guard) -> [Stmt l] -> [Guard]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stmt l -> Guard
forall l. Stmt l -> Guard
hsStmtToGuard [Stmt l]
ss
([[Stmt]]
pgs,[Guard]
ngs) = [([Stmt], Guard)] -> ([[Stmt]], [Guard])
forall a b. [(a, b)] -> ([a], [b])
unzip [([Stmt]
p,Guard
n)
| (TH.PatG [Stmt]
p) <- [Guard]
ss'
, n :: Guard
n@(TH.NormalG Exp
_) <- [Guard]
ss']
e' :: Exp
e' = Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e
patg :: Guard
patg = [Stmt] -> Guard
TH.PatG ([[Stmt]] -> [Stmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Stmt]]
pgs)
in [(Guard, Exp)] -> Body
TH.GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ (Guard
patg,Exp
e') (Guard, Exp) -> [(Guard, Exp)] -> [(Guard, Exp)]
forall a. a -> [a] -> [a]
: [Guard] -> [Exp] -> [(Guard, Exp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Guard]
ngs (Exp -> [Exp]
forall a. a -> [a]
repeat Exp
e')
hsStmtToGuard :: Exts.Stmt l -> TH.Guard
hsStmtToGuard :: Stmt l -> Guard
hsStmtToGuard (Exts.Generator l
_ Pat l
p Exp l
e) = [Stmt] -> Guard
TH.PatG [Pat -> Exp -> Stmt
TH.BindS (Pat l -> Pat
forall a. ToPat a => a -> Pat
toPat Pat l
p) (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)]
hsStmtToGuard (Exts.Qualifier l
_ Exp l
e) = Exp -> Guard
TH.NormalG (Exp l -> Exp
forall a. ToExp a => a -> Exp
toExp Exp l
e)
hsStmtToGuard (Exts.LetStmt l
_ Binds l
bs) = [Stmt] -> Guard
TH.PatG [[Dec] -> Stmt
TH.LetS (Binds l -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Binds l
bs)]
hsStmtToGuard Stmt l
h = String -> Stmt l -> Guard
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"hsStmtToGuard" Stmt l
h
instance ToDecs (Exts.InstDecl l) where
toDecs :: InstDecl l -> [Dec]
toDecs (Exts.InsDecl l
_ Decl l
decl) = Decl l -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs Decl l
decl
toDecs InstDecl l
d = String -> InstDecl l -> [Dec]
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"toDec" InstDecl l
d
instance ToDecs (Exts.Decl l) where
toDecs :: Decl l -> [Dec]
toDecs _a :: Decl l
_a@(Exts.TypeSig l
_ [Name l]
ns Type l
t)
= let xs :: [Dec]
xs = (Name l -> Dec) -> [Name l] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Type -> Dec) -> Type -> Name -> Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Type -> Dec
TH.SigD (Type l -> Type
forall a. ToType a => a -> Type
toType Type l
t) (Name -> Dec) -> (Name l -> Name) -> Name l -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name l -> Name
forall a. ToName a => a -> Name
toName) [Name l]
ns
in [Dec]
xs
toDecs (Exts.InfixDecl l
l Assoc l
assoc Maybe Int
Nothing [Op l]
ops) =
Decl l -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs (l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
forall l. l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
Exts.InfixDecl l
l Assoc l
assoc (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
9) [Op l]
ops)
toDecs (Exts.InfixDecl l
_ Assoc l
assoc (Just Int
fixity) [Op l]
ops) =
(Op l -> Dec) -> [Op l] -> [Dec]
forall a b. (a -> b) -> [a] -> [b]
map (\Op l
op -> Fixity -> Name -> Dec
TH.InfixD (Int -> FixityDirection -> Fixity
TH.Fixity Int
fixity FixityDirection
dir) (Op l -> Name
forall a. ToName a => a -> Name
toName Op l
op)) [Op l]
ops
where
dir :: FixityDirection
dir = case Assoc l
assoc of
Exts.AssocNone l
_ -> FixityDirection
TH.InfixN
Exts.AssocLeft l
_ -> FixityDirection
TH.InfixL
Exts.AssocRight l
_ -> FixityDirection
TH.InfixR
toDecs Decl l
a = [Decl l -> Dec
forall a. ToDec a => a -> Dec
toDec Decl l
a]
instance ToDecs a => ToDecs [a] where
toDecs :: [a] -> [Dec]
toDecs [a]
a = (a -> [Dec]) -> [a] -> [Dec]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs [a]
a