{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.ThToHs
( convertToHsExpr
, convertToPat
, convertToHsDecls
, convertToHsType
, thRdrNameGuesses
)
where
import GHC.Prelude hiding (init, last, tail)
import GHC.Hs as Hs
import GHC.Tc.Errors.Types
import GHC.Types.Name.Reader
import qualified GHC.Types.Name as Name
import GHC.Unit.Module
import GHC.Parser.PostProcess
import GHC.Types.Name.Occurrence as OccName
import GHC.Types.SrcLoc
import GHC.Core.Type as Hs
import qualified GHC.Core.Coercion as Coercion ( Role(..) )
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim( fUNTyCon )
import GHC.Types.Basic as Hs
import GHC.Types.Fixity as Hs
import GHC.Types.ForeignCall
import GHC.Types.Unique
import GHC.Types.SourceText
import GHC.Data.Bag
import GHC.Utils.Lexeme
import GHC.Utils.Misc
import GHC.Data.FastString
import GHC.Utils.Panic
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import qualified Data.ByteString as BS
import Control.Monad( unless, ap )
import Control.Applicative( (<|>) )
import Data.Bifunctor (first)
import Data.Foldable (for_)
import Data.List.NonEmpty( NonEmpty (..), nonEmpty )
import qualified Data.List.NonEmpty as NE
import Data.Maybe( catMaybes, isNothing )
import Data.Word (Word64)
import Language.Haskell.TH as TH hiding (sigP)
import Language.Haskell.TH.Syntax as TH
import Foreign.ForeignPtr
import Foreign.Ptr
import System.IO.Unsafe
convertToHsDecls :: Origin -> SrcSpan -> [TH.Dec] -> Either RunSpliceFailReason [LHsDecl GhcPs]
convertToHsDecls :: Origin
-> SrcSpan -> [Dec] -> Either RunSpliceFailReason [LHsDecl GhcPs]
convertToHsDecls Origin
origin SrcSpan
loc [Dec]
ds =
Origin
-> SrcSpan
-> CvtM' RunSpliceFailReason [LHsDecl GhcPs]
-> Either RunSpliceFailReason [LHsDecl GhcPs]
forall err a. Origin -> SrcSpan -> CvtM' err a -> Either err a
initCvt Origin
origin SrcSpan
loc (CvtM' RunSpliceFailReason [LHsDecl GhcPs]
-> Either RunSpliceFailReason [LHsDecl GhcPs])
-> CvtM' RunSpliceFailReason [LHsDecl GhcPs]
-> Either RunSpliceFailReason [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ ([Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> CvtM'
RunSpliceFailReason [Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> CvtM'
RunSpliceFailReason [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b.
(a -> b)
-> CvtM' RunSpliceFailReason a -> CvtM' RunSpliceFailReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [Maybe a] -> [a]
catMaybes ((Dec
-> CvtM'
RunSpliceFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> [Dec]
-> CvtM'
RunSpliceFailReason [Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Dec
-> CvtM'
RunSpliceFailReason (Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
cvt_dec [Dec]
ds)
where
cvt_dec :: Dec -> CvtM' RunSpliceFailReason (Maybe (LHsDecl GhcPs))
cvt_dec Dec
d =
ThingBeingConverted
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
-> CvtM' RunSpliceFailReason (Maybe (LHsDecl GhcPs))
forall a.
ThingBeingConverted
-> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
wrapMsg (Dec -> ThingBeingConverted
ConvDec Dec
d) (CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
-> CvtM' RunSpliceFailReason (Maybe (LHsDecl GhcPs)))
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
-> CvtM' RunSpliceFailReason (Maybe (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Dec -> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtDec Dec
d
convertToHsExpr :: Origin -> SrcSpan -> TH.Exp -> Either RunSpliceFailReason (LHsExpr GhcPs)
convertToHsExpr :: Origin
-> SrcSpan -> Exp -> Either RunSpliceFailReason (LHsExpr GhcPs)
convertToHsExpr Origin
origin SrcSpan
loc Exp
e
= Origin
-> SrcSpan
-> CvtM' RunSpliceFailReason (LHsExpr GhcPs)
-> Either RunSpliceFailReason (LHsExpr GhcPs)
forall err a. Origin -> SrcSpan -> CvtM' err a -> Either err a
initCvt Origin
origin SrcSpan
loc (CvtM' RunSpliceFailReason (LHsExpr GhcPs)
-> Either RunSpliceFailReason (LHsExpr GhcPs))
-> CvtM' RunSpliceFailReason (LHsExpr GhcPs)
-> Either RunSpliceFailReason (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ThingBeingConverted
-> CvtM' ConversionFailReason (LHsExpr GhcPs)
-> CvtM' RunSpliceFailReason (LHsExpr GhcPs)
forall a.
ThingBeingConverted
-> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
wrapMsg (Exp -> ThingBeingConverted
ConvExp Exp
e) (CvtM' ConversionFailReason (LHsExpr GhcPs)
-> CvtM' RunSpliceFailReason (LHsExpr GhcPs))
-> CvtM' ConversionFailReason (LHsExpr GhcPs)
-> CvtM' RunSpliceFailReason (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
convertToPat :: Origin -> SrcSpan -> TH.Pat -> Either RunSpliceFailReason (LPat GhcPs)
convertToPat :: Origin -> SrcSpan -> Pat -> Either RunSpliceFailReason (LPat GhcPs)
convertToPat Origin
origin SrcSpan
loc Pat
p
= Origin
-> SrcSpan
-> CvtM' RunSpliceFailReason (LPat GhcPs)
-> Either RunSpliceFailReason (LPat GhcPs)
forall err a. Origin -> SrcSpan -> CvtM' err a -> Either err a
initCvt Origin
origin SrcSpan
loc (CvtM' RunSpliceFailReason (LPat GhcPs)
-> Either RunSpliceFailReason (LPat GhcPs))
-> CvtM' RunSpliceFailReason (LPat GhcPs)
-> Either RunSpliceFailReason (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$ ThingBeingConverted
-> CvtM' ConversionFailReason (LPat GhcPs)
-> CvtM' RunSpliceFailReason (LPat GhcPs)
forall a.
ThingBeingConverted
-> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
wrapMsg (Pat -> ThingBeingConverted
ConvPat Pat
p) (CvtM' ConversionFailReason (LPat GhcPs)
-> CvtM' RunSpliceFailReason (LPat GhcPs))
-> CvtM' ConversionFailReason (LPat GhcPs)
-> CvtM' RunSpliceFailReason (LPat GhcPs)
forall a b. (a -> b) -> a -> b
$ Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p
convertToHsType :: Origin -> SrcSpan -> TH.Type -> Either RunSpliceFailReason (LHsType GhcPs)
convertToHsType :: Origin
-> SrcSpan -> Type -> Either RunSpliceFailReason (LHsType GhcPs)
convertToHsType Origin
origin SrcSpan
loc Type
t
= Origin
-> SrcSpan
-> CvtM' RunSpliceFailReason (LHsType GhcPs)
-> Either RunSpliceFailReason (LHsType GhcPs)
forall err a. Origin -> SrcSpan -> CvtM' err a -> Either err a
initCvt Origin
origin SrcSpan
loc (CvtM' RunSpliceFailReason (LHsType GhcPs)
-> Either RunSpliceFailReason (LHsType GhcPs))
-> CvtM' RunSpliceFailReason (LHsType GhcPs)
-> Either RunSpliceFailReason (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ ThingBeingConverted
-> CvtM' ConversionFailReason (LHsType GhcPs)
-> CvtM' RunSpliceFailReason (LHsType GhcPs)
forall a.
ThingBeingConverted
-> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
wrapMsg (Type -> ThingBeingConverted
ConvType Type
t) (CvtM' ConversionFailReason (LHsType GhcPs)
-> CvtM' RunSpliceFailReason (LHsType GhcPs))
-> CvtM' ConversionFailReason (LHsType GhcPs)
-> CvtM' RunSpliceFailReason (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t
newtype CvtM' err a = CvtM { forall err a.
CvtM' err a -> Origin -> SrcSpan -> Either err (SrcSpan, a)
unCvtM :: Origin -> SrcSpan -> Either err (SrcSpan, a) }
deriving ((forall a b. (a -> b) -> CvtM' err a -> CvtM' err b)
-> (forall a b. a -> CvtM' err b -> CvtM' err a)
-> Functor (CvtM' err)
forall a b. a -> CvtM' err b -> CvtM' err a
forall a b. (a -> b) -> CvtM' err a -> CvtM' err b
forall err a b. a -> CvtM' err b -> CvtM' err a
forall err a b. (a -> b) -> CvtM' err a -> CvtM' err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall err a b. (a -> b) -> CvtM' err a -> CvtM' err b
fmap :: forall a b. (a -> b) -> CvtM' err a -> CvtM' err b
$c<$ :: forall err a b. a -> CvtM' err b -> CvtM' err a
<$ :: forall a b. a -> CvtM' err b -> CvtM' err a
Functor)
type CvtM = CvtM' ConversionFailReason
instance Applicative (CvtM' err) where
pure :: forall a. a -> CvtM' err a
pure a
x = (Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM ((Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a)
-> (Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
forall a b. (a -> b) -> a -> b
$ \Origin
_ SrcSpan
loc -> (SrcSpan, a) -> Either err (SrcSpan, a)
forall a b. b -> Either a b
Right (SrcSpan
loc,a
x)
<*> :: forall a b. CvtM' err (a -> b) -> CvtM' err a -> CvtM' err b
(<*>) = CvtM' err (a -> b) -> CvtM' err a -> CvtM' err b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (CvtM' err) where
(CvtM Origin -> SrcSpan -> Either err (SrcSpan, a)
m) >>= :: forall a b. CvtM' err a -> (a -> CvtM' err b) -> CvtM' err b
>>= a -> CvtM' err b
k = (Origin -> SrcSpan -> Either err (SrcSpan, b)) -> CvtM' err b
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM ((Origin -> SrcSpan -> Either err (SrcSpan, b)) -> CvtM' err b)
-> (Origin -> SrcSpan -> Either err (SrcSpan, b)) -> CvtM' err b
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either err (SrcSpan, a)
m Origin
origin SrcSpan
loc of
Left err
err -> err -> Either err (SrcSpan, b)
forall a b. a -> Either a b
Left err
err
Right (SrcSpan
loc',a
v) -> CvtM' err b -> Origin -> SrcSpan -> Either err (SrcSpan, b)
forall err a.
CvtM' err a -> Origin -> SrcSpan -> Either err (SrcSpan, a)
unCvtM (a -> CvtM' err b
k a
v) Origin
origin SrcSpan
loc'
mapCvtMError :: (err1 -> err2) -> CvtM' err1 a -> CvtM' err2 a
mapCvtMError :: forall err1 err2 a. (err1 -> err2) -> CvtM' err1 a -> CvtM' err2 a
mapCvtMError err1 -> err2
f (CvtM Origin -> SrcSpan -> Either err1 (SrcSpan, a)
m) = (Origin -> SrcSpan -> Either err2 (SrcSpan, a)) -> CvtM' err2 a
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM ((Origin -> SrcSpan -> Either err2 (SrcSpan, a)) -> CvtM' err2 a)
-> (Origin -> SrcSpan -> Either err2 (SrcSpan, a)) -> CvtM' err2 a
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> (err1 -> err2)
-> Either err1 (SrcSpan, a) -> Either err2 (SrcSpan, a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first err1 -> err2
f (Either err1 (SrcSpan, a) -> Either err2 (SrcSpan, a))
-> Either err1 (SrcSpan, a) -> Either err2 (SrcSpan, a)
forall a b. (a -> b) -> a -> b
$ Origin -> SrcSpan -> Either err1 (SrcSpan, a)
m Origin
origin SrcSpan
loc
initCvt :: Origin -> SrcSpan -> CvtM' err a -> Either err a
initCvt :: forall err a. Origin -> SrcSpan -> CvtM' err a -> Either err a
initCvt Origin
origin SrcSpan
loc (CvtM Origin -> SrcSpan -> Either err (SrcSpan, a)
m) = ((SrcSpan, a) -> a) -> Either err (SrcSpan, a) -> Either err a
forall a b. (a -> b) -> Either err a -> Either err b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan, a) -> a
forall a b. (a, b) -> b
snd (Origin -> SrcSpan -> Either err (SrcSpan, a)
m Origin
origin SrcSpan
loc)
force :: a -> CvtM ()
force :: forall a. a -> CvtM ()
force a
a = a
a a -> CvtM () -> CvtM ()
forall a b. a -> b -> b
`seq` () -> CvtM ()
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
failWith :: ConversionFailReason -> CvtM a
failWith :: forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
m = (Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a))
-> CvtM' ConversionFailReason a
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM (\Origin
_ SrcSpan
_ -> ConversionFailReason -> Either ConversionFailReason (SrcSpan, a)
forall a b. a -> Either a b
Left ConversionFailReason
m)
getOrigin :: CvtM Origin
getOrigin :: CvtM Origin
getOrigin = (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, Origin))
-> CvtM Origin
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM (\Origin
origin SrcSpan
loc -> (SrcSpan, Origin) -> Either ConversionFailReason (SrcSpan, Origin)
forall a b. b -> Either a b
Right (SrcSpan
loc,Origin
origin))
getL :: CvtM SrcSpan
getL :: CvtM SrcSpan
getL = (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, SrcSpan))
-> CvtM SrcSpan
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM (\Origin
_ SrcSpan
loc -> (SrcSpan, SrcSpan)
-> Either ConversionFailReason (SrcSpan, SrcSpan)
forall a b. b -> Either a b
Right (SrcSpan
loc,SrcSpan
loc))
setL :: SrcSpan -> CvtM ()
setL :: SrcSpan -> CvtM ()
setL SrcSpan
loc = (Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, ()))
-> CvtM ()
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM (\Origin
_ SrcSpan
_ -> (SrcSpan, ()) -> Either ConversionFailReason (SrcSpan, ())
forall a b. b -> Either a b
Right (SrcSpan
loc, ()))
returnLA :: e -> CvtM (LocatedAn ann e)
returnLA :: forall e ann. e -> CvtM (LocatedAn ann e)
returnLA e
x = (Origin
-> SrcSpan
-> Either ConversionFailReason (SrcSpan, LocatedAn ann e))
-> CvtM' ConversionFailReason (LocatedAn ann e)
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM (\Origin
_ SrcSpan
loc -> (SrcSpan, LocatedAn ann e)
-> Either ConversionFailReason (SrcSpan, LocatedAn ann e)
forall a b. b -> Either a b
Right (SrcSpan
loc, SrcAnn ann -> e -> LocatedAn ann e
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) e
x))
returnJustLA :: a -> CvtM (Maybe (LocatedA a))
returnJustLA :: forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA = (LocatedA a -> Maybe (LocatedA a))
-> CvtM' ConversionFailReason (LocatedA a)
-> CvtM' ConversionFailReason (Maybe (LocatedA a))
forall a b.
(a -> b)
-> CvtM' ConversionFailReason a -> CvtM' ConversionFailReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocatedA a -> Maybe (LocatedA a)
forall a. a -> Maybe a
Just (CvtM' ConversionFailReason (LocatedA a)
-> CvtM' ConversionFailReason (Maybe (LocatedA a)))
-> (a -> CvtM' ConversionFailReason (LocatedA a))
-> a
-> CvtM' ConversionFailReason (Maybe (LocatedA a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CvtM' ConversionFailReason (LocatedA a)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA
wrapParLA :: (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA :: forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LocatedAn ann a -> b
add_par a
x = (Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, b))
-> CvtM' ConversionFailReason b
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM (\Origin
_ SrcSpan
loc -> (SrcSpan, b) -> Either ConversionFailReason (SrcSpan, b)
forall a b. b -> Either a b
Right (SrcSpan
loc, LocatedAn ann a -> b
add_par (SrcAnn ann -> a -> LocatedAn ann a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) a
x)))
wrapMsg :: ThingBeingConverted -> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
wrapMsg :: forall a.
ThingBeingConverted
-> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
wrapMsg ThingBeingConverted
what = (ConversionFailReason -> RunSpliceFailReason)
-> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a
forall err1 err2 a. (err1 -> err2) -> CvtM' err1 a -> CvtM' err2 a
mapCvtMError (ThingBeingConverted -> ConversionFailReason -> RunSpliceFailReason
ConversionFail ThingBeingConverted
what)
wrapL :: CvtM a -> CvtM (Located a)
wrapL :: forall a. CvtM a -> CvtM (Located a)
wrapL (CvtM Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a)
m) = (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, Located a))
-> CvtM' ConversionFailReason (Located a)
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM ((Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, Located a))
-> CvtM' ConversionFailReason (Located a))
-> (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, Located a))
-> CvtM' ConversionFailReason (Located a)
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a)
m Origin
origin SrcSpan
loc of
Left ConversionFailReason
err -> ConversionFailReason
-> Either ConversionFailReason (SrcSpan, Located a)
forall a b. a -> Either a b
Left ConversionFailReason
err
Right (SrcSpan
loc', a
v) -> (SrcSpan, Located a)
-> Either ConversionFailReason (SrcSpan, Located a)
forall a b. b -> Either a b
Right (SrcSpan
loc', SrcSpan -> a -> Located a
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc a
v)
wrapLN :: CvtM a -> CvtM (LocatedN a)
wrapLN :: forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (CvtM Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a)
m) = (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, LocatedN a))
-> CvtM' ConversionFailReason (LocatedN a)
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM ((Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, LocatedN a))
-> CvtM' ConversionFailReason (LocatedN a))
-> (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, LocatedN a))
-> CvtM' ConversionFailReason (LocatedN a)
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a)
m Origin
origin SrcSpan
loc of
Left ConversionFailReason
err -> ConversionFailReason
-> Either ConversionFailReason (SrcSpan, LocatedN a)
forall a b. a -> Either a b
Left ConversionFailReason
err
Right (SrcSpan
loc', a
v) -> (SrcSpan, LocatedN a)
-> Either ConversionFailReason (SrcSpan, LocatedN a)
forall a b. b -> Either a b
Right (SrcSpan
loc', SrcSpanAnnN -> a -> LocatedN a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) a
v)
wrapLA :: CvtM a -> CvtM (LocatedA a)
wrapLA :: forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (CvtM Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a)
m) = (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, LocatedA a))
-> CvtM' ConversionFailReason (LocatedA a)
forall err a.
(Origin -> SrcSpan -> Either err (SrcSpan, a)) -> CvtM' err a
CvtM ((Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, LocatedA a))
-> CvtM' ConversionFailReason (LocatedA a))
-> (Origin
-> SrcSpan -> Either ConversionFailReason (SrcSpan, LocatedA a))
-> CvtM' ConversionFailReason (LocatedA a)
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either ConversionFailReason (SrcSpan, a)
m Origin
origin SrcSpan
loc of
Left ConversionFailReason
err -> ConversionFailReason
-> Either ConversionFailReason (SrcSpan, LocatedA a)
forall a b. a -> Either a b
Left ConversionFailReason
err
Right (SrcSpan
loc', a
v) -> (SrcSpan, LocatedA a)
-> Either ConversionFailReason (SrcSpan, LocatedA a)
forall a b. b -> Either a b
Right (SrcSpan
loc', SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) a
v)
cvtDecs :: [TH.Dec] -> CvtM [LHsDecl GhcPs]
cvtDecs :: [Dec] -> CvtM [LHsDecl GhcPs]
cvtDecs = ([Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> CvtM'
ConversionFailReason
[Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b.
(a -> b)
-> CvtM' ConversionFailReason a -> CvtM' ConversionFailReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [Maybe a] -> [a]
catMaybes (CvtM'
ConversionFailReason
[Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([Dec]
-> CvtM'
ConversionFailReason
[Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))])
-> [Dec]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dec
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> [Dec]
-> CvtM'
ConversionFailReason
[Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Dec -> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
Dec
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
cvtDec
cvtDec :: TH.Dec -> CvtM (Maybe (LHsDecl GhcPs))
cvtDec :: Dec -> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtDec (TH.ValD Pat
pat Body
body [Dec]
ds)
| TH.VarP Name
s <- Pat
pat
= do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
s
; GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
cl' <- HsMatchContext GhcPs
-> Clause -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtClause (LIdP (NoGhcTc GhcPs) -> HsMatchContext GhcPs
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc GhcPs)
LocatedN RdrName
s') ([Pat] -> Body -> [Dec] -> Clause
Clause [] Body
body [Dec]
ds)
; Origin
th_origin <- CvtM Origin
getOrigin
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD GhcPs
NoExtField
noExtField (HsBind GhcPs -> HsDecl GhcPs) -> HsBind GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ Origin
-> LocatedN RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
mkFunBind Origin
th_origin LocatedN RdrName
s' [LMatch GhcPs (LHsExpr GhcPs)
GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
cl'] }
| Bool
otherwise
= do { GenLocated SrcSpanAnnA (Pat GhcPs)
pat' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
pat
; [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
body' <- Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard Body
body
; HsLocalBinds GhcPs
ds' <- THDeclDescriptor -> [Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs THDeclDescriptor
WhereClause [Dec]
ds
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD GhcPs
NoExtField
noExtField (HsBind GhcPs -> HsDecl GhcPs) -> HsBind GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
PatBind { pat_lhs :: LPat GhcPs
pat_lhs = LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat'
, pat_rhs :: GRHSs GhcPs (LHsExpr GhcPs)
pat_rhs = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
emptyComments [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
body' HsLocalBinds GhcPs
ds'
, pat_ext :: XPatBind GhcPs GhcPs
pat_ext = XPatBind GhcPs GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
} }
cvtDec (TH.FunD Name
nm [Clause]
cls)
| [Clause] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Clause]
cls
= ConversionFailReason
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs)))
-> ConversionFailReason
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Name -> ConversionFailReason
FunBindLacksEquations Name
nm
| Bool
otherwise
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
cls' <- (Clause
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Clause]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext GhcPs
-> Clause -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtClause (LIdP (NoGhcTc GhcPs) -> HsMatchContext GhcPs
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc GhcPs)
LocatedN RdrName
nm')) [Clause]
cls
; Origin
th_origin <- CvtM Origin
getOrigin
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD GhcPs
NoExtField
noExtField (HsBind GhcPs -> HsDecl GhcPs) -> HsBind GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ Origin
-> LocatedN RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
mkFunBind Origin
th_origin LocatedN RdrName
nm' [LMatch GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
cls' }
cvtDec (TH.SigD Name
nm Type
typ)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
typ
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField
(XTypeSig GhcPs -> [LIdP GhcPs] -> LHsSigWcType GhcPs -> Sig GhcPs
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
EpAnn AnnSig
forall a. EpAnn a
noAnn [LIdP GhcPs
LocatedN RdrName
nm'] (GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty')) }
cvtDec (TH.KiSigD Name
nm Type
ki)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ki' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigKind Type
ki
; let sig' :: StandaloneKindSig GhcPs
sig' = XStandaloneKindSig GhcPs
-> LIdP GhcPs -> LHsSigType GhcPs -> StandaloneKindSig GhcPs
forall pass.
XStandaloneKindSig pass
-> LIdP pass -> LHsSigType pass -> StandaloneKindSig pass
StandaloneKindSig XStandaloneKindSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
nm' LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ki'
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XKindSigD GhcPs -> StandaloneKindSig GhcPs -> HsDecl GhcPs
forall p. XKindSigD p -> StandaloneKindSig p -> HsDecl p
Hs.KindSigD XKindSigD GhcPs
NoExtField
noExtField StandaloneKindSig GhcPs
sig' }
cvtDec (TH.InfixD Fixity
fx Name
nm)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vcNameN Name
nm
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField (XFixSig GhcPs -> FixitySig GhcPs -> Sig GhcPs
forall pass. XFixSig pass -> FixitySig pass -> Sig pass
FixSig XFixSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
(XFixitySig GhcPs -> [LIdP GhcPs] -> Fixity -> FixitySig GhcPs
forall pass.
XFixitySig pass -> [LIdP pass] -> Fixity -> FixitySig pass
FixitySig XFixitySig GhcPs
NoExtField
noExtField [LIdP GhcPs
LocatedN RdrName
nm'] (Fixity -> Fixity
cvtFixity Fixity
fx)))) }
cvtDec (TH.DefaultD [Type]
tys)
= do { [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys' <- (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [Type]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtType [Type]
tys
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (XDefD GhcPs -> DefaultDecl GhcPs -> HsDecl GhcPs
forall p. XDefD p -> DefaultDecl p -> HsDecl p
Hs.DefD XDefD GhcPs
NoExtField
noExtField (DefaultDecl GhcPs -> HsDecl GhcPs)
-> DefaultDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XCDefaultDecl GhcPs -> [LHsType GhcPs] -> DefaultDecl GhcPs
forall pass.
XCDefaultDecl pass -> [LHsType pass] -> DefaultDecl pass
DefaultDecl XCDefaultDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys') }
cvtDec (PragmaD Pragma
prag)
= Pragma -> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtPragmaD Pragma
prag
cvtDec (TySynD Name
tc [TyVarBndr BndrVis]
tvs Type
rhs)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
_, LocatedN RdrName
tc', LHsQTyVars GhcPs
tvs') <- [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [] Name
tc [TyVarBndr BndrVis]
tvs
; GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
rhs
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
SynDecl { tcdSExt :: XSynDecl GhcPs
tcdSExt = XSynDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, tcdLName :: LIdP GhcPs
tcdLName = LIdP GhcPs
LocatedN RdrName
tc', tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tvs'
, tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
, tcdRhs :: LHsType GhcPs
tcdRhs = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' } }
cvtDec (DataD [Type]
ctxt Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs [DerivClause]
derivs)
= [Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtDataDec [Type]
ctxt Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs [DerivClause]
derivs
cvtDec (NewtypeD [Type]
ctxt Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig Con
constr [DerivClause]
derivs)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt', LocatedN RdrName
tc', LHsQTyVars GhcPs
tvs') <- [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [Type]
ctxt Name
tc [TyVarBndr BndrVis]
tvs
; Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtKind (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Maybe Type
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
con' <- Bool
-> Maybe Type
-> DataDefnCons Con
-> CvtM (DataDefnCons (LConDecl GhcPs))
cvtDataDefnCons Bool
False Maybe Type
ksig (DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Con -> DataDefnCons Con
forall a. a -> DataDefnCons a
NewTypeCon Con
constr
; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' <- [DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs [DerivClause]
derivs
; let defn :: HsDataDefn GhcPs
defn = HsDataDefn { dd_ext :: XCHsDataDefn GhcPs
dd_ext = XCHsDataDefn GhcPs
NoExtField
noExtField
, dd_cType :: Maybe (XRec GhcPs CType)
dd_cType = Maybe (XRec GhcPs CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
, dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ctxt = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'
, dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig = Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig'
, dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_cons = DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
con'
, dd_derivs :: HsDeriving GhcPs
dd_derivs = HsDeriving GhcPs
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' }
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
DataDecl { tcdDExt :: XDataDecl GhcPs
tcdDExt = XDataDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, tcdLName :: LIdP GhcPs
tcdLName = LIdP GhcPs
LocatedN RdrName
tc', tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tvs'
, tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
, tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn = HsDataDefn GhcPs
defn } }
cvtDec (TypeDataD Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs)
= Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtTypeDataDec Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs
cvtDec (ClassD [Type]
ctxt Name
cl [TyVarBndr BndrVis]
tvs [FunDep]
fds [Dec]
decs)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt', LocatedN RdrName
tc', LHsQTyVars GhcPs
tvs') <- [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [Type]
ctxt Name
cl [TyVarBndr BndrVis]
tvs
; [GenLocated SrcSpanAnnA (FunDep GhcPs)]
fds' <- (FunDep
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (FunDep GhcPs)))
-> [FunDep]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (FunDep GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FunDep -> CvtM (LHsFunDep GhcPs)
FunDep
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (FunDep GhcPs))
cvt_fundep [FunDep]
fds
; (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
binds', [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs', [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fams', [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
at_defs', [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts') <- THDeclDescriptor
-> [Dec]
-> CvtM
(LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs])
cvt_ci_decs THDeclDescriptor
ClssDecl [Dec]
decs
; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts')
(ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason -> CvtM ())
-> ConversionFailReason -> CvtM ()
forall a b. (a -> b) -> a -> b
$ [LDataFamInstDecl GhcPs] -> ConversionFailReason
DefaultDataInstDecl [LDataFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts')
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
ClassDecl { tcdCExt :: XClassDecl GhcPs
tcdCExt = (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, AnnSortKey
NoAnnSortKey), tcdLayout :: LayoutInfo GhcPs
tcdLayout = LayoutInfo GhcPs
forall pass. LayoutInfo pass
NoLayoutInfo
, tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt', tcdLName :: LIdP GhcPs
tcdLName = LIdP GhcPs
LocatedN RdrName
tc', tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tvs'
, tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
, tcdFDs :: [LHsFunDep GhcPs]
tcdFDs = [LHsFunDep GhcPs]
[GenLocated SrcSpanAnnA (FunDep GhcPs)]
fds', tcdSigs :: [LSig GhcPs]
tcdSigs = [LSig GhcPs] -> [LSig GhcPs]
Hs.mkClassOpSigs [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs'
, tcdMeths :: LHsBinds GhcPs
tcdMeths = LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
binds'
, tcdATs :: [LFamilyDecl GhcPs]
tcdATs = [LFamilyDecl GhcPs]
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fams', tcdATDefs :: [LTyFamInstDecl GhcPs]
tcdATDefs = [LTyFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
at_defs', tcdDocs :: [LDocDecl GhcPs]
tcdDocs = [] }
}
cvtDec (InstanceD Maybe Overlap
o [Type]
ctxt Type
ty [Dec]
decs)
= do { (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
binds', [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs', [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fams', [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
ats', [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts') <- THDeclDescriptor
-> [Dec]
-> CvtM
(LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs])
cvt_ci_decs THDeclDescriptor
InstanceDecl [Dec]
decs
; Maybe (NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs)))
-> (NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fams') ((NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ())
-> (NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ()
forall a b. (a -> b) -> a -> b
$ \ NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
bad_fams ->
ConversionFailReason -> CvtM' ConversionFailReason Any
forall a. ConversionFailReason -> CvtM a
failWith (THDeclDescriptor -> IllegalDecls -> ConversionFailReason
IllegalDeclaration THDeclDescriptor
InstanceDecl (IllegalDecls -> ConversionFailReason)
-> IllegalDecls -> ConversionFailReason
forall a b. (a -> b) -> a -> b
$ NonEmpty (LFamilyDecl GhcPs) -> IllegalDecls
IllegalFamDecls NonEmpty (LFamilyDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
bad_fams)
; GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' <- PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
funPrec [Type]
ctxt
; (L SrcSpanAnnA
loc HsType GhcPs
ty') <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; let inst_ty' :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
inst_ty' = SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType (LHsType GhcPs -> HsSigType GhcPs)
-> LHsType GhcPs -> HsSigType GhcPs
forall a b. (a -> b) -> a -> b
$
[Type]
-> SrcSpanAnnA
-> LHsContext GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
mkHsQualTy [Type]
ctxt SrcSpanAnnA
loc LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsType GhcPs
ty'
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
NoExtField
noExtField (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XClsInstD GhcPs -> ClsInstDecl GhcPs -> InstDecl GhcPs
forall pass. XClsInstD pass -> ClsInstDecl pass -> InstDecl pass
ClsInstD XClsInstD GhcPs
NoExtField
noExtField (ClsInstDecl GhcPs -> InstDecl GhcPs)
-> ClsInstDecl GhcPs -> InstDecl GhcPs
forall a b. (a -> b) -> a -> b
$
ClsInstDecl { cid_ext :: XCClsInstDecl GhcPs
cid_ext = (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, AnnSortKey
NoAnnSortKey), cid_poly_ty :: LHsSigType GhcPs
cid_poly_ty = LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
inst_ty'
, cid_binds :: LHsBinds GhcPs
cid_binds = LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
binds'
, cid_sigs :: [LSig GhcPs]
cid_sigs = [LSig GhcPs] -> [LSig GhcPs]
Hs.mkClassOpSigs [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs'
, cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_tyfam_insts = [LTyFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
ats', cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_datafam_insts = [LDataFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts'
, cid_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
cid_overlap_mode
= (Overlap -> GenLocated SrcSpanAnnP OverlapMode)
-> Maybe Overlap -> Maybe (GenLocated SrcSpanAnnP OverlapMode)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpanAnnP -> OverlapMode -> GenLocated SrcSpanAnnP OverlapMode
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnP
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
loc) (OverlapMode -> GenLocated SrcSpanAnnP OverlapMode)
-> (Overlap -> OverlapMode)
-> Overlap
-> GenLocated SrcSpanAnnP OverlapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlap -> OverlapMode
overlap) Maybe Overlap
o } }
where
overlap :: Overlap -> OverlapMode
overlap Overlap
pragma =
case Overlap
pragma of
Overlap
TH.Overlaps -> SourceText -> OverlapMode
Hs.Overlaps (FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"OVERLAPS")
Overlap
TH.Overlappable -> SourceText -> OverlapMode
Hs.Overlappable (FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"OVERLAPPABLE")
Overlap
TH.Overlapping -> SourceText -> OverlapMode
Hs.Overlapping (FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"OVERLAPPING")
Overlap
TH.Incoherent -> SourceText -> OverlapMode
Hs.Incoherent (FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"INCOHERENT")
cvtDec (ForeignD Foreign
ford)
= do { ForeignDecl GhcPs
ford' <- Foreign -> CvtM (ForeignDecl GhcPs)
cvtForD Foreign
ford
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD XForD GhcPs
NoExtField
noExtField ForeignDecl GhcPs
ford' }
cvtDec (DataFamilyD Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
kind)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
_, LocatedN RdrName
tc', LHsQTyVars GhcPs
tvs') <- [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [] Name
tc [TyVarBndr BndrVis]
tvs
; GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result <- Maybe Type -> CvtM (LFamilyResultSig GhcPs)
cvtMaybeKindToFamilyResultSig Maybe Type
kind
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XFamDecl GhcPs -> FamilyDecl GhcPs -> TyClDecl GhcPs
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl GhcPs
NoExtField
noExtField (FamilyDecl GhcPs -> TyClDecl GhcPs)
-> FamilyDecl GhcPs -> TyClDecl GhcPs
forall a b. (a -> b) -> a -> b
$
XCFamilyDecl GhcPs
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LIdP GhcPs
-> LHsQTyVars GhcPs
-> LexicalFixity
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> FamilyDecl GhcPs
forall pass.
XCFamilyDecl pass
-> FamilyInfo pass
-> TopLevelFlag
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> LFamilyResultSig pass
-> Maybe (LInjectivityAnn pass)
-> FamilyDecl pass
FamilyDecl XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn FamilyInfo GhcPs
forall pass. FamilyInfo pass
DataFamily TopLevelFlag
TopLevel LIdP GhcPs
LocatedN RdrName
tc' LHsQTyVars GhcPs
tvs' LexicalFixity
Prefix LFamilyResultSig GhcPs
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result Maybe (LInjectivityAnn GhcPs)
Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
forall a. Maybe a
Nothing }
cvtDec (DataInstD [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys Maybe Type
ksig [Con]
constrs [DerivClause]
derivs)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt', LocatedN RdrName
tc', HsOuterFamEqnTyVarBndrs GhcPs
bndrs', [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
typats') <- [Type]
-> Maybe [TyVarBndr ()]
-> Type
-> CvtM
(LHsContext GhcPs, LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
HsTyPats GhcPs)
cvt_datainst_hdr [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys
; Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtKind (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Maybe Type
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
cons' <- Bool
-> Maybe Type
-> DataDefnCons Con
-> CvtM (DataDefnCons (LConDecl GhcPs))
cvtDataDefnCons Bool
False Maybe Type
ksig (DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Bool -> [Con] -> DataDefnCons Con
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
False [Con]
constrs
; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' <- [DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs [DerivClause]
derivs
; let defn :: HsDataDefn GhcPs
defn = HsDataDefn { dd_ext :: XCHsDataDefn GhcPs
dd_ext = XCHsDataDefn GhcPs
NoExtField
noExtField
, dd_cType :: Maybe (XRec GhcPs CType)
dd_cType = Maybe (XRec GhcPs CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
, dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ctxt = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'
, dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig = Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig'
, dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_cons = DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
cons'
, dd_derivs :: HsDeriving GhcPs
dd_derivs = HsDeriving GhcPs
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' }
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
NoExtField
noExtField (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ DataFamInstD
{ dfid_ext :: XDataFamInstD GhcPs
dfid_ext = XDataFamInstD GhcPs
NoExtField
noExtField
, dfid_inst :: DataFamInstDecl GhcPs
dfid_inst = DataFamInstDecl { dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn =
FamEqn { feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext = XCFamEqn GhcPs (HsDataDefn GhcPs)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, feqn_tycon :: LIdP GhcPs
feqn_tycon = LIdP GhcPs
LocatedN RdrName
tc'
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
bndrs'
, feqn_pats :: HsTyPats GhcPs
feqn_pats = HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
typats'
, feqn_rhs :: HsDataDefn GhcPs
feqn_rhs = HsDataDefn GhcPs
defn
, feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Prefix } }}}
cvtDec (NewtypeInstD [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys Maybe Type
ksig Con
constr [DerivClause]
derivs)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt', LocatedN RdrName
tc', HsOuterFamEqnTyVarBndrs GhcPs
bndrs', [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
typats') <- [Type]
-> Maybe [TyVarBndr ()]
-> Type
-> CvtM
(LHsContext GhcPs, LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
HsTyPats GhcPs)
cvt_datainst_hdr [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys
; Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtKind (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Maybe Type
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
con' <- Bool
-> Maybe Type
-> DataDefnCons Con
-> CvtM (DataDefnCons (LConDecl GhcPs))
cvtDataDefnCons Bool
False Maybe Type
ksig (DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Con -> DataDefnCons Con
forall a. a -> DataDefnCons a
NewTypeCon Con
constr
; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' <- [DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs [DerivClause]
derivs
; let defn :: HsDataDefn GhcPs
defn = HsDataDefn { dd_ext :: XCHsDataDefn GhcPs
dd_ext = XCHsDataDefn GhcPs
NoExtField
noExtField
, dd_cType :: Maybe (XRec GhcPs CType)
dd_cType = Maybe (XRec GhcPs CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
, dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ctxt = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'
, dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig = Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig'
, dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_cons = DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
con'
, dd_derivs :: HsDeriving GhcPs
dd_derivs = HsDeriving GhcPs
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' }
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
NoExtField
noExtField (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ DataFamInstD
{ dfid_ext :: XDataFamInstD GhcPs
dfid_ext = XDataFamInstD GhcPs
NoExtField
noExtField
, dfid_inst :: DataFamInstDecl GhcPs
dfid_inst = DataFamInstDecl { dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn =
FamEqn { feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext = XCFamEqn GhcPs (HsDataDefn GhcPs)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, feqn_tycon :: LIdP GhcPs
feqn_tycon = LIdP GhcPs
LocatedN RdrName
tc'
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
bndrs'
, feqn_pats :: HsTyPats GhcPs
feqn_pats = HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
typats'
, feqn_rhs :: HsDataDefn GhcPs
feqn_rhs = HsDataDefn GhcPs
defn
, feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Prefix } }}}
cvtDec (TySynInstD TySynEqn
eqn)
= do { (L SrcSpanAnnA
_ FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
eqn') <- TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
cvtTySynEqn TySynEqn
eqn
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
NoExtField
noExtField (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ TyFamInstD
{ tfid_ext :: XTyFamInstD GhcPs
tfid_ext = XTyFamInstD GhcPs
NoExtField
noExtField
, tfid_inst :: TyFamInstDecl GhcPs
tfid_inst = TyFamInstDecl { tfid_xtn :: XCTyFamInstDecl GhcPs
tfid_xtn = XCTyFamInstDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, tfid_eqn :: TyFamInstEqn GhcPs
tfid_eqn = TyFamInstEqn GhcPs
FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
eqn' } }}
cvtDec (OpenTypeFamilyD TypeFamilyHead
head)
= do { (LocatedN RdrName
tc', LHsQTyVars GhcPs
tyvars', GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result', Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
injectivity') <- TypeFamilyHead
-> CvtM
(LocatedN RdrName, LHsQTyVars GhcPs, LFamilyResultSig GhcPs,
Maybe (LInjectivityAnn GhcPs))
cvt_tyfam_head TypeFamilyHead
head
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XFamDecl GhcPs -> FamilyDecl GhcPs -> TyClDecl GhcPs
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl GhcPs
NoExtField
noExtField (FamilyDecl GhcPs -> TyClDecl GhcPs)
-> FamilyDecl GhcPs -> TyClDecl GhcPs
forall a b. (a -> b) -> a -> b
$
XCFamilyDecl GhcPs
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LIdP GhcPs
-> LHsQTyVars GhcPs
-> LexicalFixity
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> FamilyDecl GhcPs
forall pass.
XCFamilyDecl pass
-> FamilyInfo pass
-> TopLevelFlag
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> LFamilyResultSig pass
-> Maybe (LInjectivityAnn pass)
-> FamilyDecl pass
FamilyDecl XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn FamilyInfo GhcPs
forall pass. FamilyInfo pass
OpenTypeFamily TopLevelFlag
TopLevel LIdP GhcPs
LocatedN RdrName
tc' LHsQTyVars GhcPs
tyvars' LexicalFixity
Prefix LFamilyResultSig GhcPs
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result' Maybe (LInjectivityAnn GhcPs)
Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
injectivity'
}
cvtDec (ClosedTypeFamilyD TypeFamilyHead
head [TySynEqn]
eqns)
= do { (LocatedN RdrName
tc', LHsQTyVars GhcPs
tyvars', GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result', Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
injectivity') <- TypeFamilyHead
-> CvtM
(LocatedN RdrName, LHsQTyVars GhcPs, LFamilyResultSig GhcPs,
Maybe (LInjectivityAnn GhcPs))
cvt_tyfam_head TypeFamilyHead
head
; [GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
eqns' <- (TySynEqn
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))))
-> [TySynEqn]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
TySynEqn
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
cvtTySynEqn [TySynEqn]
eqns
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XFamDecl GhcPs -> FamilyDecl GhcPs -> TyClDecl GhcPs
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl GhcPs
NoExtField
noExtField (FamilyDecl GhcPs -> TyClDecl GhcPs)
-> FamilyDecl GhcPs -> TyClDecl GhcPs
forall a b. (a -> b) -> a -> b
$
XCFamilyDecl GhcPs
-> FamilyInfo GhcPs
-> TopLevelFlag
-> LIdP GhcPs
-> LHsQTyVars GhcPs
-> LexicalFixity
-> LFamilyResultSig GhcPs
-> Maybe (LInjectivityAnn GhcPs)
-> FamilyDecl GhcPs
forall pass.
XCFamilyDecl pass
-> FamilyInfo pass
-> TopLevelFlag
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> LFamilyResultSig pass
-> Maybe (LInjectivityAnn pass)
-> FamilyDecl pass
FamilyDecl XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (Maybe [LTyFamInstEqn GhcPs] -> FamilyInfo GhcPs
forall pass. Maybe [LTyFamInstEqn pass] -> FamilyInfo pass
ClosedTypeFamily ([GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> Maybe
[GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a. a -> Maybe a
Just [GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
eqns')) TopLevelFlag
TopLevel LIdP GhcPs
LocatedN RdrName
tc' LHsQTyVars GhcPs
tyvars' LexicalFixity
Prefix
LFamilyResultSig GhcPs
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result' Maybe (LInjectivityAnn GhcPs)
Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
injectivity' }
cvtDec (TH.RoleAnnotD Name
tc [Role]
roles)
= do { LocatedN RdrName
tc' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
tc
; [LocatedAn NoEpAnns (Maybe Role)]
roles' <- (Role
-> CvtM' ConversionFailReason (LocatedAn NoEpAnns (Maybe Role)))
-> [Role]
-> CvtM' ConversionFailReason [LocatedAn NoEpAnns (Maybe Role)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Maybe Role
-> CvtM' ConversionFailReason (LocatedAn NoEpAnns (Maybe Role))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (Maybe Role
-> CvtM' ConversionFailReason (LocatedAn NoEpAnns (Maybe Role)))
-> (Role -> Maybe Role)
-> Role
-> CvtM' ConversionFailReason (LocatedAn NoEpAnns (Maybe Role))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> Maybe Role
cvtRole) [Role]
roles
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA
(HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XRoleAnnotD GhcPs -> RoleAnnotDecl GhcPs -> HsDecl GhcPs
forall p. XRoleAnnotD p -> RoleAnnotDecl p -> HsDecl p
Hs.RoleAnnotD XRoleAnnotD GhcPs
NoExtField
noExtField (XCRoleAnnotDecl GhcPs
-> LIdP GhcPs -> [XRec GhcPs (Maybe Role)] -> RoleAnnotDecl GhcPs
forall pass.
XCRoleAnnotDecl pass
-> LIdP pass -> [XRec pass (Maybe Role)] -> RoleAnnotDecl pass
RoleAnnotDecl XCRoleAnnotDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
tc' [XRec GhcPs (Maybe Role)]
[LocatedAn NoEpAnns (Maybe Role)]
roles') }
cvtDec (TH.StandaloneDerivD Maybe DerivStrategy
ds [Type]
cxt Type
ty)
= do { GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
funPrec [Type]
cxt
; Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
ds' <- (DerivStrategy
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)))
-> Maybe DerivStrategy
-> CvtM'
ConversionFailReason
(Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse DerivStrategy -> CvtM (LDerivStrategy GhcPs)
DerivStrategy
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
cvtDerivStrategy Maybe DerivStrategy
ds
; (L SrcSpanAnnA
loc HsType GhcPs
ty') <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; let inst_ty' :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
inst_ty' = SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType (LHsType GhcPs -> HsSigType GhcPs)
-> LHsType GhcPs -> HsSigType GhcPs
forall a b. (a -> b) -> a -> b
$
[Type]
-> SrcSpanAnnA
-> LHsContext GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
mkHsQualTy [Type]
cxt SrcSpanAnnA
loc LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt' (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsType GhcPs
ty'
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XDerivD GhcPs -> DerivDecl GhcPs -> HsDecl GhcPs
forall p. XDerivD p -> DerivDecl p -> HsDecl p
DerivD XDerivD GhcPs
NoExtField
noExtField (DerivDecl GhcPs -> HsDecl GhcPs)
-> DerivDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
DerivDecl { deriv_ext :: XCDerivDecl GhcPs
deriv_ext = XCDerivDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, deriv_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_strategy = Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
ds'
, deriv_type :: LHsSigWcType GhcPs
deriv_type = GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsSigType GhcPs)
inst_ty'
, deriv_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
deriv_overlap_mode = Maybe (XRec GhcPs OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
forall a. Maybe a
Nothing } }
cvtDec (TH.DefaultSigD Name
nm Type
typ)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
typ
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField
(Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XClassOpSig GhcPs
-> Bool -> [LIdP GhcPs] -> LHsSigType GhcPs -> Sig GhcPs
forall pass.
XClassOpSig pass
-> Bool -> [LIdP pass] -> LHsSigType pass -> Sig pass
ClassOpSig XClassOpSig GhcPs
EpAnn AnnSig
forall a. EpAnn a
noAnn Bool
True [LIdP GhcPs
LocatedN RdrName
nm'] LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'}
cvtDec (TH.PatSynD Name
nm PatSynArgs
args PatSynDir
dir Pat
pat)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
nm
; HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
args' <- PatSynArgs
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
cvtArgs PatSynArgs
args
; HsPatSynDir GhcPs
dir' <- LocatedN RdrName
-> PatSynDir -> CvtM' ConversionFailReason (HsPatSynDir GhcPs)
cvtDir LocatedN RdrName
nm' PatSynDir
dir
; GenLocated SrcSpanAnnA (Pat GhcPs)
pat' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
pat
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD GhcPs
NoExtField
noExtField (HsBind GhcPs -> HsDecl GhcPs) -> HsBind GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcPs GhcPs -> PatSynBind GhcPs GhcPs -> HsBind GhcPs
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcPs GhcPs
NoExtField
noExtField (PatSynBind GhcPs GhcPs -> HsBind GhcPs)
-> PatSynBind GhcPs GhcPs -> HsBind GhcPs
forall a b. (a -> b) -> a -> b
$
XPSB GhcPs GhcPs
-> LIdP GhcPs
-> HsPatSynDetails GhcPs
-> LPat GhcPs
-> HsPatSynDir GhcPs
-> PatSynBind GhcPs GhcPs
forall idL idR.
XPSB idL idR
-> LIdP idL
-> HsPatSynDetails idR
-> LPat idR
-> HsPatSynDir idR
-> PatSynBind idL idR
PSB XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
nm' HsPatSynDetails GhcPs
HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
args' LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat' HsPatSynDir GhcPs
dir' }
where
cvtArgs :: PatSynArgs
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
cvtArgs (TH.PrefixPatSyn [Name]
args) = [Void]
-> [LocatedN RdrName]
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
Hs.PrefixCon [Void]
noTypeArgs ([LocatedN RdrName]
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
-> CvtM' ConversionFailReason [LocatedN RdrName]
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> CvtM (LocatedN RdrName))
-> [Name] -> CvtM' ConversionFailReason [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (LocatedN RdrName)
vNameN [Name]
args
cvtArgs (TH.InfixPatSyn Name
a1 Name
a2) = LocatedN RdrName
-> LocatedN RdrName
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
Hs.InfixCon (LocatedN RdrName
-> LocatedN RdrName
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
-> CvtM (LocatedN RdrName)
-> CvtM'
ConversionFailReason
(LocatedN RdrName
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> CvtM (LocatedN RdrName)
vNameN Name
a1 CvtM'
ConversionFailReason
(LocatedN RdrName
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
-> CvtM (LocatedN RdrName)
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
forall a b.
CvtM' ConversionFailReason (a -> b)
-> CvtM' ConversionFailReason a -> CvtM' ConversionFailReason b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> CvtM (LocatedN RdrName)
vNameN Name
a2
cvtArgs (TH.RecordPatSyn [Name]
sels)
= do { let mk_fld :: Name -> CvtM (LocatedN RdrName)
mk_fld = String -> Name -> CvtM (LocatedN RdrName)
fldNameN (Name -> String
nameBase Name
nm)
; [FieldOcc GhcPs]
sels' <- (Name -> CvtM' ConversionFailReason (FieldOcc GhcPs))
-> [Name] -> CvtM' ConversionFailReason [FieldOcc GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((LocatedN RdrName -> FieldOcc GhcPs)
-> CvtM (LocatedN RdrName)
-> CvtM' ConversionFailReason (FieldOcc GhcPs)
forall a b.
(a -> b)
-> CvtM' ConversionFailReason a -> CvtM' ConversionFailReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (L SrcSpanAnnN
li RdrName
i) -> XCFieldOcc GhcPs -> XRec GhcPs RdrName -> FieldOcc GhcPs
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcPs
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
li RdrName
i)) (CvtM (LocatedN RdrName)
-> CvtM' ConversionFailReason (FieldOcc GhcPs))
-> (Name -> CvtM (LocatedN RdrName))
-> Name
-> CvtM' ConversionFailReason (FieldOcc GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CvtM (LocatedN RdrName)
mk_fld) [Name]
sels
; [LocatedN RdrName]
vars' <- (Name -> CvtM (LocatedN RdrName))
-> [Name] -> CvtM' ConversionFailReason [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Name -> CvtM (LocatedN RdrName)
vNameN (Name -> CvtM (LocatedN RdrName))
-> (Name -> Name) -> Name -> CvtM (LocatedN RdrName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkNameS (String -> Name) -> (Name -> String) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase) [Name]
sels
; HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]))
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
-> CvtM'
ConversionFailReason
(HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
forall a b. (a -> b) -> a -> b
$ [RecordPatSynField GhcPs]
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
Hs.RecCon ([RecordPatSynField GhcPs]
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs])
-> [RecordPatSynField GhcPs]
-> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
forall a b. (a -> b) -> a -> b
$ (FieldOcc GhcPs -> LocatedN RdrName -> RecordPatSynField GhcPs)
-> [FieldOcc GhcPs]
-> [LocatedN RdrName]
-> [RecordPatSynField GhcPs]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FieldOcc GhcPs -> LIdP GhcPs -> RecordPatSynField GhcPs
FieldOcc GhcPs -> LocatedN RdrName -> RecordPatSynField GhcPs
forall pass. FieldOcc pass -> LIdP pass -> RecordPatSynField pass
RecordPatSynField [FieldOcc GhcPs]
sels' [LocatedN RdrName]
vars' }
cvtDir :: LocatedN RdrName
-> PatSynDir -> CvtM' ConversionFailReason (HsPatSynDir GhcPs)
cvtDir LocatedN RdrName
_ PatSynDir
Unidir = HsPatSynDir GhcPs -> CvtM' ConversionFailReason (HsPatSynDir GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return HsPatSynDir GhcPs
forall id. HsPatSynDir id
Unidirectional
cvtDir LocatedN RdrName
_ PatSynDir
ImplBidir = HsPatSynDir GhcPs -> CvtM' ConversionFailReason (HsPatSynDir GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return HsPatSynDir GhcPs
forall id. HsPatSynDir id
ImplicitBidirectional
cvtDir LocatedN RdrName
n (ExplBidir [Clause]
cls) =
do { [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms <- (Clause
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Clause]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext GhcPs
-> Clause -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtClause (LIdP (NoGhcTc GhcPs) -> HsMatchContext GhcPs
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc GhcPs)
LocatedN RdrName
n)) [Clause]
cls
; Origin
th_origin <- CvtM Origin
getOrigin
; (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsPatSynDir GhcPs)
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM' ConversionFailReason (HsPatSynDir GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (MatchGroup GhcPs (LHsExpr GhcPs) -> HsPatSynDir GhcPs
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsPatSynDir GhcPs
forall id. MatchGroup id (LHsExpr id) -> HsPatSynDir id
ExplicitBidirectional (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsPatSynDir GhcPs)
-> (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsPatSynDir GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms }
cvtDec (TH.PatSynSigD Name
nm Type
ty)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtPatSynSigTy Type
ty
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField (Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XPatSynSig GhcPs -> [LIdP GhcPs] -> LHsSigType GhcPs -> Sig GhcPs
forall pass.
XPatSynSig pass -> [LIdP pass] -> LHsSigType pass -> Sig pass
PatSynSig XPatSynSig GhcPs
EpAnn AnnSig
forall a. EpAnn a
noAnn [LIdP GhcPs
LocatedN RdrName
nm'] LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'}
cvtDec (TH.ImplicitParamBindD String
_ Exp
_)
= ConversionFailReason
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
InvalidImplicitParamBinding
cvtDataDec :: TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis]
-> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause]
-> CvtM (Maybe (LHsDecl GhcPs))
cvtDataDec :: [Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtDataDec = Bool
-> [Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtGenDataDec Bool
False
cvtTypeDataDec :: TH.Name -> [TH.TyVarBndr TH.BndrVis] -> Maybe TH.Kind -> [TH.Con]
-> CvtM (Maybe (LHsDecl GhcPs))
cvtTypeDataDec :: Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtTypeDataDec Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs
= Bool
-> [Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtGenDataDec Bool
True [] Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs []
cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis]
-> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause]
-> CvtM (Maybe (LHsDecl GhcPs))
cvtGenDataDec :: Bool
-> [Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtGenDataDec Bool
type_data [Type]
ctxt Name
tc [TyVarBndr BndrVis]
tvs Maybe Type
ksig [Con]
constrs [DerivClause]
derivs
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt', LocatedN RdrName
tc', LHsQTyVars GhcPs
tvs') <- [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [Type]
ctxt Name
tc [TyVarBndr BndrVis]
tvs
; Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtKind (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Maybe Type
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
; DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
cons' <- Bool
-> Maybe Type
-> DataDefnCons Con
-> CvtM (DataDefnCons (LConDecl GhcPs))
cvtDataDefnCons Bool
type_data Maybe Type
ksig (DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs)))
-> DataDefnCons Con -> CvtM (DataDefnCons (LConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$
Bool -> [Con] -> DataDefnCons Con
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
type_data [Con]
constrs
; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' <- [DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs [DerivClause]
derivs
; let defn :: HsDataDefn GhcPs
defn = HsDataDefn { dd_ext :: XCHsDataDefn GhcPs
dd_ext = XCHsDataDefn GhcPs
NoExtField
noExtField
, dd_cType :: Maybe (XRec GhcPs CType)
dd_cType = Maybe (XRec GhcPs CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
, dd_ctxt :: Maybe (LHsContext GhcPs)
dd_ctxt = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'
, dd_kindSig :: Maybe (LHsType GhcPs)
dd_kindSig = Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig'
, dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_cons = DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
cons'
, dd_derivs :: HsDeriving GhcPs
dd_derivs = HsDeriving GhcPs
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
derivs' }
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
DataDecl { tcdDExt :: XDataDecl GhcPs
tcdDExt = XDataDecl GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, tcdLName :: LIdP GhcPs
tcdLName = LIdP GhcPs
LocatedN RdrName
tc', tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars = LHsQTyVars GhcPs
tvs'
, tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
, tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn = HsDataDefn GhcPs
defn } }
cvtDataDefnCons ::
Bool -> Maybe TH.Kind ->
DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs))
cvtDataDefnCons :: Bool
-> Maybe Type
-> DataDefnCons Con
-> CvtM (DataDefnCons (LConDecl GhcPs))
cvtDataDefnCons Bool
type_data Maybe Type
ksig DataDefnCons Con
constrs
= do { let isGadtCon :: Con -> Bool
isGadtCon (GadtC [Name]
_ [BangType]
_ Type
_) = Bool
True
isGadtCon (RecGadtC [Name]
_ [VarBangType]
_ Type
_) = Bool
True
isGadtCon (ForallC [TyVarBndr Specificity]
_ [Type]
_ Con
c) = Con -> Bool
isGadtCon Con
c
isGadtCon Con
_ = Bool
False
isGadtDecl :: Bool
isGadtDecl = (Con -> Bool) -> DataDefnCons Con -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Con -> Bool
isGadtCon DataDefnCons Con
constrs
isH98Decl :: Bool
isH98Decl = (Con -> Bool) -> DataDefnCons Con -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Con -> Bool) -> Con -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Con -> Bool
isGadtCon) DataDefnCons Con
constrs
con_name :: Name -> CvtM (LocatedN RdrName)
con_name
| Bool
type_data = Name -> CvtM (LocatedN RdrName)
tconNameN
| Bool
otherwise = Name -> CvtM (LocatedN RdrName)
cNameN
; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isGadtDecl Bool -> Bool -> Bool
|| Bool
isH98Decl)
(ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
CannotMixGADTConsWith98Cons)
; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Type -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Type
ksig Bool -> Bool -> Bool
|| Bool
isGadtDecl)
(ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
KindSigsOnlyAllowedOnGADTs)
; let first_datacon :: Con
first_datacon =
case DataDefnCons Con -> Maybe Con
forall a. DataDefnCons a -> Maybe a
firstDataDefnCon DataDefnCons Con
constrs of
Maybe Con
Nothing -> String -> Con
forall a. HasCallStack => String -> a
panic String
"cvtDataDefnCons: empty list of constructors"
Just Con
con -> Con
con
first_datacon_name :: Name
first_datacon_name =
case Con -> [Name]
get_cons_names Con
first_datacon of
[] -> String -> Name
forall a. HasCallStack => String -> a
panic String
"cvtDataDefnCons: data constructor with no names"
Name
c:[Name]
_ -> Name
c
; (Con
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> DataDefnCons Con
-> CvtM'
ConversionFailReason
(DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DataDefnCons a -> m (DataDefnCons b)
mapM (Name
-> (Name -> CvtM (LocatedN RdrName))
-> Con
-> CvtM (LConDecl GhcPs)
cvtConstr Name
first_datacon_name Name -> CvtM (LocatedN RdrName)
con_name) DataDefnCons Con
constrs }
cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
cvtTySynEqn (TySynEqn Maybe [TyVarBndr ()]
mb_bndrs Type
lhs Type
rhs)
= do { Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
mb_bndrs' <- ([TyVarBndr ()]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
-> Maybe [TyVarBndr ()]
-> CvtM'
ConversionFailReason
(Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((TyVarBndr ()
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> [TyVarBndr ()]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyVarBndr () -> CvtM (LHsTyVarBndr () GhcPs)
TyVarBndr ()
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv) Maybe [TyVarBndr ()]
mb_bndrs
; let outer_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
outer_bndrs = Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
mkHsOuterFamEqnTyVarBndrs Maybe [LHsTyVarBndr () GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
mb_bndrs'
; (Type
head_ty, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args) <- Type -> CvtM (Type, HsTyPats GhcPs)
split_ty_app Type
lhs
; case Type
head_ty of
ConT Name
nm -> do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
nm
; GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
rhs
; let args' :: [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args' = (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTypeArg GhcPs -> LHsTypeArg GhcPs
HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
wrap_tyarg [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args
; FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA
(FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))))
-> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall a b. (a -> b) -> a -> b
$ FamEqn { feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_ext = XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, feqn_tycon :: LIdP GhcPs
feqn_tycon = LIdP GhcPs
LocatedN RdrName
nm'
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
outer_bndrs
, feqn_pats :: HsTyPats GhcPs
feqn_pats = HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args'
, feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Prefix
, feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs = GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' } }
InfixT Type
t1 Name
nm Type
t2 -> do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
nm
; [GenLocated SrcSpanAnnA (HsType GhcPs)]
args' <- (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [Type]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtType [Type
t1,Type
t2]
; GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
rhs
; FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA
(FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))))
-> FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall a b. (a -> b) -> a -> b
$ FamEqn { feqn_ext :: XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
feqn_ext = XCFamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, feqn_tycon :: LIdP GhcPs
feqn_tycon = LIdP GhcPs
LocatedN RdrName
nm'
, feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcPs
outer_bndrs
, feqn_pats :: HsTyPats GhcPs
feqn_pats =
((GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg [GenLocated SrcSpanAnnA (HsType GhcPs)]
args') [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. [a] -> [a] -> [a]
++ [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args
, feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Hs.Infix
, feqn_rhs :: GenLocated SrcSpanAnnA (HsType GhcPs)
feqn_rhs = GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' } }
Type
_ -> ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))))
-> ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
forall a b. (a -> b) -> a -> b
$ Type -> ConversionFailReason
InvalidTyFamInstLHS Type
lhs
}
cvt_ci_decs :: THDeclDescriptor -> [TH.Dec]
-> CvtM (LHsBinds GhcPs,
[LSig GhcPs],
[LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs],
[LDataFamInstDecl GhcPs])
cvt_ci_decs :: THDeclDescriptor
-> [Dec]
-> CvtM
(LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs])
cvt_ci_decs THDeclDescriptor
declDescr [Dec]
decs
= do { [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs' <- [Dec] -> CvtM [LHsDecl GhcPs]
cvtDecs [Dec]
decs
; let ([GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
ats', [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bind_sig_decs') = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_tyfam_inst [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs'
; let ([GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts', [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
no_ats') = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_datafam_inst [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bind_sig_decs'
; let ([GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs', [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
prob_binds') = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (Sig GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (Sig GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (Sig GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_sig [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
no_ats'
; let ([GenLocated SrcSpanAnnA (HsBind GhcPs)]
binds', [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
prob_fams') = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (HsBind GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsBind GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (HsBind GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_bind [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
prob_binds'
; let ([GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fams', [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bads) = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_fam_decl [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
prob_fams'
; Maybe (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bads) ((NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ())
-> (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ()
forall a b. (a -> b) -> a -> b
$ \ NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
bad_decls ->
ConversionFailReason -> CvtM' ConversionFailReason Any
forall a. ConversionFailReason -> CvtM a
failWith (THDeclDescriptor -> IllegalDecls -> ConversionFailReason
IllegalDeclaration THDeclDescriptor
declDescr (IllegalDecls -> ConversionFailReason)
-> IllegalDecls -> ConversionFailReason
forall a b. (a -> b) -> a -> b
$ NonEmpty (LHsDecl GhcPs) -> IllegalDecls
IllegalDecls NonEmpty (LHsDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
bad_decls)
; (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs)),
[GenLocated SrcSpanAnnA (Sig GhcPs)],
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)])
-> CvtM'
ConversionFailReason
(Bag (GenLocated SrcSpanAnnA (HsBind GhcPs)),
[GenLocated SrcSpanAnnA (Sig GhcPs)],
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)])
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
forall a. [a] -> Bag a
listToBag [GenLocated SrcSpanAnnA (HsBind GhcPs)]
binds', [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs', [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
fams', [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
ats', [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts') }
cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis]
-> CvtM ( LHsContext GhcPs
, LocatedN RdrName
, LHsQTyVars GhcPs)
cvt_tycl_hdr :: [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [Type]
cxt Name
tc [TyVarBndr BndrVis]
tvs
= do { GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
funPrec [Type]
cxt
; LocatedN RdrName
tc' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
tc
; [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
tvs' <- [TyVarBndr BndrVis] -> CvtM [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs [TyVarBndr BndrVis]
tvs
; (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, LHsQTyVars GhcPs)
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, LHsQTyVars GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt', LocatedN RdrName
tc', [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
tvs')
}
cvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr ()] -> TH.Type
-> CvtM ( LHsContext GhcPs
, LocatedN RdrName
, HsOuterFamEqnTyVarBndrs GhcPs
, HsTyPats GhcPs)
cvt_datainst_hdr :: [Type]
-> Maybe [TyVarBndr ()]
-> Type
-> CvtM
(LHsContext GhcPs, LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
HsTyPats GhcPs)
cvt_datainst_hdr [Type]
cxt Maybe [TyVarBndr ()]
bndrs Type
tys
= do { GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
funPrec [Type]
cxt
; Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
bndrs' <- ([TyVarBndr ()]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
-> Maybe [TyVarBndr ()]
-> CvtM'
ConversionFailReason
(Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((TyVarBndr ()
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)))
-> [TyVarBndr ()]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyVarBndr () -> CvtM (LHsTyVarBndr () GhcPs)
TyVarBndr ()
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv) Maybe [TyVarBndr ()]
bndrs
; let outer_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
outer_bndrs = Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
mkHsOuterFamEqnTyVarBndrs Maybe [LHsTyVarBndr () GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
bndrs'
; (Type
head_ty, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args) <- Type -> CvtM (Type, HsTyPats GhcPs)
split_ty_app Type
tys
; case Type
head_ty of
ConT Name
nm -> do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
nm
; let args' :: [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args' = (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTypeArg GhcPs -> LHsTypeArg GhcPs
HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
wrap_tyarg [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args
; (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt', LocatedN RdrName
nm', HsOuterFamEqnTyVarBndrs GhcPs
outer_bndrs, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args') }
InfixT Type
t1 Name
nm Type
t2 -> do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
nm
; [GenLocated SrcSpanAnnA (HsType GhcPs)]
args' <- (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [Type]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtType [Type
t1,Type
t2]
; (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt', LocatedN RdrName
nm', HsOuterFamEqnTyVarBndrs GhcPs
outer_bndrs,
(((GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg [GenLocated SrcSpanAnnA (HsType GhcPs)]
args') [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. [a] -> [a] -> [a]
++ [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
args)) }
Type
_ -> ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]))
-> ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)],
LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
forall a b. (a -> b) -> a -> b
$ Type -> ConversionFailReason
InvalidTypeInstanceHeader Type
tys }
cvt_tyfam_head :: TypeFamilyHead
-> CvtM ( LocatedN RdrName
, LHsQTyVars GhcPs
, Hs.LFamilyResultSig GhcPs
, Maybe (Hs.LInjectivityAnn GhcPs))
cvt_tyfam_head :: TypeFamilyHead
-> CvtM
(LocatedN RdrName, LHsQTyVars GhcPs, LFamilyResultSig GhcPs,
Maybe (LInjectivityAnn GhcPs))
cvt_tyfam_head (TypeFamilyHead Name
tc [TyVarBndr BndrVis]
tyvars FamilyResultSig
result Maybe InjectivityAnn
injectivity)
= do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
_, LocatedN RdrName
tc', LHsQTyVars GhcPs
tyvars') <- [Type]
-> Name
-> [TyVarBndr BndrVis]
-> CvtM (LHsContext GhcPs, LocatedN RdrName, LHsQTyVars GhcPs)
cvt_tycl_hdr [] Name
tc [TyVarBndr BndrVis]
tyvars
; GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result' <- FamilyResultSig -> CvtM (LFamilyResultSig GhcPs)
cvtFamilyResultSig FamilyResultSig
result
; Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
injectivity' <- (InjectivityAnn
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)))
-> Maybe InjectivityAnn
-> CvtM'
ConversionFailReason
(Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse InjectivityAnn -> CvtM (LInjectivityAnn GhcPs)
InjectivityAnn
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
cvtInjectivityAnnotation Maybe InjectivityAnn
injectivity
; (LocatedN RdrName, LHsQTyVars GhcPs,
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs),
Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)))
-> CvtM'
ConversionFailReason
(LocatedN RdrName, LHsQTyVars GhcPs,
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs),
Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs)))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedN RdrName
tc', LHsQTyVars GhcPs
tyvars', GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs)
result', Maybe (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
injectivity') }
is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
is_fam_decl (L SrcSpanAnnA
loc (TyClD XTyClD GhcPs
_ (FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl GhcPs
d }))) = GenLocated SrcSpanAnnA (FamilyDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> FamilyDecl GhcPs -> GenLocated SrcSpanAnnA (FamilyDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc FamilyDecl GhcPs
d)
is_fam_decl LHsDecl GhcPs
decl = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. b -> Either a b
Right LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
is_tyfam_inst (L SrcSpanAnnA
loc (Hs.InstD XInstD GhcPs
_ (TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamInstDecl GhcPs
d })))
= GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> TyFamInstDecl GhcPs
-> GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc TyFamInstDecl GhcPs
d)
is_tyfam_inst LHsDecl GhcPs
decl
= GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. b -> Either a b
Right LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
is_datafam_inst :: LHsDecl GhcPs
-> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
is_datafam_inst :: LHsDecl GhcPs -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
is_datafam_inst (L SrcSpanAnnA
loc (Hs.InstD XInstD GhcPs
_ (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl GhcPs
d })))
= GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> DataFamInstDecl GhcPs
-> GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc DataFamInstDecl GhcPs
d)
is_datafam_inst LHsDecl GhcPs
decl
= GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. b -> Either a b
Right LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
is_sig (L SrcSpanAnnA
loc (Hs.SigD XSigD GhcPs
_ Sig GhcPs
sig)) = GenLocated SrcSpanAnnA (Sig GhcPs)
-> Either
(GenLocated SrcSpanAnnA (Sig GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. a -> Either a b
Left (SrcSpanAnnA -> Sig GhcPs -> GenLocated SrcSpanAnnA (Sig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Sig GhcPs
sig)
is_sig LHsDecl GhcPs
decl = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (Sig GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. b -> Either a b
Right LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
is_bind (L SrcSpanAnnA
loc (Hs.ValD XValD GhcPs
_ HsBind GhcPs
bind)) = GenLocated SrcSpanAnnA (HsBind GhcPs)
-> Either
(GenLocated SrcSpanAnnA (HsBind GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsBind GhcPs
bind)
is_bind LHsDecl GhcPs
decl = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (HsBind GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. b -> Either a b
Right LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
is_ip_bind :: TH.Dec -> Either (String, TH.Exp) TH.Dec
is_ip_bind :: Dec -> Either (String, Exp) Dec
is_ip_bind (TH.ImplicitParamBindD String
n Exp
e) = (String, Exp) -> Either (String, Exp) Dec
forall a b. a -> Either a b
Left (String
n, Exp
e)
is_ip_bind Dec
decl = Dec -> Either (String, Exp) Dec
forall a b. b -> Either a b
Right Dec
decl
cvtConstr :: TH.Name
-> (TH.Name -> CvtM (LocatedN RdrName))
-> TH.Con -> CvtM (LConDecl GhcPs)
cvtConstr :: Name
-> (Name -> CvtM (LocatedN RdrName))
-> Con
-> CvtM (LConDecl GhcPs)
cvtConstr Name
_ Name -> CvtM (LocatedN RdrName)
do_con_name (NormalC Name
c [BangType]
strtys)
= do { LocatedN RdrName
c' <- Name -> CvtM (LocatedN RdrName)
do_con_name Name
c
; [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys' <- (BangType
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [BangType]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BangType -> CvtM' ConversionFailReason (LHsType GhcPs)
BangType
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvt_arg [BangType]
strtys
; ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn]
-> LocatedN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LocatedN RdrName
c' Maybe [LHsTyVarBndr Specificity GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
forall a. Maybe a
Nothing Maybe (LHsContext GhcPs)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing ([Void]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ((GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys')) }
cvtConstr Name
parent_con Name -> CvtM (LocatedN RdrName)
do_con_name (RecC Name
c [VarBangType]
varstrtys)
= do { LocatedN RdrName
c' <- Name -> CvtM (LocatedN RdrName)
do_con_name Name
c
; [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
args' <- (VarBangType
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDeclField GhcPs)))
-> [VarBangType]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Name -> VarBangType -> CvtM (LConDeclField GhcPs)
cvt_id_arg Name
parent_con) [VarBangType]
varstrtys
; ConDecl GhcPs
con_decl <- (GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> ConDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> CvtM (ConDecl GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (EpAnn [AddEpAnn]
-> LocatedN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LocatedN RdrName
c' Maybe [LHsTyVarBndr Specificity GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
forall a. Maybe a
Nothing Maybe (LHsContext GhcPs)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing (HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> ConDecl GhcPs)
-> (GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]))
-> GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> ConDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
args'
; ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA ConDecl GhcPs
con_decl }
cvtConstr Name
_ Name -> CvtM (LocatedN RdrName)
do_con_name (InfixC BangType
st1 Name
c BangType
st2)
= do { LocatedN RdrName
c' <- Name -> CvtM (LocatedN RdrName)
do_con_name Name
c
; GenLocated SrcSpanAnnA (HsType GhcPs)
st1' <- BangType -> CvtM' ConversionFailReason (LHsType GhcPs)
cvt_arg BangType
st1
; GenLocated SrcSpanAnnA (HsType GhcPs)
st2' <- BangType -> CvtM' ConversionFailReason (LHsType GhcPs)
cvt_arg BangType
st2
; ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn]
-> LocatedN RdrName
-> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs)
-> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LocatedN RdrName
c' Maybe [LHsTyVarBndr Specificity GhcPs]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
forall a. Maybe a
Nothing Maybe (LHsContext GhcPs)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear GenLocated SrcSpanAnnA (HsType GhcPs)
st1') (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear GenLocated SrcSpanAnnA (HsType GhcPs)
st2')) }
cvtConstr Name
parent_con Name -> CvtM (LocatedN RdrName)
do_con_name (ForallC [TyVarBndr Specificity]
tvs [Type]
ctxt Con
con)
= do { [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
tvs' <- [TyVarBndr Specificity] -> CvtM [LHsTyVarBndr Specificity GhcPs]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs [TyVarBndr Specificity]
tvs
; GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' <- PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
funPrec [Type]
ctxt
; L SrcSpanAnnA
_ ConDecl GhcPs
con' <- Name
-> (Name -> CvtM (LocatedN RdrName))
-> Con
-> CvtM (LConDecl GhcPs)
cvtConstr Name
parent_con Name -> CvtM (LocatedN RdrName)
do_con_name Con
con
; ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ [LHsTyVarBndr Specificity GhcPs]
-> LHsContext GhcPs -> ConDecl GhcPs -> ConDecl GhcPs
add_forall [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
tvs' LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' ConDecl GhcPs
con' }
where
add_cxt :: GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe (GenLocated l [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe (LHsContext GhcPs)
add_cxt GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
lcxt Maybe (GenLocated l [GenLocated SrcSpanAnnA (HsType GhcPs)])
Nothing = LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
lcxt
add_cxt (L SrcSpanAnnC
loc [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt1) (Just (L l
_ [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt2))
= GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> Maybe a
Just (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
loc ([GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt1 [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt2))
add_forall :: [LHsTyVarBndr Hs.Specificity GhcPs] -> LHsContext GhcPs
-> ConDecl GhcPs -> ConDecl GhcPs
add_forall :: [LHsTyVarBndr Specificity GhcPs]
-> LHsContext GhcPs -> ConDecl GhcPs -> ConDecl GhcPs
add_forall [LHsTyVarBndr Specificity GhcPs]
tvs' LHsContext GhcPs
cxt' con :: ConDecl GhcPs
con@(ConDeclGADT { con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs = L SrcSpanAnnA
l HsOuterSigTyVarBndrs GhcPs
outer_bndrs, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcPs)
cxt })
= ConDecl GhcPs
con { con_bndrs = L l outer_bndrs'
, con_mb_cxt = add_cxt cxt' cxt }
where
outer_bndrs' :: HsOuterSigTyVarBndrs GhcPs
outer_bndrs'
| [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
all_tvs = HsOuterSigTyVarBndrs GhcPs
forall flag. HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit
| Bool
otherwise = EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcPs] -> HsOuterSigTyVarBndrs GhcPs
forall flag.
EpAnnForallTy
-> [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
mkHsOuterExplicit EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
all_tvs
all_tvs :: [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
all_tvs = [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
tvs' [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
outer_exp_tvs
outer_exp_tvs :: [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
outer_exp_tvs = HsOuterSigTyVarBndrs GhcPs
-> [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
forall flag (p :: Pass).
HsOuterTyVarBndrs flag (GhcPass p)
-> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
hsOuterExplicitBndrs HsOuterSigTyVarBndrs GhcPs
outer_bndrs
add_forall [LHsTyVarBndr Specificity GhcPs]
tvs' LHsContext GhcPs
cxt' con :: ConDecl GhcPs
con@(ConDeclH98 { con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity GhcPs]
ex_tvs, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcPs)
cxt })
= ConDecl GhcPs
con { con_forall = not (null all_tvs)
, con_ex_tvs = all_tvs
, con_mb_cxt = add_cxt cxt' cxt }
where
all_tvs :: [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
all_tvs = [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
tvs' [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
ex_tvs
cvtConstr Name
_ Name -> CvtM (LocatedN RdrName)
do_con_name (GadtC [Name]
c [BangType]
strtys Type
ty) = case [Name] -> Maybe (NonEmpty Name)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Name]
c of
Maybe (NonEmpty Name)
Nothing -> ConversionFailReason
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
GadtNoCons
Just NonEmpty Name
c -> do
{ NonEmpty (LocatedN RdrName)
c' <- (Name -> CvtM (LocatedN RdrName))
-> NonEmpty Name
-> CvtM' ConversionFailReason (NonEmpty (LocatedN RdrName))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM Name -> CvtM (LocatedN RdrName)
do_con_name NonEmpty Name
c
; [GenLocated SrcSpanAnnA (HsType GhcPs)]
args <- (BangType
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [BangType]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BangType -> CvtM' ConversionFailReason (LHsType GhcPs)
BangType
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvt_arg [BangType]
strtys
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; NonEmpty (LocatedN RdrName)
-> HsConDeclGADTDetails GhcPs
-> LHsType GhcPs
-> CvtM (LConDecl GhcPs)
mk_gadt_decl NonEmpty (LocatedN RdrName)
c' ([HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs
forall pass.
[HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT ([HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs)
-> [HsScaled GhcPs (LHsType GhcPs)] -> HsConDeclGADTDetails GhcPs
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear [GenLocated SrcSpanAnnA (HsType GhcPs)]
args) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty'}
cvtConstr Name
parent_con Name -> CvtM (LocatedN RdrName)
do_con_name (RecGadtC [Name]
c [VarBangType]
varstrtys Type
ty) = case [Name] -> Maybe (NonEmpty Name)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Name]
c of
Maybe (NonEmpty Name)
Nothing -> ConversionFailReason
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
RecGadtNoCons
Just NonEmpty Name
c -> do
{ NonEmpty (LocatedN RdrName)
c' <- (Name -> CvtM (LocatedN RdrName))
-> NonEmpty Name
-> CvtM' ConversionFailReason (NonEmpty (LocatedN RdrName))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM Name -> CvtM (LocatedN RdrName)
do_con_name NonEmpty Name
c
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rec_flds <- (VarBangType
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDeclField GhcPs)))
-> [VarBangType]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Name -> VarBangType -> CvtM (LConDeclField GhcPs)
cvt_id_arg Name
parent_con) [VarBangType]
varstrtys
; GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
lrec_flds <- [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> CvtM
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rec_flds
; NonEmpty (LocatedN RdrName)
-> HsConDeclGADTDetails GhcPs
-> LHsType GhcPs
-> CvtM (LConDecl GhcPs)
mk_gadt_decl NonEmpty (LocatedN RdrName)
c' (XRec GhcPs [LConDeclField GhcPs]
-> LHsUniToken "->" "\8594" GhcPs -> HsConDeclGADTDetails GhcPs
forall pass.
XRec pass [LConDeclField pass]
-> LHsUniToken "->" "\8594" pass -> HsConDeclGADTDetails pass
RecConGADT XRec GhcPs [LConDeclField GhcPs]
GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
lrec_flds LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' }
mk_gadt_decl :: NonEmpty (LocatedN RdrName) -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs
-> CvtM (LConDecl GhcPs)
mk_gadt_decl :: NonEmpty (LocatedN RdrName)
-> HsConDeclGADTDetails GhcPs
-> LHsType GhcPs
-> CvtM (LConDecl GhcPs)
mk_gadt_decl NonEmpty (LocatedN RdrName)
names HsConDeclGADTDetails GhcPs
args LHsType GhcPs
res_ty
= do GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
bndrs <- HsOuterSigTyVarBndrs GhcPs
-> CvtM (GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsOuterSigTyVarBndrs GhcPs
forall flag. HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit
ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> ConDecl GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ ConDeclGADT
{ con_g_ext :: XConDeclGADT GhcPs
con_g_ext = XConDeclGADT GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, con_names :: NonEmpty (LIdP GhcPs)
con_names = NonEmpty (LIdP GhcPs)
NonEmpty (LocatedN RdrName)
names
, con_dcolon :: LHsUniToken "::" "\8759" GhcPs
con_dcolon = LHsUniToken "::" "\8759" GhcPs
GenLocated TokenLocation (HsUniToken "::" "\8759")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok
, con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs = XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
bndrs
, con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt = Maybe (LHsContext GhcPs)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing
, con_g_args :: HsConDeclGADTDetails GhcPs
con_g_args = HsConDeclGADTDetails GhcPs
args
, con_res_ty :: LHsType GhcPs
con_res_ty = LHsType GhcPs
res_ty
, con_doc :: Maybe (LHsDoc GhcPs)
con_doc = Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing }
cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
cvtSrcUnpackedness :: SourceUnpackedness -> SrcUnpackedness
cvtSrcUnpackedness SourceUnpackedness
NoSourceUnpackedness = SrcUnpackedness
NoSrcUnpack
cvtSrcUnpackedness SourceUnpackedness
SourceNoUnpack = SrcUnpackedness
SrcNoUnpack
cvtSrcUnpackedness SourceUnpackedness
SourceUnpack = SrcUnpackedness
SrcUnpack
cvtSrcStrictness :: TH.SourceStrictness -> SrcStrictness
cvtSrcStrictness :: SourceStrictness -> SrcStrictness
cvtSrcStrictness SourceStrictness
NoSourceStrictness = SrcStrictness
NoSrcStrict
cvtSrcStrictness SourceStrictness
SourceLazy = SrcStrictness
SrcLazy
cvtSrcStrictness SourceStrictness
SourceStrict = SrcStrictness
SrcStrict
cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType GhcPs)
cvt_arg :: BangType -> CvtM' ConversionFailReason (LHsType GhcPs)
cvt_arg (Bang SourceUnpackedness
su SourceStrictness
ss, Type
ty)
= do { GenLocated SrcSpanAnnA (HsType GhcPs)
ty'' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; let ty' :: LHsType GhcPs
ty' = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty''
su' :: SrcUnpackedness
su' = SourceUnpackedness -> SrcUnpackedness
cvtSrcUnpackedness SourceUnpackedness
su
ss' :: SrcStrictness
ss' = SourceStrictness -> SrcStrictness
cvtSrcStrictness SourceStrictness
ss
; HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$ XBangTy GhcPs -> HsSrcBang -> LHsType GhcPs -> HsType GhcPs
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
su' SrcStrictness
ss') LHsType GhcPs
ty' }
cvt_id_arg :: TH.Name
-> (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
cvt_id_arg :: Name -> VarBangType -> CvtM (LConDeclField GhcPs)
cvt_id_arg Name
parent_con (Name
i, Bang
str, Type
ty)
= do { L SrcSpanAnnN
li RdrName
i' <- String -> Name -> CvtM (LocatedN RdrName)
fldNameN (Name -> String
nameBase Name
parent_con) Name
i
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- BangType -> CvtM' ConversionFailReason (LHsType GhcPs)
cvt_arg (Bang
str,Type
ty)
; ConDeclField GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDeclField GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDeclField GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDeclField GhcPs)))
-> ConDeclField GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (ConDeclField GhcPs))
forall a b. (a -> b) -> a -> b
$ ConDeclField
{ cd_fld_ext :: XConDeclField GhcPs
cd_fld_ext = XConDeclField GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_names
= [SrcAnn NoEpAnns
-> FieldOcc GhcPs -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
li) (FieldOcc GhcPs -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
-> FieldOcc GhcPs -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
forall a b. (a -> b) -> a -> b
$ XCFieldOcc GhcPs -> XRec GhcPs RdrName -> FieldOcc GhcPs
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcPs
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
li RdrName
i')]
, cd_fld_type :: LHsType GhcPs
cd_fld_type = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty'
, cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_doc = Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing} }
cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs :: [DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs [DerivClause]
cs = do { (DerivClause
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)))
-> [DerivClause]
-> CvtM'
ConversionFailReason
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DerivClause -> CvtM (LHsDerivingClause GhcPs)
DerivClause
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs))
cvtDerivClause [DerivClause]
cs }
cvt_fundep :: TH.FunDep -> CvtM (LHsFunDep GhcPs)
cvt_fundep :: FunDep -> CvtM (LHsFunDep GhcPs)
cvt_fundep (TH.FunDep [Name]
xs [Name]
ys) = do { [LocatedN RdrName]
xs' <- (Name -> CvtM (LocatedN RdrName))
-> [Name] -> CvtM' ConversionFailReason [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (LocatedN RdrName)
tNameN [Name]
xs
; [LocatedN RdrName]
ys' <- (Name -> CvtM (LocatedN RdrName))
-> [Name] -> CvtM' ConversionFailReason [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (LocatedN RdrName)
tNameN [Name]
ys
; FunDep GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (FunDep GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCFunDep GhcPs -> [LIdP GhcPs] -> [LIdP GhcPs] -> FunDep GhcPs
forall pass.
XCFunDep pass -> [LIdP pass] -> [LIdP pass] -> FunDep pass
Hs.FunDep XCFunDep GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LIdP GhcPs]
[LocatedN RdrName]
xs' [LIdP GhcPs]
[LocatedN RdrName]
ys') }
cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)
cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)
cvtForD (ImportF Callconv
callconv Safety
safety String
from Name
nm Type
ty) =
do { SrcSpan
l <- CvtM SrcSpan
getL
; if
| Callconv
callconv Callconv -> Callconv -> Bool
forall a. Eq a => a -> a -> Bool
== Callconv
TH.Prim Bool -> Bool -> Bool
|| Callconv
callconv Callconv -> Callconv -> Bool
forall a. Eq a => a -> a -> Bool
== Callconv
TH.JavaScript
-> ForeignImport GhcPs -> CvtM (ForeignDecl GhcPs)
mk_imp (XCImport GhcPs
-> XRec GhcPs CCallConv
-> XRec GhcPs Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport GhcPs
forall pass.
XCImport pass
-> XRec pass CCallConv
-> XRec pass Safety
-> Maybe Header
-> CImportSpec
-> ForeignImport pass
CImport (SrcSpan -> SourceText -> GenLocated SrcSpan SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (SourceText -> GenLocated SrcSpan SourceText)
-> SourceText -> GenLocated SrcSpan SourceText
forall a b. (a -> b) -> a -> b
$ String -> SourceText
quotedSourceText String
from) (SrcSpan -> CCallConv -> GenLocated SrcSpan CCallConv
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Callconv -> CCallConv
cvt_conv Callconv
callconv)) (SrcSpan -> Safety -> GenLocated SrcSpan Safety
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Safety
safety') Maybe Header
forall a. Maybe a
Nothing
(CCallTarget -> CImportSpec
CFunction (SourceText -> FastString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget (FastString -> SourceText
SourceText FastString
fromtxt)
FastString
fromtxt Maybe Unit
forall a. Maybe a
Nothing
Bool
True)))
| Just ForeignImport GhcPs
impspec <- GenLocated SrcSpan CCallConv
-> GenLocated SrcSpan Safety
-> FastString
-> String
-> GenLocated SrcSpan SourceText
-> Maybe (ForeignImport GhcPs)
forall (p :: Pass).
GenLocated SrcSpan CCallConv
-> GenLocated SrcSpan Safety
-> FastString
-> String
-> GenLocated SrcSpan SourceText
-> Maybe (ForeignImport (GhcPass p))
parseCImport (SrcSpan -> CCallConv -> GenLocated SrcSpan CCallConv
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Callconv -> CCallConv
cvt_conv Callconv
callconv)) (SrcSpan -> Safety -> GenLocated SrcSpan Safety
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Safety
safety')
(String -> FastString
mkFastString (Name -> String
TH.nameBase Name
nm))
String
from (SrcSpan -> SourceText -> GenLocated SrcSpan SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (SourceText -> GenLocated SrcSpan SourceText)
-> SourceText -> GenLocated SrcSpan SourceText
forall a b. (a -> b) -> a -> b
$ String -> SourceText
quotedSourceText String
from)
-> ForeignImport GhcPs -> CvtM (ForeignDecl GhcPs)
mk_imp ForeignImport GhcPs
impspec
| Bool
otherwise
-> ConversionFailReason -> CvtM (ForeignDecl GhcPs)
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason -> CvtM (ForeignDecl GhcPs))
-> ConversionFailReason -> CvtM (ForeignDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ String -> ConversionFailReason
InvalidCCallImpent String
from }
where
fromtxt :: FastString
fromtxt = String -> FastString
mkFastString String
from
mk_imp :: ForeignImport GhcPs -> CvtM (ForeignDecl GhcPs)
mk_imp ForeignImport GhcPs
impspec
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
ty
; ForeignDecl GhcPs -> CvtM (ForeignDecl GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignImport { fd_i_ext :: XForeignImport GhcPs
fd_i_ext = XForeignImport GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, fd_name :: LIdP GhcPs
fd_name = LIdP GhcPs
LocatedN RdrName
nm'
, fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'
, fd_fi :: ForeignImport GhcPs
fd_fi = ForeignImport GhcPs
impspec })
}
safety' :: Safety
safety' = case Safety
safety of
Safety
Unsafe -> Safety
PlayRisky
Safety
Safe -> Safety
PlaySafe
Safety
Interruptible -> Safety
PlayInterruptible
cvtForD (ExportF Callconv
callconv String
as Name
nm Type
ty)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
ty
; SrcSpan
l <- CvtM SrcSpan
getL
; let astxt :: FastString
astxt = String -> FastString
mkFastString String
as
; let e :: ForeignExport GhcPs
e = XCExport GhcPs -> XRec GhcPs CExportSpec -> ForeignExport GhcPs
forall pass.
XCExport pass -> XRec pass CExportSpec -> ForeignExport pass
CExport (SrcSpan -> SourceText -> GenLocated SrcSpan SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (FastString -> SourceText
SourceText FastString
astxt)) (SrcSpan -> CExportSpec -> GenLocated SrcSpan CExportSpec
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (SourceText -> FastString -> CCallConv -> CExportSpec
CExportStatic (FastString -> SourceText
SourceText FastString
astxt)
FastString
astxt
(Callconv -> CCallConv
cvt_conv Callconv
callconv)))
; ForeignDecl GhcPs -> CvtM (ForeignDecl GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignDecl GhcPs -> CvtM (ForeignDecl GhcPs))
-> ForeignDecl GhcPs -> CvtM (ForeignDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ ForeignExport { fd_e_ext :: XForeignExport GhcPs
fd_e_ext = XForeignExport GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, fd_name :: LIdP GhcPs
fd_name = LIdP GhcPs
LocatedN RdrName
nm'
, fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'
, fd_fe :: ForeignExport GhcPs
fd_fe = ForeignExport GhcPs
e } }
cvt_conv :: TH.Callconv -> CCallConv
cvt_conv :: Callconv -> CCallConv
cvt_conv Callconv
TH.CCall = CCallConv
CCallConv
cvt_conv Callconv
TH.StdCall = CCallConv
StdCallConv
cvt_conv Callconv
TH.CApi = CCallConv
CApiConv
cvt_conv Callconv
TH.Prim = CCallConv
PrimCallConv
cvt_conv Callconv
TH.JavaScript = CCallConv
JavaScriptCallConv
cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl GhcPs))
cvtPragmaD :: Pragma -> CvtM' ConversionFailReason (Maybe (LHsDecl GhcPs))
cvtPragmaD (InlineP Name
nm Inline
inline RuleMatch
rm Phases
phases)
= do {
LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vcNameN Name
nm
; let dflt :: Activation
dflt = Inline -> Activation
dfltActivation Inline
inline
; let src :: Inline -> FastString
src Inline
TH.NoInline = String -> FastString
fsLit String
"{-# NOINLINE"
src Inline
TH.Inline = String -> FastString
fsLit String
"{-# INLINE"
src Inline
TH.Inlinable = String -> FastString
fsLit String
"{-# INLINABLE"
; let ip :: InlinePragma
ip = InlinePragma { inl_src :: SourceText
inl_src = Inline -> SourceText
toSrcTxt Inline
inline
, inl_inline :: InlineSpec
inl_inline = Inline -> SourceText -> InlineSpec
cvtInline Inline
inline (Inline -> SourceText
toSrcTxt Inline
inline)
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatch -> RuleMatchInfo
cvtRuleMatch RuleMatch
rm
, inl_act :: Activation
inl_act = Phases -> Activation -> Activation
cvtPhases Phases
phases Activation
dflt
, inl_sat :: Maybe SumAlt
inl_sat = Maybe SumAlt
forall a. Maybe a
Nothing }
where
toSrcTxt :: Inline -> SourceText
toSrcTxt Inline
a = FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ Inline -> FastString
src Inline
a
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField (Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XInlineSig GhcPs -> LIdP GhcPs -> InlinePragma -> Sig GhcPs
forall pass.
XInlineSig pass -> LIdP pass -> InlinePragma -> Sig pass
InlineSig XInlineSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
nm' InlinePragma
ip }
cvtPragmaD (OpaqueP Name
nm)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; let ip :: InlinePragma
ip = InlinePragma { inl_src :: SourceText
inl_src = SourceText
srcTxt
, inl_inline :: InlineSpec
inl_inline = SourceText -> InlineSpec
Opaque SourceText
srcTxt
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
Hs.FunLike
, inl_act :: Activation
inl_act = Activation
NeverActive
, inl_sat :: Maybe SumAlt
inl_sat = Maybe SumAlt
forall a. Maybe a
Nothing }
where
srcTxt :: SourceText
srcTxt = FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"{-# OPAQUE"
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField (Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XInlineSig GhcPs -> LIdP GhcPs -> InlinePragma -> Sig GhcPs
forall pass.
XInlineSig pass -> LIdP pass -> InlinePragma -> Sig pass
InlineSig XInlineSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
nm' InlinePragma
ip }
cvtPragmaD (SpecialiseP Name
nm Type
ty Maybe Inline
inline Phases
phases)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
nm
; GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
ty
; let src :: Inline -> FastString
src Inline
TH.NoInline = String -> FastString
fsLit String
"{-# SPECIALISE NOINLINE"
src Inline
TH.Inline = String -> FastString
fsLit String
"{-# SPECIALISE INLINE"
src Inline
TH.Inlinable = String -> FastString
fsLit String
"{-# SPECIALISE INLINE"
; let (InlineSpec
inline', Activation
dflt, SourceText
srcText) = case Maybe Inline
inline of
Just Inline
inline1 -> (Inline -> SourceText -> InlineSpec
cvtInline Inline
inline1 (Inline -> SourceText
toSrcTxt Inline
inline1), Inline -> Activation
dfltActivation Inline
inline1,
Inline -> SourceText
toSrcTxt Inline
inline1)
Maybe Inline
Nothing -> (InlineSpec
NoUserInlinePrag, Activation
AlwaysActive,
FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"{-# SPECIALISE")
where
toSrcTxt :: Inline -> SourceText
toSrcTxt Inline
a = FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ Inline -> FastString
src Inline
a
; let ip :: InlinePragma
ip = InlinePragma { inl_src :: SourceText
inl_src = SourceText
srcText
, inl_inline :: InlineSpec
inl_inline = InlineSpec
inline'
, inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
Hs.FunLike
, inl_act :: Activation
inl_act = Phases -> Activation -> Activation
cvtPhases Phases
phases Activation
dflt
, inl_sat :: Maybe SumAlt
inl_sat = Maybe SumAlt
forall a. Maybe a
Nothing }
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField (Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XSpecSig GhcPs
-> LIdP GhcPs -> [LHsSigType GhcPs] -> InlinePragma -> Sig GhcPs
forall pass.
XSpecSig pass
-> LIdP pass -> [LHsSigType pass] -> InlinePragma -> Sig pass
SpecSig XSpecSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
nm' [LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'] InlinePragma
ip }
cvtPragmaD (SpecialiseInstP Type
ty)
= do { GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
ty
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField (Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
XSpecInstSig GhcPs -> LHsSigType GhcPs -> Sig GhcPs
forall pass. XSpecInstSig pass -> LHsSigType pass -> Sig pass
SpecInstSig (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, (FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"{-# SPECIALISE")) LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' }
cvtPragmaD (RuleP String
nm Maybe [TyVarBndr ()]
ty_bndrs [RuleBndr]
tm_bndrs Exp
lhs Exp
rhs Phases
phases)
= do { let nm' :: FastString
nm' = String -> FastString
mkFastString String
nm
; LocatedAn NoEpAnns FastString
rd_name' <- FastString -> CvtM (LocatedAn NoEpAnns FastString)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA FastString
nm'
; let act :: Activation
act = Phases -> Activation -> Activation
cvtPhases Phases
phases Activation
AlwaysActive
; Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
ty_bndrs' <- ([TyVarBndr ()]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
-> Maybe [TyVarBndr ()]
-> CvtM'
ConversionFailReason
(Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse [TyVarBndr ()] -> CvtM [LHsTyVarBndr () GhcPs]
[TyVarBndr ()]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs Maybe [TyVarBndr ()]
ty_bndrs
; [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
tm_bndrs' <- (RuleBndr
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)))
-> [RuleBndr]
-> CvtM'
ConversionFailReason
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RuleBndr -> CvtM (LRuleBndr GhcPs)
RuleBndr
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs))
cvtRuleBndr [RuleBndr]
tm_bndrs
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
lhs
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
rhs
; LocatedAn AnnListItem (RuleDecl GhcPs)
rule <- RuleDecl GhcPs -> CvtM (LocatedAn AnnListItem (RuleDecl GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RuleDecl GhcPs -> CvtM (LocatedAn AnnListItem (RuleDecl GhcPs)))
-> RuleDecl GhcPs -> CvtM (LocatedAn AnnListItem (RuleDecl GhcPs))
forall a b. (a -> b) -> a -> b
$
HsRule { rd_ext :: XHsRule GhcPs
rd_ext = (EpAnn HsRuleAnn
forall a. EpAnn a
noAnn, String -> SourceText
quotedSourceText String
nm)
, rd_name :: XRec GhcPs FastString
rd_name = XRec GhcPs FastString
LocatedAn NoEpAnns FastString
rd_name'
, rd_act :: Activation
rd_act = Activation
act
, rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
rd_tyvs = Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
ty_bndrs'
, rd_tmvs :: [LRuleBndr GhcPs]
rd_tmvs = [LRuleBndr GhcPs]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
tm_bndrs'
, rd_lhs :: LHsExpr GhcPs
rd_lhs = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs'
, rd_rhs :: LHsExpr GhcPs
rd_rhs = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs' }
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XRuleD GhcPs -> RuleDecls GhcPs -> HsDecl GhcPs
forall p. XRuleD p -> RuleDecls p -> HsDecl p
Hs.RuleD XRuleD GhcPs
NoExtField
noExtField
(RuleDecls GhcPs -> HsDecl GhcPs)
-> RuleDecls GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ HsRules { rds_ext :: XCRuleDecls GhcPs
rds_ext = (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"{-# RULES")
, rds_rules :: [LRuleDecl GhcPs]
rds_rules = [LRuleDecl GhcPs
LocatedAn AnnListItem (RuleDecl GhcPs)
rule] }
}
cvtPragmaD (AnnP AnnTarget
target Exp
exp)
= do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
exp' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
exp
; AnnProvenance GhcPs
target' <- case AnnTarget
target of
AnnTarget
ModuleAnnotation -> AnnProvenance GhcPs
-> CvtM' ConversionFailReason (AnnProvenance GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnProvenance GhcPs
forall pass. AnnProvenance pass
ModuleAnnProvenance
TypeAnnotation Name
n -> do
RdrName
n' <- Name -> CvtM RdrName
tconName Name
n
(LocatedN RdrName -> AnnProvenance GhcPs)
-> RdrName -> CvtM' ConversionFailReason (AnnProvenance GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LIdP GhcPs -> AnnProvenance GhcPs
LocatedN RdrName -> AnnProvenance GhcPs
forall pass. LIdP pass -> AnnProvenance pass
TypeAnnProvenance RdrName
n'
ValueAnnotation Name
n -> do
RdrName
n' <- Name -> CvtM RdrName
vcName Name
n
(LocatedN RdrName -> AnnProvenance GhcPs)
-> RdrName -> CvtM' ConversionFailReason (AnnProvenance GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LIdP GhcPs -> AnnProvenance GhcPs
LocatedN RdrName -> AnnProvenance GhcPs
forall pass. LIdP pass -> AnnProvenance pass
ValueAnnProvenance RdrName
n'
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XAnnD GhcPs -> AnnDecl GhcPs -> HsDecl GhcPs
forall p. XAnnD p -> AnnDecl p -> HsDecl p
Hs.AnnD XAnnD GhcPs
NoExtField
noExtField
(AnnDecl GhcPs -> HsDecl GhcPs) -> AnnDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XHsAnnotation GhcPs
-> AnnProvenance GhcPs -> LHsExpr GhcPs -> AnnDecl GhcPs
forall pass.
XHsAnnotation pass
-> AnnProvenance pass -> XRec pass (HsExpr pass) -> AnnDecl pass
HsAnnotation (EpAnn AnnPragma
forall a. EpAnn a
noAnn, (FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"{-# ANN")) AnnProvenance GhcPs
target' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
exp'
}
cvtPragmaD (LineP SumAlt
line String
file)
= do { SrcSpan -> CvtM ()
setL (SrcLoc -> SrcSpan
srcLocSpan (FastString -> SumAlt -> SumAlt -> SrcLoc
mkSrcLoc (String -> FastString
fsLit String
file) SumAlt
line SumAlt
1))
; Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Maybe a
Nothing
}
cvtPragmaD (CompleteP [Name]
cls Maybe Name
mty)
= do { Located [LocatedN RdrName]
cls' <- CvtM' ConversionFailReason [LocatedN RdrName]
-> CvtM (Located [LocatedN RdrName])
forall a. CvtM a -> CvtM (Located a)
wrapL (CvtM' ConversionFailReason [LocatedN RdrName]
-> CvtM (Located [LocatedN RdrName]))
-> CvtM' ConversionFailReason [LocatedN RdrName]
-> CvtM (Located [LocatedN RdrName])
forall a b. (a -> b) -> a -> b
$ (Name -> CvtM (LocatedN RdrName))
-> [Name] -> CvtM' ConversionFailReason [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (LocatedN RdrName)
cNameN [Name]
cls
; Maybe (LocatedN RdrName)
mty' <- (Name -> CvtM (LocatedN RdrName))
-> Maybe Name
-> CvtM' ConversionFailReason (Maybe (LocatedN RdrName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Name -> CvtM (LocatedN RdrName)
tconNameN Maybe Name
mty
; HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> HsDecl GhcPs
-> CvtM'
ConversionFailReason
(Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD GhcPs
NoExtField
noExtField
(Sig GhcPs -> HsDecl GhcPs) -> Sig GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XCompleteMatchSig GhcPs
-> XRec GhcPs [LIdP GhcPs] -> Maybe (LIdP GhcPs) -> Sig GhcPs
forall pass.
XCompleteMatchSig pass
-> XRec pass [LIdP pass] -> Maybe (LIdP pass) -> Sig pass
CompleteMatchSig (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, SourceText
NoSourceText) XRec GhcPs [LIdP GhcPs]
Located [LocatedN RdrName]
cls' Maybe (LIdP GhcPs)
Maybe (LocatedN RdrName)
mty' }
dfltActivation :: TH.Inline -> Activation
dfltActivation :: Inline -> Activation
dfltActivation Inline
TH.NoInline = Activation
NeverActive
dfltActivation Inline
_ = Activation
AlwaysActive
cvtInline :: TH.Inline -> SourceText -> Hs.InlineSpec
cvtInline :: Inline -> SourceText -> InlineSpec
cvtInline Inline
TH.NoInline SourceText
srcText = SourceText -> InlineSpec
Hs.NoInline SourceText
srcText
cvtInline Inline
TH.Inline SourceText
srcText = SourceText -> InlineSpec
Hs.Inline SourceText
srcText
cvtInline Inline
TH.Inlinable SourceText
srcText = SourceText -> InlineSpec
Hs.Inlinable SourceText
srcText
cvtRuleMatch :: TH.RuleMatch -> RuleMatchInfo
cvtRuleMatch :: RuleMatch -> RuleMatchInfo
cvtRuleMatch RuleMatch
TH.ConLike = RuleMatchInfo
Hs.ConLike
cvtRuleMatch RuleMatch
TH.FunLike = RuleMatchInfo
Hs.FunLike
cvtPhases :: TH.Phases -> Activation -> Activation
cvtPhases :: Phases -> Activation -> Activation
cvtPhases Phases
AllPhases Activation
dflt = Activation
dflt
cvtPhases (FromPhase SumAlt
i) Activation
_ = SourceText -> SumAlt -> Activation
ActiveAfter SourceText
NoSourceText SumAlt
i
cvtPhases (BeforePhase SumAlt
i) Activation
_ = SourceText -> SumAlt -> Activation
ActiveBefore SourceText
NoSourceText SumAlt
i
cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
cvtRuleBndr :: RuleBndr -> CvtM (LRuleBndr GhcPs)
cvtRuleBndr (RuleVar Name
n)
= do { LocatedN RdrName
n' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
n
; RuleBndr GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RuleBndr GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)))
-> RuleBndr GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs))
forall a b. (a -> b) -> a -> b
$ XCRuleBndr GhcPs -> LIdP GhcPs -> RuleBndr GhcPs
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
Hs.RuleBndr XCRuleBndr GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
n' }
cvtRuleBndr (TypedRuleVar Name
n Type
ty)
= do { LocatedN RdrName
n' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
n
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; RuleBndr GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RuleBndr GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)))
-> RuleBndr GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs))
forall a b. (a -> b) -> a -> b
$ XRuleBndrSig GhcPs
-> LIdP GhcPs -> HsPatSigType GhcPs -> RuleBndr GhcPs
forall pass.
XRuleBndrSig pass
-> LIdP pass -> HsPatSigType pass -> RuleBndr pass
Hs.RuleBndrSig XRuleBndrSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
n' (HsPatSigType GhcPs -> RuleBndr GhcPs)
-> HsPatSigType GhcPs -> RuleBndr GhcPs
forall a b. (a -> b) -> a -> b
$ EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnnCO
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' }
cvtLocalDecs :: THDeclDescriptor -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs :: THDeclDescriptor -> [Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs THDeclDescriptor
declDescr [Dec]
ds
= case (Dec -> Either (String, Exp) Dec)
-> [Dec] -> ([(String, Exp)], [Dec])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith Dec -> Either (String, Exp) Dec
is_ip_bind [Dec]
ds of
([], []) -> HsLocalBinds GhcPs -> CvtM (HsLocalBinds GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField
noExtField)
([], [Dec]
_) -> do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds' <- [Dec] -> CvtM [LHsDecl GhcPs]
cvtDecs [Dec]
ds
let ([GenLocated SrcSpanAnnA (HsBind GhcPs)]
binds, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
prob_sigs) = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (HsBind GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsBind GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (HsBind GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_bind [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds'
let ([GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bads) = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (Sig GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (Sig GhcPs)],
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Either
(GenLocated SrcSpanAnnA (Sig GhcPs))
(GenLocated SrcSpanAnnA (HsDecl GhcPs))
is_sig [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
prob_sigs
Maybe (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bads) ((NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ())
-> (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> CvtM' ConversionFailReason Any)
-> CvtM ()
forall a b. (a -> b) -> a -> b
$ \ NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
bad_decls ->
ConversionFailReason -> CvtM' ConversionFailReason Any
forall a. ConversionFailReason -> CvtM a
failWith (THDeclDescriptor -> IllegalDecls -> ConversionFailReason
IllegalDeclaration THDeclDescriptor
declDescr (IllegalDecls -> ConversionFailReason)
-> IllegalDecls -> ConversionFailReason
forall a b. (a -> b) -> a -> b
$ NonEmpty (LHsDecl GhcPs) -> IllegalDecls
IllegalDecls NonEmpty (LHsDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
bad_decls)
HsLocalBinds GhcPs -> CvtM (HsLocalBinds GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn (XValBinds GhcPs GhcPs
-> LHsBinds GhcPs -> [LSig GhcPs] -> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
AnnSortKey
NoAnnSortKey ([GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
forall a. [a] -> Bag a
listToBag [GenLocated SrcSpanAnnA (HsBind GhcPs)]
binds) [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs))
([(String, Exp)]
ip_binds, []) -> do
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
binds <- ((String, Exp)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (IPBind GhcPs)))
-> [(String, Exp)]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (IPBind GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((String
-> Exp
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (IPBind GhcPs)))
-> (String, Exp)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (IPBind GhcPs))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Exp -> CvtM (LIPBind GhcPs)
String
-> Exp
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (IPBind GhcPs))
cvtImplicitParamBind) [(String, Exp)]
ip_binds
HsLocalBinds GhcPs -> CvtM (HsLocalBinds GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (XHsIPBinds GhcPs GhcPs -> HsIPBinds GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds XHsIPBinds GhcPs GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn (XIPBinds GhcPs -> [LIPBind GhcPs] -> HsIPBinds GhcPs
forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
IPBinds XIPBinds GhcPs
NoExtField
noExtField [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
binds))
(((String, Exp)
_:[(String, Exp)]
_), (Dec
_:[Dec]
_)) ->
ConversionFailReason -> CvtM (HsLocalBinds GhcPs)
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
ImplicitParamsWithOtherBinds
cvtClause :: HsMatchContext GhcPs
-> TH.Clause -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
cvtClause :: HsMatchContext GhcPs
-> Clause -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtClause HsMatchContext GhcPs
ctxt (Clause [Pat]
ps Body
body [Dec]
wheres)
= do { [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
ps
; let pps :: [GenLocated SrcSpanAnnA (Pat GhcPs)]
pps = (GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps'
; [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g' <- Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard Body
body
; HsLocalBinds GhcPs
ds' <- THDeclDescriptor -> [Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs THDeclDescriptor
WhereClause [Dec]
wheres
; Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Hs.Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsMatchContext GhcPs
ctxt [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pps (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
emptyComments [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g' HsLocalBinds GhcPs
ds') }
cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)
cvtImplicitParamBind :: String -> Exp -> CvtM (LIPBind GhcPs)
cvtImplicitParamBind String
n Exp
e = do
Located HsIPName
n' <- CvtM HsIPName -> CvtM (Located HsIPName)
forall a. CvtM a -> CvtM (Located a)
wrapL (String -> CvtM HsIPName
ipName String
n)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
IPBind GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (IPBind GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCIPBind GhcPs
-> XRec GhcPs HsIPName -> LHsExpr GhcPs -> IPBind GhcPs
forall id.
XCIPBind id -> XRec id HsIPName -> LHsExpr id -> IPBind id
IPBind XCIPBind GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (Located HsIPName -> LocatedAn NoEpAnns HsIPName
forall e ann. Located e -> LocatedAn ann e
reLocA Located HsIPName
n') LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e')
cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
cvtl :: Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e = CvtM (HsExpr GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (Exp -> CvtM (HsExpr GhcPs)
cvt Exp
e)
where
cvt :: Exp -> CvtM (HsExpr GhcPs)
cvt (VarE Name
s) = do { RdrName
s' <- Name -> CvtM RdrName
vName Name
s; (LocatedN RdrName -> HsExpr GhcPs)
-> RdrName -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField) RdrName
s' }
cvt (ConE Name
s) = do { RdrName
s' <- Name -> CvtM RdrName
cName Name
s; (LocatedN RdrName -> HsExpr GhcPs)
-> RdrName -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField) RdrName
s' }
cvt (LitE Lit
l)
| Lit -> Bool
overloadedLit Lit
l = (Lit -> CvtM (HsOverLit GhcPs))
-> (HsOverLit GhcPs -> HsExpr GhcPs)
-> (HsOverLit GhcPs -> Bool)
-> CvtM (HsExpr GhcPs)
forall (l :: * -> *).
(Lit -> CvtM (l GhcPs))
-> (l GhcPs -> HsExpr GhcPs)
-> (l GhcPs -> Bool)
-> CvtM (HsExpr GhcPs)
go Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit (XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcPs
EpAnnCO
noComments)
(PprPrec -> HsOverLit GhcPs -> Bool
forall x. PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
appPrec)
| Bool
otherwise = (Lit -> CvtM (HsLit GhcPs))
-> (HsLit GhcPs -> HsExpr GhcPs)
-> (HsLit GhcPs -> Bool)
-> CvtM (HsExpr GhcPs)
forall (l :: * -> *).
(Lit -> CvtM (l GhcPs))
-> (l GhcPs -> HsExpr GhcPs)
-> (l GhcPs -> Bool)
-> CvtM (HsExpr GhcPs)
go Lit -> CvtM (HsLit GhcPs)
cvtLit (XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
EpAnnCO
noComments)
(PprPrec -> HsLit GhcPs -> Bool
forall x. PprPrec -> HsLit x -> Bool
hsLitNeedsParens PprPrec
appPrec)
where
go :: (Lit -> CvtM (l GhcPs))
-> (l GhcPs -> HsExpr GhcPs)
-> (l GhcPs -> Bool)
-> CvtM (HsExpr GhcPs)
go :: forall (l :: * -> *).
(Lit -> CvtM (l GhcPs))
-> (l GhcPs -> HsExpr GhcPs)
-> (l GhcPs -> Bool)
-> CvtM (HsExpr GhcPs)
go Lit -> CvtM (l GhcPs)
cvt_lit l GhcPs -> HsExpr GhcPs
mk_expr l GhcPs -> Bool
is_compound_lit = do
l GhcPs
l' <- Lit -> CvtM (l GhcPs)
cvt_lit Lit
l
let e' :: HsExpr GhcPs
e' = l GhcPs -> HsExpr GhcPs
mk_expr l GhcPs
l'
if l GhcPs -> Bool
is_compound_lit l GhcPs
l' then (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr GhcPs -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar HsExpr GhcPs
e' else HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsExpr GhcPs
e'
cvt (AppE Exp
e1 Exp
e2) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1' <- PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
opPrec (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e1
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2' <- PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e2
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnnCO
noComments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2' }
cvt (AppTypeE Exp
e Type
t) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
opPrec (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; GenLocated SrcSpanAnnA (HsType GhcPs)
t' <- PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec (GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XAppTypeE GhcPs
-> LHsExpr GhcPs
-> XRec GhcPs (HsToken "@")
-> HsWildCardBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
-> HsExpr GhcPs
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcPs
NoExtField
noExtField LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' XRec GhcPs (HsToken "@")
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok
(HsWildCardBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
-> HsExpr GhcPs)
-> HsWildCardBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
-> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsType GhcPs)
t' }
cvt (LamE [] Exp
e) = Exp -> CvtM (HsExpr GhcPs)
cvt Exp
e
cvt (LamE [Pat]
ps Exp
e) = do { [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
ps; GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; let pats :: [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats = (GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps'
; Origin
th_origin <- CvtM Origin
getOrigin
; (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs)
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
NoExtField
noExtField (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs)
-> (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin)
[HsMatchContext GhcPs
-> [LPat GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcAnn NoEpAnns) =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext GhcPs
forall p. HsMatchContext p
LambdaExpr [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats GenLocated SrcSpanAnnA (HsExpr GhcPs)
e']}
cvt (LamCaseE [Match]
ms) = do { [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms' <- (Match
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Match]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext GhcPs
-> Match -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtMatch (HsMatchContext GhcPs
-> Match -> CvtM (LMatch GhcPs (LHsExpr GhcPs)))
-> HsMatchContext GhcPs
-> Match
-> CvtM (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> HsMatchContext GhcPs
forall p. LamCaseVariant -> HsMatchContext p
LamCaseAlt LamCaseVariant
LamCase) [Match]
ms
; Origin
th_origin <- CvtM Origin
getOrigin
; (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs)
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XLamCase GhcPs
-> LamCaseVariant
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LamCaseVariant
LamCase (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs)
-> (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms'
}
cvt (LamCasesE [Clause]
ms)
| [Clause] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Clause]
ms = ConversionFailReason -> CvtM (HsExpr GhcPs)
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
CasesExprWithoutAlts
| Bool
otherwise = do { [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms' <- (Clause
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Clause]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext GhcPs
-> Clause -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtClause (HsMatchContext GhcPs
-> Clause -> CvtM (LMatch GhcPs (LHsExpr GhcPs)))
-> HsMatchContext GhcPs
-> Clause
-> CvtM (LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> HsMatchContext GhcPs
forall p. LamCaseVariant -> HsMatchContext p
LamCaseAlt LamCaseVariant
LamCases) [Clause]
ms
; Origin
th_origin <- CvtM Origin
getOrigin
; (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs)
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XLamCase GhcPs
-> LamCaseVariant
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LamCaseVariant
LamCases (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs)
-> (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms'
}
cvt (TupE [Maybe Exp]
es) = [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup [Maybe Exp]
es Boxity
Boxed
cvt (UnboxedTupE [Maybe Exp]
es) = [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup [Maybe Exp]
es Boxity
Unboxed
cvt (UnboxedSumE Exp
e SumAlt
alt SumAlt
arity) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; SumAlt -> SumAlt -> CvtM ()
unboxedSumChecks SumAlt
alt SumAlt
arity
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitSum GhcPs
-> SumAlt -> SumAlt -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XExplicitSum p -> SumAlt -> SumAlt -> LHsExpr p -> HsExpr p
ExplicitSum XExplicitSum GhcPs
EpAnn AnnExplicitSum
forall a. EpAnn a
noAnn SumAlt
alt SumAlt
arity LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'}
cvt (CondE Exp
x Exp
y Exp
z) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y; GenLocated SrcSpanAnnA (HsExpr GhcPs)
z' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
z;
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn AnnsIf -> HsExpr GhcPs
mkHsIf LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
z' EpAnn AnnsIf
forall a. EpAnn a
noAnn }
cvt (MultiIfE [(Guard, Exp)]
alts)
| [(Guard, Exp)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Guard, Exp)]
alts = ConversionFailReason -> CvtM (HsExpr GhcPs)
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
MultiWayIfWithoutAlts
| Bool
otherwise = do { [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
alts' <- ((Guard, Exp)
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [(Guard, Exp)]
-> CvtM'
ConversionFailReason
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Guard, Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
(Guard, Exp)
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
cvtpair [(Guard, Exp)]
alts
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XMultiIf GhcPs -> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr GhcPs
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
alts' }
cvt (LetE [Dec]
ds Exp
e) = do { HsLocalBinds GhcPs
ds' <- THDeclDescriptor -> [Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs THDeclDescriptor
LetExpression [Dec]
ds
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XLet GhcPs
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> LHsExpr GhcPs
-> HsExpr GhcPs
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet GhcPs
EpAnnCO
forall a. EpAnn a
noAnn LHsToken "let" GhcPs
GenLocated TokenLocation (HsToken "let")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok HsLocalBinds GhcPs
ds' LHsToken "in" GhcPs
GenLocated TokenLocation (HsToken "in")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'}
cvt (CaseE Exp
e [Match]
ms) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms' <- (Match
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Match]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext GhcPs
-> Match -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtMatch HsMatchContext GhcPs
forall p. HsMatchContext p
CaseAlt) [Match]
ms
; Origin
th_origin <- CvtM Origin
getOrigin
; (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs)
-> [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XCase GhcPs
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcPs
EpAnn EpAnnHsCase
forall a. EpAnn a
noAnn LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs)
-> (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
AnnList
[GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
[LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms' }
cvt (DoE Maybe ModName
m [Stmt]
ss) = HsDoFlavour -> [Stmt] -> CvtM (HsExpr GhcPs)
cvtHsDo (Maybe ModuleName -> HsDoFlavour
DoExpr (ModName -> ModuleName
mk_mod (ModName -> ModuleName) -> Maybe ModName -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModName
m)) [Stmt]
ss
cvt (MDoE Maybe ModName
m [Stmt]
ss) = HsDoFlavour -> [Stmt] -> CvtM (HsExpr GhcPs)
cvtHsDo (Maybe ModuleName -> HsDoFlavour
MDoExpr (ModName -> ModuleName
mk_mod (ModName -> ModuleName) -> Maybe ModName -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModName
m)) [Stmt]
ss
cvt (CompE [Stmt]
ss) = HsDoFlavour -> [Stmt] -> CvtM (HsExpr GhcPs)
cvtHsDo HsDoFlavour
ListComp [Stmt]
ss
cvt (ArithSeqE Range
dd) = do { ArithSeqInfo GhcPs
dd' <- Range -> CvtM (ArithSeqInfo GhcPs)
cvtDD Range
dd
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XArithSeq GhcPs
-> Maybe (SyntaxExpr GhcPs) -> ArithSeqInfo GhcPs -> HsExpr GhcPs
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing ArithSeqInfo GhcPs
dd' }
cvt (ListE [Exp]
xs)
| Just String
s <- [Exp] -> Maybe String
allCharLs [Exp]
xs = do { HsLit GhcPs
l' <- Lit -> CvtM (HsLit GhcPs)
cvtLit (String -> Lit
StringL String
s)
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
EpAnnCO
noComments HsLit GhcPs
l') }
| Bool
otherwise = do { [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs' <- (Exp
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [Exp]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
Exp
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
cvtl [Exp]
xs
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitList GhcPs -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs'
}
cvt (InfixE (Just Exp
x) Exp
s (Just Exp
y)) = Exp -> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs))
-> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
s
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y
; let px :: LHsExpr GhcPs
px = PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
opPrec LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x'
py :: LHsExpr GhcPs
py = PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
opPrec LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y'
; (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr GhcPs -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar
(HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
px LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' LHsExpr GhcPs
py }
cvt (InfixE Maybe Exp
Nothing Exp
s (Just Exp
y)) = Exp -> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs))
-> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
s; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y
; (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr GhcPs -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
XSectionR GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcPs
EpAnnCO
noComments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' }
cvt (InfixE (Just Exp
x) Exp
s Maybe Exp
Nothing ) = Exp -> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs))
-> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x; GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
s
; (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr GhcPs -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
XSectionL GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL GhcPs
EpAnnCO
noComments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' }
cvt (InfixE Maybe Exp
Nothing Exp
s Maybe Exp
Nothing ) = Exp -> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs))
-> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
s
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> HsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
s' }
cvt (UInfixE Exp
x Exp
s Exp
y) = Exp -> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs))
-> CvtM (HsExpr GhcPs) -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x
; let x'' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
x'' = case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' of
OpApp {} -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
x'
HsExpr GhcPs
_ -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x'
; LHsExpr GhcPs -> Exp -> Exp -> CvtM (HsExpr GhcPs)
cvtOpApp LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x'' Exp
s Exp
y }
cvt (ParensE Exp
e) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> HsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' }
cvt (SigE Exp
e Type
t) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; GenLocated SrcSpanAnnA (HsSigType GhcPs)
t' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
t
; let pe :: LHsExpr GhcPs
pe = PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
sigPrec LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
pe (GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsSigType GhcPs)
t') }
cvt (RecConE Name
c [FieldExp]
flds) = do { LocatedN RdrName
c' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
c
; [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds' <- (FieldExp
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [FieldExp]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((RdrName -> CvtM' ConversionFailReason (FieldOcc GhcPs))
-> FieldExp
-> CvtM
(LHsFieldBind
GhcPs
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(LHsExpr GhcPs))
forall t.
(RdrName -> CvtM t)
-> FieldExp
-> CvtM (LHsFieldBind GhcPs (LocatedAn NoEpAnns t) (LHsExpr GhcPs))
cvtFld ((LocatedN RdrName -> FieldOcc GhcPs)
-> RdrName -> CvtM' ConversionFailReason (FieldOcc GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LocatedN RdrName -> FieldOcc GhcPs
mkFieldOcc)) [FieldExp]
flds
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName
-> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon LocatedN RdrName
c' ([LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Maybe (XRec GhcPs RecFieldsDotDot)
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p arg.
[LHsRecField p arg]
-> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
HsRecFields [LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds' Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (GenLocated SrcSpan RecFieldsDotDot)
forall a. Maybe a
Nothing) EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn }
cvt (RecUpdE Exp
e [FieldExp]
flds) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; [GenLocated
SrcSpanAnnA
(HsFieldBind
(LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds'
<- (FieldExp
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [FieldExp]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA
(HsFieldBind
(LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((RdrName -> CvtM (AmbiguousFieldOcc GhcPs))
-> FieldExp
-> CvtM
(LHsFieldBind
GhcPs
(LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs))
(LHsExpr GhcPs))
forall t.
(RdrName -> CvtM t)
-> FieldExp
-> CvtM (LHsFieldBind GhcPs (LocatedAn NoEpAnns t) (LHsExpr GhcPs))
cvtFld ((LocatedN RdrName -> AmbiguousFieldOcc GhcPs)
-> RdrName -> CvtM (AmbiguousFieldOcc GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LocatedN RdrName -> AmbiguousFieldOcc GhcPs
mkAmbiguousFieldOcc))
[FieldExp]
flds
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XRecordUpd GhcPs
-> LHsExpr GhcPs -> LHsRecUpdFields GhcPs -> HsExpr GhcPs
forall p.
XRecordUpd p -> LHsExpr p -> LHsRecUpdFields p -> HsExpr p
RecordUpd XRecordUpd GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' (LHsRecUpdFields GhcPs -> HsExpr GhcPs)
-> LHsRecUpdFields GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
RegularRecUpdFields
{ xRecUpdFields :: XLHsRecUpdLabels GhcPs
xRecUpdFields = XLHsRecUpdLabels GhcPs
NoExtField
noExtField
, recUpdFields :: [LHsRecUpdField GhcPs GhcPs]
recUpdFields = [LHsRecUpdField GhcPs GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds' } }
cvt (StaticE Exp
e) = (LHsExpr GhcPs -> HsExpr GhcPs)
-> CvtM' ConversionFailReason (LHsExpr GhcPs)
-> CvtM (HsExpr GhcPs)
forall a b.
(a -> b)
-> CvtM' ConversionFailReason a -> CvtM' ConversionFailReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XStatic GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic XStatic GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) (CvtM' ConversionFailReason (LHsExpr GhcPs) -> CvtM (HsExpr GhcPs))
-> CvtM' ConversionFailReason (LHsExpr GhcPs)
-> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
cvt (UnboundVarE Name
s) = do
{ RdrName
s' <- Name -> CvtM RdrName
vcName Name
s
; (LocatedN RdrName -> HsExpr GhcPs)
-> RdrName -> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField) RdrName
s' }
cvt (LabelE String
s) = HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOverLabel GhcPs -> SourceText -> FastString -> HsExpr GhcPs
forall p. XOverLabel p -> SourceText -> FastString -> HsExpr p
HsOverLabel XOverLabel GhcPs
EpAnnCO
noComments SourceText
NoSourceText (String -> FastString
fsLit String
s)
cvt (ImplicitParamVarE String
n) = do { HsIPName
n' <- String -> CvtM HsIPName
ipName String
n; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XIPVar GhcPs -> HsIPName -> HsExpr GhcPs
forall p. XIPVar p -> HsIPName -> HsExpr p
HsIPVar XIPVar GhcPs
EpAnnCO
noComments HsIPName
n' }
cvt (GetFieldE Exp
exp String
f) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
exp
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XGetField GhcPs
-> LHsExpr GhcPs -> XRec GhcPs (DotFieldOcc GhcPs) -> HsExpr GhcPs
forall p.
XGetField p -> LHsExpr p -> XRec p (DotFieldOcc p) -> HsExpr p
HsGetField XGetField GhcPs
EpAnnCO
noComments LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'
(SrcAnn NoEpAnns
-> DotFieldOcc GhcPs
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
forall ann. SrcAnn ann
noSrcSpanA (XCDotFieldOcc GhcPs
-> XRec GhcPs FieldLabelString -> DotFieldOcc GhcPs
forall p.
XCDotFieldOcc p -> XRec p FieldLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc GhcPs
EpAnn AnnFieldLabel
forall a. EpAnn a
noAnn (SrcSpanAnnN
-> FieldLabelString -> GenLocated SrcSpanAnnN FieldLabelString
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
forall ann. SrcAnn ann
noSrcSpanA (FastString -> FieldLabelString
FieldLabelString (String -> FastString
fsLit String
f))))) }
cvt (ProjectionE NonEmpty String
xs) = HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XProjection GhcPs
-> NonEmpty (XRec GhcPs (DotFieldOcc GhcPs)) -> HsExpr GhcPs
forall p.
XProjection p -> NonEmpty (XRec p (DotFieldOcc p)) -> HsExpr p
HsProjection XProjection GhcPs
EpAnn AnnProjection
forall a. EpAnn a
noAnn (NonEmpty (XRec GhcPs (DotFieldOcc GhcPs)) -> HsExpr GhcPs)
-> NonEmpty (XRec GhcPs (DotFieldOcc GhcPs)) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ (String -> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
-> NonEmpty String
-> NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(SrcAnn NoEpAnns
-> DotFieldOcc GhcPs
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
forall ann. SrcAnn ann
noSrcSpanA (DotFieldOcc GhcPs
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
-> (String -> DotFieldOcc GhcPs)
-> String
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCDotFieldOcc GhcPs
-> XRec GhcPs FieldLabelString -> DotFieldOcc GhcPs
forall p.
XCDotFieldOcc p -> XRec p FieldLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc GhcPs
EpAnn AnnFieldLabel
forall a. EpAnn a
noAnn (GenLocated SrcSpanAnnN FieldLabelString -> DotFieldOcc GhcPs)
-> (String -> GenLocated SrcSpanAnnN FieldLabelString)
-> String
-> DotFieldOcc GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnN
-> FieldLabelString -> GenLocated SrcSpanAnnN FieldLabelString
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
forall ann. SrcAnn ann
noSrcSpanA (FieldLabelString -> GenLocated SrcSpanAnnN FieldLabelString)
-> (String -> FieldLabelString)
-> String
-> GenLocated SrcSpanAnnN FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString)
-> (String -> FastString) -> String -> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit) NonEmpty String
xs
cvt (TypedSpliceE Exp
e) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XTypedSplice GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XTypedSplice p -> LHsExpr p -> HsExpr p
HsTypedSplice (EpAnnCO
forall a. EpAnn a
noAnn, EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' }
cvt (TypedBracketE Exp
e) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XTypedBracket GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XTypedBracket p -> LHsExpr p -> HsExpr p
HsTypedBracket XTypedBracket GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' }
ensureValidOpExp :: TH.Exp -> CvtM a -> CvtM a
ensureValidOpExp :: forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp (VarE Name
_n) CvtM a
m = CvtM a
m
ensureValidOpExp (ConE Name
_n) CvtM a
m = CvtM a
m
ensureValidOpExp (UnboundVarE Name
_n) CvtM a
m = CvtM a
m
ensureValidOpExp Exp
_e CvtM a
_m = ConversionFailReason -> CvtM a
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
NonVarInInfixExpr
cvtFld :: (RdrName -> CvtM t) -> (TH.Name, TH.Exp)
-> CvtM (LHsFieldBind GhcPs (LocatedAn NoEpAnns t) (LHsExpr GhcPs))
cvtFld :: forall t.
(RdrName -> CvtM t)
-> FieldExp
-> CvtM (LHsFieldBind GhcPs (LocatedAn NoEpAnns t) (LHsExpr GhcPs))
cvtFld RdrName -> CvtM t
f (Name
v,Exp
e)
= do { LocatedA RdrName
v' <- Name -> CvtM (LocatedA RdrName)
vNameL Name
v
; GenLocated SrcSpanAnnA t
lhs' <- (RdrName -> CvtM t)
-> LocatedA RdrName
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenLocated SrcSpanAnnA a -> f (GenLocated SrcSpanAnnA b)
traverse RdrName -> CvtM t
f LocatedA RdrName
v'
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; HsFieldBind
(LocatedAn NoEpAnns t) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM
(LocatedAn
AnnListItem
(HsFieldBind
(LocatedAn NoEpAnns t) (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsFieldBind
(LocatedAn NoEpAnns t) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM
(LocatedAn
AnnListItem
(HsFieldBind
(LocatedAn NoEpAnns t) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> HsFieldBind
(LocatedAn NoEpAnns t) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM
(LocatedAn
AnnListItem
(HsFieldBind
(LocatedAn NoEpAnns t) (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ HsFieldBind { hfbAnn :: XHsFieldBind (LocatedAn NoEpAnns t)
hfbAnn = XHsFieldBind (LocatedAn NoEpAnns t)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, hfbLHS :: LocatedAn NoEpAnns t
hfbLHS = GenLocated SrcSpanAnnA t -> LocatedAn NoEpAnns t
forall ann1 a2 ann2. LocatedAn ann1 a2 -> LocatedAn ann2 a2
la2la GenLocated SrcSpanAnnA t
lhs'
, hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'
, hfbPun :: Bool
hfbPun = Bool
False} }
cvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)
cvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)
cvtDD (FromR Exp
x) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x; ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs))
-> ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' }
cvtDD (FromThenR Exp
x Exp
y) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y; ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs))
-> ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' }
cvtDD (FromToR Exp
x Exp
y) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y; ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs))
-> ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' }
cvtDD (FromThenToR Exp
x Exp
y Exp
z) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
x; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y; GenLocated SrcSpanAnnA (HsExpr GhcPs)
z' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
z; ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs))
-> ArithSeqInfo GhcPs -> CvtM (ArithSeqInfo GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
z' }
cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup [Maybe Exp]
es Boxity
boxity = do { let cvtl_maybe :: Maybe Exp -> CvtM' ConversionFailReason (HsTupArg GhcPs)
cvtl_maybe Maybe Exp
Nothing = HsTupArg GhcPs -> CvtM' ConversionFailReason (HsTupArg GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn EpaLocation -> HsTupArg GhcPs
missingTupArg EpAnn EpaLocation
forall a. EpAnn a
noAnn)
cvtl_maybe (Just Exp
e) = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsTupArg GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM' ConversionFailReason (HsTupArg GhcPs)
forall a b.
(a -> b)
-> CvtM' ConversionFailReason a -> CvtM' ConversionFailReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) (Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e)
; [HsTupArg GhcPs]
es' <- (Maybe Exp -> CvtM' ConversionFailReason (HsTupArg GhcPs))
-> [Maybe Exp] -> CvtM' ConversionFailReason [HsTupArg GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Maybe Exp -> CvtM' ConversionFailReason (HsTupArg GhcPs)
cvtl_maybe [Maybe Exp]
es
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcPs -> CvtM (HsExpr GhcPs))
-> HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple GhcPs -> [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple
XExplicitTuple GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
[HsTupArg GhcPs]
es'
Boxity
boxity }
cvtOpApp :: LHsExpr GhcPs -> TH.Exp -> TH.Exp -> CvtM (HsExpr GhcPs)
cvtOpApp :: LHsExpr GhcPs -> Exp -> Exp -> CvtM (HsExpr GhcPs)
cvtOpApp LHsExpr GhcPs
x Exp
op1 (UInfixE Exp
y Exp
op2 Exp
z)
= do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
l <- CvtM (HsExpr GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (CvtM (HsExpr GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> CvtM (HsExpr GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Exp -> Exp -> CvtM (HsExpr GhcPs)
cvtOpApp LHsExpr GhcPs
x Exp
op1 Exp
y
; LHsExpr GhcPs -> Exp -> Exp -> CvtM (HsExpr GhcPs)
cvtOpApp LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
l Exp
op2 Exp
z }
cvtOpApp LHsExpr GhcPs
x Exp
op Exp
y
= do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
op' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
op
; GenLocated SrcSpanAnnA (HsExpr GhcPs)
y' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
y
; HsExpr GhcPs -> CvtM (HsExpr GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
x LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y') }
cvtHsDo :: HsDoFlavour -> [TH.Stmt] -> CvtM (HsExpr GhcPs)
cvtHsDo :: HsDoFlavour -> [Stmt] -> CvtM (HsExpr GhcPs)
cvtHsDo HsDoFlavour
do_or_lc [Stmt]
stmts = case [Stmt] -> Maybe (NonEmpty Stmt)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Stmt]
stmts of
Maybe (NonEmpty Stmt)
Nothing -> ConversionFailReason -> CvtM (HsExpr GhcPs)
forall a. ConversionFailReason -> CvtM a
failWith ConversionFailReason
EmptyStmtListInDoBlock
Just NonEmpty Stmt
stmts -> do
{ NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
stmts' <- (Stmt
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> NonEmpty Stmt
-> CvtM'
ConversionFailReason
(NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse Stmt -> CvtM (LStmt GhcPs (LHsExpr GhcPs))
Stmt
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
cvtStmt NonEmpty Stmt
stmts
; let stmts'' :: [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts'' = NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. NonEmpty a -> [a]
NE.init NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
stmts'
last' :: GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
last' = NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. NonEmpty a -> a
NE.last NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
stmts'
; GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
last'' <- case GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
last' of
(L SrcSpanAnnA
loc (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
(GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
body))
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
_ -> ConversionFailReason
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. ConversionFailReason -> CvtM a
failWith (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> ConversionFailReason
bad_last GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
last')
; (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs)
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM (HsExpr GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XDo GhcPs
-> HsDoFlavour
-> XRec GhcPs [LStmt GhcPs (LHsExpr GhcPs)]
-> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn HsDoFlavour
do_or_lc) ([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts'' [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
last'']) }
where
bad_last :: GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> ConversionFailReason
bad_last GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
stmt = HsDoFlavour -> LStmt GhcPs (LHsExpr GhcPs) -> ConversionFailReason
IllegalLastStatement HsDoFlavour
do_or_lc LStmt GhcPs (LHsExpr GhcPs)
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
stmt
cvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt GhcPs (LHsExpr GhcPs)]
cvtStmts :: [Stmt] -> CvtM [LStmt GhcPs (LHsExpr GhcPs)]
cvtStmts = (Stmt
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Stmt]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Stmt -> CvtM (LStmt GhcPs (LHsExpr GhcPs))
Stmt
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
cvtStmt
cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
cvtStmt :: Stmt -> CvtM (LStmt GhcPs (LHsExpr GhcPs))
cvtStmt (NoBindS Exp
e) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (bodyR :: * -> *) (idL :: Pass).
LocatedA (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
mkBodyStmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' }
cvtStmt (TH.BindS Pat
p Exp
e) = do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p; GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn]
-> LPat GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (bodyR :: * -> *).
EpAnn [AddEpAnn]
-> LPat GhcPs
-> LocatedA (bodyR GhcPs)
-> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
mkPsBindStmt EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' }
cvtStmt (TH.LetS [Dec]
ds) = do { HsLocalBinds GhcPs
ds' <- THDeclDescriptor -> [Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs THDeclDescriptor
LetBinding [Dec]
ds
; StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBinds GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsLocalBinds GhcPs
ds' }
cvtStmt (TH.ParS [[Stmt]]
dss) = do { [ParStmtBlock GhcPs GhcPs]
dss' <- ([Stmt] -> CvtM' ConversionFailReason (ParStmtBlock GhcPs GhcPs))
-> [[Stmt]]
-> CvtM' ConversionFailReason [ParStmtBlock GhcPs GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Stmt] -> CvtM' ConversionFailReason (ParStmtBlock GhcPs GhcPs)
forall {p :: Pass} {idR}.
(SyntaxExprGhc p ~ SyntaxExpr idR,
XParStmtBlock GhcPs idR ~ NoExtField, IsPass p) =>
[Stmt] -> CvtM' ConversionFailReason (ParStmtBlock GhcPs idR)
cvt_one [[Stmt]]
dss
; StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XParStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [ParStmtBlock GhcPs GhcPs]
-> HsExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NoExtField
noExtField [ParStmtBlock GhcPs GhcPs]
dss' HsExpr GhcPs
forall (p :: Pass). HsExpr (GhcPass p)
noExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr }
where
cvt_one :: [Stmt] -> CvtM' ConversionFailReason (ParStmtBlock GhcPs idR)
cvt_one [Stmt]
ds = do { [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ds' <- [Stmt] -> CvtM [LStmt GhcPs (LHsExpr GhcPs)]
cvtStmts [Stmt]
ds
; ParStmtBlock GhcPs idR
-> CvtM' ConversionFailReason (ParStmtBlock GhcPs idR)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmtBlock GhcPs idR
-> [LStmt GhcPs (LHsExpr GhcPs)]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock GhcPs idR
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcPs idR
NoExtField
noExtField [LStmt GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ds' [IdP idR]
forall a. HasCallStack => a
undefined SyntaxExpr idR
SyntaxExpr (GhcPass p)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr) }
cvtStmt (TH.RecS [Stmt]
ss) = do { [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ss' <- (Stmt
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [Stmt]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Stmt -> CvtM (LStmt GhcPs (LHsExpr GhcPs))
Stmt
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
cvtStmt [Stmt]
ss
; StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rec_stmt <- (LocatedAn
AnnList
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (EpAnn AnnList
-> LocatedL
[LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (idL :: Pass) bodyR.
(Anno
[GenLocated
(Anno (StmtLR (GhcPass idL) GhcPs bodyR))
(StmtLR (GhcPass idL) GhcPs bodyR)]
~ SrcSpanAnnL) =>
EpAnn AnnList
-> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt EpAnn AnnList
forall a. EpAnn a
noAnn) [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ss'
; StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
rec_stmt }
cvtMatch :: HsMatchContext GhcPs
-> TH.Match -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
cvtMatch :: HsMatchContext GhcPs
-> Match -> CvtM (LMatch GhcPs (LHsExpr GhcPs))
cvtMatch HsMatchContext GhcPs
ctxt (TH.Match Pat
p Body
body [Dec]
decs)
= do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p
; let lp :: GenLocated SrcSpanAnnA (Pat GhcPs)
lp = case GenLocated SrcSpanAnnA (Pat GhcPs)
p' of
(L SrcSpanAnnA
loc SigPat{}) -> SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LPat GhcPs -> Pat GhcPs
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p')
GenLocated SrcSpanAnnA (Pat GhcPs)
_ -> GenLocated SrcSpanAnnA (Pat GhcPs)
p'
; [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g' <- Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard Body
body
; HsLocalBinds GhcPs
decs' <- THDeclDescriptor -> [Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs THDeclDescriptor
WhereClause [Dec]
decs
; Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Hs.Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsMatchContext GhcPs
ctxt [LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lp] (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
emptyComments [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
g' HsLocalBinds GhcPs
decs') }
cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard :: Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard (GuardedB [(Guard, Exp)]
pairs) = ((Guard, Exp)
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> [(Guard, Exp)]
-> CvtM'
ConversionFailReason
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Guard, Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
(Guard, Exp)
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
cvtpair [(Guard, Exp)]
pairs
cvtGuard (NormalB Exp
e) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e
; GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g' <- GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LStmt GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
forall a. EpAnn a
noAnn [] GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'; [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> CvtM'
ConversionFailReason
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g'] }
cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
cvtpair :: (Guard, Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
cvtpair (NormalG Exp
ge,Exp
rhs) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
ge' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
ge; GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
rhs
; GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g' <- StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (bodyR :: * -> *) (idL :: Pass).
LocatedA (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
mkBodyStmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
ge'
; GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LStmt GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
forall a. EpAnn a
noAnn [LStmt GhcPs (LHsExpr GhcPs)
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g'] GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs' }
cvtpair (PatG [Stmt]
gs,Exp
rhs) = do { [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs' <- [Stmt] -> CvtM [LStmt GhcPs (LHsExpr GhcPs)]
cvtStmts [Stmt]
gs; GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
rhs
; GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LStmt GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
forall a. EpAnn a
noAnn [LStmt GhcPs (LHsExpr GhcPs)]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs' GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs' }
cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit (IntegerL Integer
i)
= do { Integer -> CvtM ()
forall a. a -> CvtM ()
force Integer
i; HsOverLit GhcPs -> CvtM (HsOverLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcPs -> CvtM (HsOverLit GhcPs))
-> HsOverLit GhcPs -> CvtM (HsOverLit GhcPs)
forall a b. (a -> b) -> a -> b
$ IntegralLit -> HsOverLit GhcPs
mkHsIntegral (Integer -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit Integer
i) }
cvtOverLit (RationalL Rational
r)
= do { Rational -> CvtM ()
forall a. a -> CvtM ()
force Rational
r; HsOverLit GhcPs -> CvtM (HsOverLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcPs -> CvtM (HsOverLit GhcPs))
-> HsOverLit GhcPs -> CvtM (HsOverLit GhcPs)
forall a b. (a -> b) -> a -> b
$ FractionalLit -> HsOverLit GhcPs
mkHsFractional (Rational -> FractionalLit
mkTHFractionalLit Rational
r) }
cvtOverLit (StringL String
s)
= do { let { s' :: FastString
s' = String -> FastString
mkFastString String
s }
; FastString -> CvtM ()
forall a. a -> CvtM ()
force FastString
s'
; HsOverLit GhcPs -> CvtM (HsOverLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcPs -> CvtM (HsOverLit GhcPs))
-> HsOverLit GhcPs -> CvtM (HsOverLit GhcPs)
forall a b. (a -> b) -> a -> b
$ SourceText -> FastString -> HsOverLit GhcPs
mkHsIsString (String -> SourceText
quotedSourceText String
s) FastString
s'
}
cvtOverLit Lit
_ = String -> CvtM (HsOverLit GhcPs)
forall a. HasCallStack => String -> a
panic String
"Convert.cvtOverLit: Unexpected overloaded literal"
allCharLs :: [TH.Exp] -> Maybe String
allCharLs :: [Exp] -> Maybe String
allCharLs [Exp]
xs
= case [Exp]
xs of
LitE (CharL Char
c) : [Exp]
ys -> String -> [Exp] -> Maybe String
go [Char
c] [Exp]
ys
[Exp]
_ -> Maybe String
forall a. Maybe a
Nothing
where
go :: String -> [Exp] -> Maybe String
go String
cs [] = String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
reverse String
cs)
go String
cs (LitE (CharL Char
c) : [Exp]
ys) = String -> [Exp] -> Maybe String
go (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs) [Exp]
ys
go String
_ [Exp]
_ = Maybe String
forall a. Maybe a
Nothing
cvtLit :: Lit -> CvtM (HsLit GhcPs)
cvtLit :: Lit -> CvtM (HsLit GhcPs)
cvtLit (IntPrimL Integer
i) = do { Integer -> CvtM ()
forall a. a -> CvtM ()
force Integer
i; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsIntPrim GhcPs -> Integer -> HsLit GhcPs
forall x. XHsIntPrim x -> Integer -> HsLit x
HsIntPrim XHsIntPrim GhcPs
SourceText
NoSourceText Integer
i }
cvtLit (WordPrimL Integer
w) = do { Integer -> CvtM ()
forall a. a -> CvtM ()
force Integer
w; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsWordPrim GhcPs -> Integer -> HsLit GhcPs
forall x. XHsWordPrim x -> Integer -> HsLit x
HsWordPrim XHsWordPrim GhcPs
SourceText
NoSourceText Integer
w }
cvtLit (FloatPrimL Rational
f)
= do { Rational -> CvtM ()
forall a. a -> CvtM ()
force Rational
f; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsFloatPrim GhcPs -> FractionalLit -> HsLit GhcPs
forall x. XHsFloatPrim x -> FractionalLit -> HsLit x
HsFloatPrim XHsFloatPrim GhcPs
NoExtField
noExtField (Rational -> FractionalLit
mkTHFractionalLit Rational
f) }
cvtLit (DoublePrimL Rational
f)
= do { Rational -> CvtM ()
forall a. a -> CvtM ()
force Rational
f; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsDoublePrim GhcPs -> FractionalLit -> HsLit GhcPs
forall x. XHsDoublePrim x -> FractionalLit -> HsLit x
HsDoublePrim XHsDoublePrim GhcPs
NoExtField
noExtField (Rational -> FractionalLit
mkTHFractionalLit Rational
f) }
cvtLit (CharL Char
c) = do { Char -> CvtM ()
forall a. a -> CvtM ()
force Char
c; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsChar GhcPs -> Char -> HsLit GhcPs
forall x. XHsChar x -> Char -> HsLit x
HsChar XHsChar GhcPs
SourceText
NoSourceText Char
c }
cvtLit (CharPrimL Char
c) = do { Char -> CvtM ()
forall a. a -> CvtM ()
force Char
c; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsCharPrim GhcPs -> Char -> HsLit GhcPs
forall x. XHsCharPrim x -> Char -> HsLit x
HsCharPrim XHsCharPrim GhcPs
SourceText
NoSourceText Char
c }
cvtLit (StringL String
s) = do { let { s' :: FastString
s' = String -> FastString
mkFastString String
s }
; FastString -> CvtM ()
forall a. a -> CvtM ()
force FastString
s'
; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsString GhcPs -> FastString -> HsLit GhcPs
forall x. XHsString x -> FastString -> HsLit x
HsString (String -> SourceText
quotedSourceText String
s) FastString
s' }
cvtLit (StringPrimL [Word8]
s) = do { let { !s' :: ByteString
s' = [Word8] -> ByteString
BS.pack [Word8]
s }
; HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsStringPrim GhcPs -> ByteString -> HsLit GhcPs
forall x. XHsStringPrim x -> ByteString -> HsLit x
HsStringPrim XHsStringPrim GhcPs
SourceText
NoSourceText ByteString
s' }
cvtLit (BytesPrimL (Bytes ForeignPtr Word8
fptr Word
off Word
sz)) = do
let bs :: ByteString
bs = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
CStringLen -> IO ByteString
BS.packCStringLen (Ptr Word8
ptr Ptr Word8 -> SumAlt -> Ptr CChar
forall a b. Ptr a -> SumAlt -> Ptr b
`plusPtr` Word -> SumAlt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
off, Word -> SumAlt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
sz)
ByteString -> CvtM ()
forall a. a -> CvtM ()
force ByteString
bs
HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcPs -> CvtM (HsLit GhcPs))
-> HsLit GhcPs -> CvtM (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsStringPrim GhcPs -> ByteString -> HsLit GhcPs
forall x. XHsStringPrim x -> ByteString -> HsLit x
HsStringPrim XHsStringPrim GhcPs
SourceText
NoSourceText ByteString
bs
cvtLit Lit
_ = String -> CvtM (HsLit GhcPs)
forall a. HasCallStack => String -> a
panic String
"Convert.cvtLit: Unexpected literal"
quotedSourceText :: String -> SourceText
quotedSourceText :: String -> SourceText
quotedSourceText String
s = FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
cvtPats :: [TH.Pat] -> CvtM [Hs.LPat GhcPs]
cvtPats :: [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
pats = (Pat
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [Pat]
-> CvtM' ConversionFailReason [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pat -> CvtM' ConversionFailReason (LPat GhcPs)
Pat
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA (Pat GhcPs))
cvtPat [Pat]
pats
cvtPat :: TH.Pat -> CvtM (Hs.LPat GhcPs)
cvtPat :: Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
pat = CvtM (Pat GhcPs)
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (Pat -> CvtM (Pat GhcPs)
cvtp Pat
pat)
cvtp :: TH.Pat -> CvtM (Hs.Pat GhcPs)
cvtp :: Pat -> CvtM (Pat GhcPs)
cvtp (TH.LitP Lit
l)
| Lit -> Bool
overloadedLit Lit
l = do { HsOverLit GhcPs
l' <- Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit Lit
l
; LocatedAn NoEpAnns (HsOverLit GhcPs)
l'' <- HsOverLit GhcPs -> CvtM (LocatedAn NoEpAnns (HsOverLit GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsOverLit GhcPs
l'
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn NoEpAnns (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs
mkNPat LocatedAn NoEpAnns (HsOverLit GhcPs)
l'' Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) }
| Bool
otherwise = do { HsLit GhcPs
l' <- Lit -> CvtM (HsLit GhcPs)
cvtLit Lit
l; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XLitPat GhcPs -> HsLit GhcPs -> Pat GhcPs
forall p. XLitPat p -> HsLit p -> Pat p
Hs.LitPat XLitPat GhcPs
NoExtField
noExtField HsLit GhcPs
l' }
cvtp (TH.VarP Name
s) = do { RdrName
s' <- Name -> CvtM RdrName
vName Name
s
; (LocatedN RdrName -> Pat GhcPs) -> RdrName -> CvtM (Pat GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
Hs.VarPat XVarPat GhcPs
NoExtField
noExtField) RdrName
s' }
cvtp (TupP [Pat]
ps) = do { [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
ps
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XTuplePat GhcPs -> [LPat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' Boxity
Boxed }
cvtp (UnboxedTupP [Pat]
ps) = do { [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
ps
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XTuplePat GhcPs -> [LPat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' Boxity
Unboxed }
cvtp (UnboxedSumP Pat
p SumAlt
alt SumAlt
arity)
= do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p
; SumAlt -> SumAlt -> CvtM ()
unboxedSumChecks SumAlt
alt SumAlt
arity
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XSumPat GhcPs -> LPat GhcPs -> SumAlt -> SumAlt -> Pat GhcPs
forall p. XSumPat p -> LPat p -> SumAlt -> SumAlt -> Pat p
SumPat XSumPat GhcPs
EpAnn EpAnnSumPat
forall a. EpAnn a
noAnn LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' SumAlt
alt SumAlt
arity }
cvtp (ConP Name
s [Type]
ts [Pat]
ps) = do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
s
; [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
ps
; [GenLocated SrcSpanAnnA (HsType GhcPs)]
ts' <- (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [Type]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtType [Type]
ts
; let pps :: [GenLocated SrcSpanAnnA (Pat GhcPs)]
pps = (GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps'
pts :: [HsConPatTyArg GhcPs]
pts = (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsConPatTyArg GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [HsConPatTyArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (\GenLocated SrcSpanAnnA (HsType GhcPs)
t -> XRec GhcPs (HsToken "@")
-> HsPatSigType GhcPs -> HsConPatTyArg GhcPs
forall p. LHsToken "@" p -> HsPatSigType p -> HsConPatTyArg p
HsConPatTyArg XRec GhcPs (HsToken "@")
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok (EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnnCO
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ts'
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
s'
, pat_args :: HsConPatDetails GhcPs
pat_args = [HsConPatTyArg GhcPs]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> HsConDetails
(HsConPatTyArg GhcPs)
(GenLocated SrcSpanAnnA (Pat GhcPs))
(HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [HsConPatTyArg GhcPs]
pts [GenLocated SrcSpanAnnA (Pat GhcPs)]
pps
}
}
cvtp (InfixP Pat
p1 Name
s Pat
p2) = do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
s; GenLocated SrcSpanAnnA (Pat GhcPs)
p1' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p1; GenLocated SrcSpanAnnA (Pat GhcPs)
p2' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p2
; (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> Pat GhcPs -> CvtM (Pat GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LPat GhcPs -> Pat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$
ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
s'
, pat_args :: HsConPatDetails GhcPs
pat_args = GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> HsConDetails
(HsConPatTyArg GhcPs)
(GenLocated SrcSpanAnnA (Pat GhcPs))
(HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon
(PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1')
(PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p2')
}
}
cvtp (UInfixP Pat
p1 Name
s Pat
p2) = do { GenLocated SrcSpanAnnA (Pat GhcPs)
p1' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p1; LPat GhcPs -> Name -> Pat -> CvtM (Pat GhcPs)
cvtOpAppP LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1' Name
s Pat
p2 }
cvtp (ParensP Pat
p) = do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p;
; case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat GhcPs)
p' of
ParPat {} -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat GhcPs)
p'
Pat GhcPs
_ -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ LPat GhcPs -> Pat GhcPs
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' }
cvtp (TildeP Pat
p) = do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XLazyPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XLazyPat p -> LPat p -> Pat p
LazyPat XLazyPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' }
cvtp (BangP Pat
p) = do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XBangPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XBangPat p -> LPat p -> Pat p
BangPat XBangPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' }
cvtp (TH.AsP Name
s Pat
p) = do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
s; GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XAsPat GhcPs
-> LIdP GhcPs
-> XRec GhcPs (HsToken "@")
-> LPat GhcPs
-> Pat GhcPs
forall p. XAsPat p -> LIdP p -> LHsToken "@" p -> LPat p -> Pat p
AsPat XAsPat GhcPs
EpAnnCO
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
s' XRec GhcPs (HsToken "@")
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p' }
cvtp Pat
TH.WildP = Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
NoExtField
noExtField
cvtp (RecP Name
c [FieldPat]
fs) = do { LocatedN RdrName
c' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
c; [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs' <- (FieldPat
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [FieldPat]
-> CvtM'
ConversionFailReason
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FieldPat -> CvtM (LHsRecField GhcPs (LPat GhcPs))
FieldPat
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
cvtPatFld [FieldPat]
fs
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
c'
, pat_args :: HsConPatDetails GhcPs
pat_args = HsRecFields GhcPs (LPat GhcPs) -> HsConPatDetails GhcPs
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
Hs.RecCon (HsRecFields GhcPs (LPat GhcPs) -> HsConPatDetails GhcPs)
-> HsRecFields GhcPs (LPat GhcPs) -> HsConPatDetails GhcPs
forall a b. (a -> b) -> a -> b
$ [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> Maybe (XRec GhcPs RecFieldsDotDot)
-> HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
forall p arg.
[LHsRecField p arg]
-> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
HsRecFields [LHsRecField GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fs' Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (GenLocated SrcSpan RecFieldsDotDot)
forall a. Maybe a
Nothing
}
}
cvtp (ListP [Pat]
ps) = do { [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps' <- [Pat] -> CvtM [LPat GhcPs]
cvtPats [Pat]
ps
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XListPat GhcPs -> [LPat GhcPs] -> Pat GhcPs
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
ps'}
cvtp (SigP Pat
p Type
t) = do { GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p; GenLocated SrcSpanAnnA (HsType GhcPs)
t' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t
; let pp :: LPat GhcPs
pp = PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
sigPrec LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p'
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XSigPat GhcPs
-> LPat GhcPs -> HsPatSigType (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat XSigPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat GhcPs
pp (EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnnCO
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t') }
cvtp (ViewP Exp
e Pat
p) = do { GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- Exp -> CvtM' ConversionFailReason (LHsExpr GhcPs)
cvtl Exp
e; GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XViewPat GhcPs -> LHsExpr GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p'}
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld :: FieldPat -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld (Name
s,Pat
p)
= do { L SrcSpanAnnN
ls RdrName
s' <- Name -> CvtM (LocatedN RdrName)
vNameN Name
s
; GenLocated SrcSpanAnnA (Pat GhcPs)
p' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
p
; HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> CvtM'
ConversionFailReason
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a b. (a -> b) -> a -> b
$ HsFieldBind { hfbAnn :: XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
hfbAnn = XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
hfbLHS
= SrcAnn NoEpAnns
-> FieldOcc GhcPs -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
ls) (FieldOcc GhcPs -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
-> FieldOcc GhcPs -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> FieldOcc GhcPs
mkFieldOcc (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnN
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
ls) RdrName
s')
, hfbRHS :: GenLocated SrcSpanAnnA (Pat GhcPs)
hfbRHS = GenLocated SrcSpanAnnA (Pat GhcPs)
p'
, hfbPun :: Bool
hfbPun = Bool
False} }
cvtOpAppP :: Hs.LPat GhcPs -> TH.Name -> TH.Pat -> CvtM (Hs.Pat GhcPs)
cvtOpAppP :: LPat GhcPs -> Name -> Pat -> CvtM (Pat GhcPs)
cvtOpAppP LPat GhcPs
x Name
op1 (UInfixP Pat
y Name
op2 Pat
z)
= do { GenLocated SrcSpanAnnA (Pat GhcPs)
l <- CvtM (Pat GhcPs)
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (CvtM (Pat GhcPs)
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> CvtM (Pat GhcPs)
-> CvtM' ConversionFailReason (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ LPat GhcPs -> Name -> Pat -> CvtM (Pat GhcPs)
cvtOpAppP LPat GhcPs
x Name
op1 Pat
y
; LPat GhcPs -> Name -> Pat -> CvtM (Pat GhcPs)
cvtOpAppP LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l Name
op2 Pat
z }
cvtOpAppP LPat GhcPs
x Name
op Pat
y
= do { LocatedN RdrName
op' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
op
; GenLocated SrcSpanAnnA (Pat GhcPs)
y' <- Pat -> CvtM' ConversionFailReason (LPat GhcPs)
cvtPat Pat
y
; Pat GhcPs -> CvtM (Pat GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcPs -> CvtM (Pat GhcPs)) -> Pat GhcPs -> CvtM (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
{ pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
, pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
op'
, pat_args :: HsConPatDetails GhcPs
pat_args = GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> HsConDetails
(HsConPatTyArg GhcPs)
(GenLocated SrcSpanAnnA (Pat GhcPs))
(HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x GenLocated SrcSpanAnnA (Pat GhcPs)
y'
}
}
class CvtFlag flag flag' | flag -> flag' where
cvtFlag :: flag -> flag'
instance CvtFlag () () where
cvtFlag :: () -> ()
cvtFlag () = ()
instance CvtFlag TH.Specificity Hs.Specificity where
cvtFlag :: Specificity -> Specificity
cvtFlag Specificity
TH.SpecifiedSpec = Specificity
Hs.SpecifiedSpec
cvtFlag Specificity
TH.InferredSpec = Specificity
Hs.InferredSpec
instance CvtFlag TH.BndrVis (HsBndrVis GhcPs) where
cvtFlag :: BndrVis -> HsBndrVis GhcPs
cvtFlag BndrVis
TH.BndrReq = HsBndrVis GhcPs
forall pass. HsBndrVis pass
HsBndrRequired
cvtFlag BndrVis
TH.BndrInvis = XRec GhcPs (HsToken "@") -> HsBndrVis GhcPs
forall pass. LHsToken "@" pass -> HsBndrVis pass
HsBndrInvisible XRec GhcPs (HsToken "@")
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok
cvtTvs :: CvtFlag flag flag' => [TH.TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs :: forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs [TyVarBndr flag]
tvs = (TyVarBndr flag
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnA (HsTyVarBndr flag' GhcPs)))
-> [TyVarBndr flag]
-> CvtM'
ConversionFailReason
[GenLocated SrcSpanAnnA (HsTyVarBndr flag' GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyVarBndr flag -> CvtM (XRec GhcPs (HsTyVarBndr flag' GhcPs))
TyVarBndr flag
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnA (HsTyVarBndr flag' GhcPs))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv [TyVarBndr flag]
tvs
cvt_tv :: CvtFlag flag flag' => (TH.TyVarBndr flag) -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv :: forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv (TH.PlainTV Name
nm flag
fl)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tNameN Name
nm
; let fl' :: flag'
fl' = flag -> flag'
forall flag flag'. CvtFlag flag flag' => flag -> flag'
cvtFlag flag
fl
; HsTyVarBndr flag' GhcPs
-> CvtM (LocatedAn AnnListItem (HsTyVarBndr flag' GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsTyVarBndr flag' GhcPs
-> CvtM (LocatedAn AnnListItem (HsTyVarBndr flag' GhcPs)))
-> HsTyVarBndr flag' GhcPs
-> CvtM (LocatedAn AnnListItem (HsTyVarBndr flag' GhcPs))
forall a b. (a -> b) -> a -> b
$ XUserTyVar GhcPs -> flag' -> LIdP GhcPs -> HsTyVarBndr flag' GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn flag'
fl' LIdP GhcPs
LocatedN RdrName
nm' }
cvt_tv (TH.KindedTV Name
nm flag
fl Type
ki)
= do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tNameN Name
nm
; let fl' :: flag'
fl' = flag -> flag'
forall flag flag'. CvtFlag flag flag' => flag -> flag'
cvtFlag flag
fl
; GenLocated SrcSpanAnnA (HsType GhcPs)
ki' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtKind Type
ki
; HsTyVarBndr flag' GhcPs
-> CvtM (LocatedAn AnnListItem (HsTyVarBndr flag' GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsTyVarBndr flag' GhcPs
-> CvtM (LocatedAn AnnListItem (HsTyVarBndr flag' GhcPs)))
-> HsTyVarBndr flag' GhcPs
-> CvtM (LocatedAn AnnListItem (HsTyVarBndr flag' GhcPs))
forall a b. (a -> b) -> a -> b
$ XKindedTyVar GhcPs
-> flag' -> LIdP GhcPs -> LHsType GhcPs -> HsTyVarBndr flag' GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn flag'
fl' LIdP GhcPs
LocatedN RdrName
nm' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki' }
cvtRole :: TH.Role -> Maybe Coercion.Role
cvtRole :: Role -> Maybe Role
cvtRole Role
TH.NominalR = Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Coercion.Nominal
cvtRole Role
TH.RepresentationalR = Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Coercion.Representational
cvtRole Role
TH.PhantomR = Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Coercion.Phantom
cvtRole Role
TH.InferR = Maybe Role
forall a. Maybe a
Nothing
cvtContext :: PprPrec -> TH.Cxt -> CvtM (LHsContext GhcPs)
cvtContext :: PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
p [Type]
tys = do { [GenLocated SrcSpanAnnA (HsType GhcPs)]
preds' <- (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [Type]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM' ConversionFailReason (LHsType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
cvtPred [Type]
tys
; PprPrec -> LHsContext GhcPs -> LHsContext GhcPs
forall (p :: Pass).
PprPrec -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)
parenthesizeHsContext PprPrec
p (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA [GenLocated SrcSpanAnnA (HsType GhcPs)]
preds' }
cvtPred :: TH.Pred -> CvtM (LHsType GhcPs)
cvtPred :: Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtPred = Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType
cvtDerivClauseTys :: TH.Cxt -> CvtM (LDerivClauseTys GhcPs)
cvtDerivClauseTys :: [Type] -> CvtM (LDerivClauseTys GhcPs)
cvtDerivClauseTys [Type]
tys
= do { [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys' <- (Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs)))
-> [Type]
-> CvtM'
ConversionFailReason [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM (LHsSigType GhcPs)
Type
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs))
cvtSigType [Type]
tys
; case [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys' of
[ty' :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'@(L SrcSpanAnnA
l (HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterImplicit{}
, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = L SrcSpanAnnA
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
NotPromoted LIdP GhcPs
_) }))]
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC (DerivClauseTys GhcPs))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)))
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC (DerivClauseTys GhcPs))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnC
-> DerivClauseTys GhcPs
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnC
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
l) (DerivClauseTys GhcPs
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcPs))
-> DerivClauseTys GhcPs
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
forall a b. (a -> b) -> a -> b
$ XDctSingle GhcPs -> LHsSigType GhcPs -> DerivClauseTys GhcPs
forall pass.
XDctSingle pass -> LHsSigType pass -> DerivClauseTys pass
DctSingle XDctSingle GhcPs
NoExtField
noExtField LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
_ -> DerivClauseTys GhcPs
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC (DerivClauseTys GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (DerivClauseTys GhcPs
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)))
-> DerivClauseTys GhcPs
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC (DerivClauseTys GhcPs))
forall a b. (a -> b) -> a -> b
$ XDctMulti GhcPs -> [LHsSigType GhcPs] -> DerivClauseTys GhcPs
forall pass.
XDctMulti pass -> [LHsSigType pass] -> DerivClauseTys pass
DctMulti XDctMulti GhcPs
NoExtField
noExtField [LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys' }
cvtDerivClause :: TH.DerivClause
-> CvtM (LHsDerivingClause GhcPs)
cvtDerivClause :: DerivClause -> CvtM (LHsDerivingClause GhcPs)
cvtDerivClause (TH.DerivClause Maybe DerivStrategy
ds [Type]
tys)
= do { GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
tys' <- [Type] -> CvtM (LDerivClauseTys GhcPs)
cvtDerivClauseTys [Type]
tys
; Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
ds' <- (DerivStrategy
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)))
-> Maybe DerivStrategy
-> CvtM'
ConversionFailReason
(Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse DerivStrategy -> CvtM (LDerivStrategy GhcPs)
DerivStrategy
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
cvtDerivStrategy Maybe DerivStrategy
ds
; HsDerivingClause GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsDerivingClause GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)))
-> HsDerivingClause GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs))
forall a b. (a -> b) -> a -> b
$ XCHsDerivingClause GhcPs
-> Maybe (LDerivStrategy GhcPs)
-> LDerivClauseTys GhcPs
-> HsDerivingClause GhcPs
forall pass.
XCHsDerivingClause pass
-> Maybe (LDerivStrategy pass)
-> LDerivClauseTys pass
-> HsDerivingClause pass
HsDerivingClause XCHsDerivingClause GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
ds' LDerivClauseTys GhcPs
GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
tys' }
cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs)
cvtDerivStrategy :: DerivStrategy -> CvtM (LDerivStrategy GhcPs)
cvtDerivStrategy DerivStrategy
TH.StockStrategy = DerivStrategy GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XStockStrategy GhcPs -> DerivStrategy GhcPs
forall pass. XStockStrategy pass -> DerivStrategy pass
Hs.StockStrategy XStockStrategy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)
cvtDerivStrategy DerivStrategy
TH.AnyclassStrategy = DerivStrategy GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XAnyClassStrategy GhcPs -> DerivStrategy GhcPs
forall pass. XAnyClassStrategy pass -> DerivStrategy pass
Hs.AnyclassStrategy XAnyClassStrategy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)
cvtDerivStrategy DerivStrategy
TH.NewtypeStrategy = DerivStrategy GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XNewtypeStrategy GhcPs -> DerivStrategy GhcPs
forall pass. XNewtypeStrategy pass -> DerivStrategy pass
Hs.NewtypeStrategy XNewtypeStrategy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)
cvtDerivStrategy (TH.ViaStrategy Type
ty) = do
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
ty
DerivStrategy GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (DerivStrategy GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)))
-> DerivStrategy GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
forall a b. (a -> b) -> a -> b
$ XViaStrategy GhcPs -> DerivStrategy GhcPs
forall pass. XViaStrategy pass -> DerivStrategy pass
Hs.ViaStrategy (EpAnn [AddEpAnn] -> LHsSigType GhcPs -> XViaStrategyPs
XViaStrategyPs EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty')
cvtType :: TH.Type -> CvtM (LHsType GhcPs)
cvtType :: Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType = TypeOrKind -> Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtTypeKind TypeOrKind
TypeLevel
cvtSigType :: TH.Type -> CvtM (LHsSigType GhcPs)
cvtSigType :: Type -> CvtM (LHsSigType GhcPs)
cvtSigType = TypeOrKind -> Type -> CvtM (LHsSigType GhcPs)
cvtSigTypeKind TypeOrKind
TypeLevel
cvtSigTypeKind :: TypeOrKind -> TH.Type -> CvtM (LHsSigType GhcPs)
cvtSigTypeKind :: TypeOrKind -> Type -> CvtM (LHsSigType GhcPs)
cvtSigTypeKind TypeOrKind
typeOrKind Type
ty = do
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- TypeOrKind -> Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtTypeKind TypeOrKind
typeOrKind Type
ty
GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall a. a -> CvtM' ConversionFailReason a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs)))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> LHsSigType GhcPs
hsTypeToHsSigType (LHsType GhcPs -> LHsSigType GhcPs)
-> LHsType GhcPs -> LHsSigType GhcPs
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty'
cvtTypeKind :: TypeOrKind -> TH.Type -> CvtM (LHsType GhcPs)
cvtTypeKind :: TypeOrKind -> Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtTypeKind TypeOrKind
typeOrKind Type
ty
= do { (Type
head_ty, [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys') <- Type -> CvtM (Type, HsTyPats GhcPs)
split_ty_app Type
ty
; let m_normals :: Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals = (HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall {p} {a} {ty}. HsArg p a ty -> Maybe a
extract_normal [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
where extract_normal :: HsArg p a ty -> Maybe a
extract_normal (HsValArg a
ty) = a -> Maybe a
forall a. a -> Maybe a
Just a
ty
extract_normal HsArg p a ty
_ = Maybe a
forall a. Maybe a
Nothing
; case Type
head_ty of
TupleT SumAlt
n
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals [GenLocated SrcSpanAnnA (HsType GhcPs)] -> SumAlt -> Bool
forall a. [a] -> SumAlt -> Bool
`lengthIs` SumAlt
n
-> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XTupleTy GhcPs -> HsTupleSort -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn HsTupleSort
HsBoxedOrConstraintTuple [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
normals)
| Bool
otherwise
-> do { LocatedN RdrName
tuple_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (TyCon -> RdrName) -> TyCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Boxity -> SumAlt -> TyCon
tupleTyCon Boxity
Boxed SumAlt
n
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
tuple_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
UnboxedTupleT SumAlt
n
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals [GenLocated SrcSpanAnnA (HsType GhcPs)] -> SumAlt -> Bool
forall a. [a] -> SumAlt -> Bool
`lengthIs` SumAlt
n
-> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XTupleTy GhcPs -> HsTupleSort -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn HsTupleSort
HsUnboxedTuple [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
normals)
| Bool
otherwise
-> do { LocatedN RdrName
tuple_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (TyCon -> RdrName) -> TyCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Boxity -> SumAlt -> TyCon
tupleTyCon Boxity
Unboxed SumAlt
n
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
tuple_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
UnboxedSumT SumAlt
n
| SumAlt
n SumAlt -> SumAlt -> Bool
forall a. Ord a => a -> a -> Bool
< SumAlt
2
-> ConversionFailReason
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> ConversionFailReason
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$ SumAlt -> ConversionFailReason
IllegalSumArity SumAlt
n
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals [GenLocated SrcSpanAnnA (HsType GhcPs)] -> SumAlt -> Bool
forall a. [a] -> SumAlt -> Bool
`lengthIs` SumAlt
n
-> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XSumTy GhcPs -> [LHsType GhcPs] -> HsType GhcPs
forall pass. XSumTy pass -> [LHsType pass] -> HsType pass
HsSumTy XSumTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
normals)
| Bool
otherwise
-> do { LocatedN RdrName
sum_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (TyCon -> RdrName) -> TyCon -> RdrName
forall a b. (a -> b) -> a -> b
$ SumAlt -> TyCon
sumTyCon SumAlt
n
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
sum_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
ArrowT
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)
x',GenLocated SrcSpanAnnA (HsType GhcPs)
y'] <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals -> do
GenLocated SrcSpanAnnA (HsType GhcPs)
x'' <- case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
x' of
HsFunTy{} -> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
HsForAllTy{} -> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
HsQualTy{} -> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
HsType GhcPs
_ -> GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$
PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x'
let y'' :: LHsType GhcPs
y'' = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
y'
HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XFunTy GhcPs
-> HsArrow GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
EpAnnCO
forall a. EpAnn a
noAnn (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok) LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x'' LHsType GhcPs
y'')
| Bool
otherwise
-> do { LocatedN RdrName
fun_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
unrestrictedFunTyCon
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
fun_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
MulArrowT
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)
w',GenLocated SrcSpanAnnA (HsType GhcPs)
x',GenLocated SrcSpanAnnA (HsType GhcPs)
y'] <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals -> do
GenLocated SrcSpanAnnA (HsType GhcPs)
x'' <- case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
x' of
HsFunTy{} -> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
HsForAllTy{} -> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
HsQualTy{} -> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
HsType GhcPs
_ -> GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$
PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x'
let y'' :: LHsType GhcPs
y'' = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
y'
w'' :: HsArrow GhcPs
w'' = LHsType GhcPs -> HsArrow GhcPs
hsTypeToArrow LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
w'
HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XFunTy GhcPs
-> HsArrow GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
EpAnnCO
forall a. EpAnn a
noAnn HsArrow GhcPs
w'' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x'' LHsType GhcPs
y'')
| Bool
otherwise
-> do { LocatedN RdrName
fun_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
fUNTyCon
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
fun_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
ListT
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)
x'] <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals ->
HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XListTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x')
| Bool
otherwise
-> do { LocatedN RdrName
list_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
listTyCon
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
list_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
VarT Name
nm -> do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
tNameN Name
nm
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
nm') HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
ConT Name
nm -> do { RdrName
nm' <- Name -> CvtM RdrName
tconName Name
nm
; let prom :: PromotionFlag
prom = RdrName -> PromotionFlag
name_promotedness RdrName
nm'
; LocatedN RdrName
lnm' <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
nm'
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom LIdP GhcPs
LocatedN RdrName
lnm') HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'}
ForallT [TyVarBndr Specificity]
tvs [Type]
cxt Type
ty
| [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
-> do { [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
tvs' <- [TyVarBndr Specificity] -> CvtM [LHsTyVarBndr Specificity GhcPs]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs [TyVarBndr Specificity]
tvs
; GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext GhcPs)
cvtContext PprPrec
funPrec [Type]
cxt
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; SrcSpan
loc <- CvtM SrcSpan
getL
; let loc' :: SrcSpanAnnA
loc' = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc
; let tele :: HsForAllTelescope GhcPs
tele = EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcPs] -> HsForAllTelescope GhcPs
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
tvs'
hs_ty :: LHsType GhcPs
hs_ty = SrcSpanAnnA
-> HsForAllTelescope GhcPs -> LHsType GhcPs -> LHsType GhcPs
mkHsForAllTy SrcSpanAnnA
loc' HsForAllTelescope GhcPs
tele LHsType GhcPs
rho_ty
rho_ty :: LHsType GhcPs
rho_ty = [Type]
-> SrcSpanAnnA
-> LHsContext GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
mkHsQualTy [Type]
cxt SrcSpanAnnA
loc' LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty'
; GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_ty }
ForallVisT [TyVarBndr ()]
tvs Type
ty
| [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
-> do { [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
tvs' <- [TyVarBndr ()] -> CvtM [LHsTyVarBndr () GhcPs]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs [TyVarBndr ()]
tvs
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; SrcSpan
loc <- CvtM SrcSpan
getL
; let loc' :: SrcSpanAnnA
loc' = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc
; let tele :: HsForAllTelescope GhcPs
tele = EpAnnForallTy -> [LHsTyVarBndr () GhcPs] -> HsForAllTelescope GhcPs
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllVisTele EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
tvs'
; LHsType GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
forall a. a -> CvtM' ConversionFailReason a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsType GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs))
-> LHsType GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsForAllTelescope GhcPs -> LHsType GhcPs -> LHsType GhcPs
mkHsForAllTy SrcSpanAnnA
loc' HsForAllTelescope GhcPs
tele LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' }
SigT Type
ty Type
ki
-> do { GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
ty
; GenLocated SrcSpanAnnA (HsType GhcPs)
ki' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtKind Type
ki
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XKindSig GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig XKindSig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki') HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
}
LitT TyLit
lit
-> HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyLit GhcPs -> HsTyLit GhcPs -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcPs
NoExtField
noExtField (TyLit -> HsTyLit GhcPs
forall (p :: Pass). TyLit -> HsTyLit (GhcPass p)
cvtTyLit TyLit
lit)) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
Type
WildCardT
-> HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps HsType GhcPs
mkAnonWildCardTy HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
InfixT Type
t1 Name
s Type
t2
-> do { RdrName
s' <- Name -> CvtM RdrName
tconName Name
s
; GenLocated SrcSpanAnnA (HsType GhcPs)
t1' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t1
; GenLocated SrcSpanAnnA (HsType GhcPs)
t2' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t2
; let prom :: PromotionFlag
prom = RdrName -> PromotionFlag
name_promotedness RdrName
s'
; LocatedN RdrName
ls' <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
s'
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps
(XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom LIdP GhcPs
LocatedN RdrName
ls')
([GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
t1', GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
t2'] [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. [a] -> [a] -> [a]
++ [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys')
}
UInfixT Type
t1 Name
s Type
t2
-> do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
s
; GenLocated SrcSpanAnnA (HsType GhcPs)
t2' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t2
; GenLocated SrcSpanAnnA (HsType GhcPs)
t <- PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
NotPromoted Type
t1 LocatedN RdrName
s' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2'
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
t) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
}
PromotedInfixT Type
t1 Name
s Type
t2
-> do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
s
; GenLocated SrcSpanAnnA (HsType GhcPs)
t1' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t1
; GenLocated SrcSpanAnnA (HsType GhcPs)
t2' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t2
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps
(XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP GhcPs
LocatedN RdrName
s')
([GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
t1', GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
t2'] [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. [a] -> [a] -> [a]
++ [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys')
}
PromotedUInfixT Type
t1 Name
s Type
t2
-> do { LocatedN RdrName
s' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
s
; GenLocated SrcSpanAnnA (HsType GhcPs)
t2' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t2
; GenLocated SrcSpanAnnA (HsType GhcPs)
t <- PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
IsPromoted Type
t1 LocatedN RdrName
s' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2'
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
t) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
}
ParensT Type
t
-> do { GenLocated SrcSpanAnnA (HsType GhcPs)
t' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t') HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
}
PromotedT Name
nm -> do { LocatedN RdrName
nm' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
nm
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP GhcPs
LocatedN RdrName
nm')
HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
PromotedTupleT SumAlt
n
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals [GenLocated SrcSpanAnnA (HsType GhcPs)] -> SumAlt -> Bool
forall a. [a] -> SumAlt -> Bool
`lengthIs` SumAlt
n
-> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XExplicitTupleTy GhcPs -> [LHsType GhcPs] -> HsType GhcPs
forall pass. XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
HsExplicitTupleTy XExplicitTupleTy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
normals)
| Bool
otherwise
-> do { LocatedN RdrName
tuple_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (DataCon -> RdrName) -> DataCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Boxity -> SumAlt -> DataCon
tupleDataCon Boxity
Boxed SumAlt
n
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP GhcPs
LocatedN RdrName
tuple_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
PromotedNilT
-> HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted []) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys'
Type
PromotedConsT
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)
ty1, L SrcSpanAnnA
_ (HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
ip [LHsType GhcPs]
tys2)] <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals
-> HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
ip (GenLocated SrcSpanAnnA (HsType GhcPs)
ty1GenLocated SrcSpanAnnA (HsType GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. a -> [a] -> [a]
:[LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys2))
| Bool
otherwise
-> do { LocatedN RdrName
cons_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
consDataCon
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP GhcPs
LocatedN RdrName
cons_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
StarT
-> do { LocatedN RdrName
type_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
liftedTypeKindTyCon
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
type_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
ConstraintT
-> do { LocatedN RdrName
constraint_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (LocatedN RdrName))
-> RdrName -> CvtM (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
constraintKindTyCon
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
constraint_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
Type
EqualityT
| Just [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
m_normals
, [GenLocated SrcSpanAnnA (HsType GhcPs)
x',GenLocated SrcSpanAnnA (HsType GhcPs)
y'] <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
normals ->
let px :: LHsType GhcPs
px = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
opPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x'
py :: LHsType GhcPs
py = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
opPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
y'
in do { LocatedN RdrName
eq_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
eqTyCon_RDR
; HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XOpTy GhcPs
-> PromotionFlag
-> LHsType GhcPs
-> LIdP GhcPs
-> LHsType GhcPs
-> HsType GhcPs
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LHsType GhcPs
px LIdP GhcPs
LocatedN RdrName
eq_tc LHsType GhcPs
py) }
| Bool
otherwise ->
do { LocatedN RdrName
eq_tc <- RdrName -> CvtM (LocatedN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
eqTyCon_RDR
; HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP GhcPs
LocatedN RdrName
eq_tc) HsTyPats GhcPs
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
tys' }
ImplicitParamT String
n Type
t
-> do { Located HsIPName
n' <- CvtM HsIPName -> CvtM (Located HsIPName)
forall a. CvtM a -> CvtM (Located a)
wrapL (CvtM HsIPName -> CvtM (Located HsIPName))
-> CvtM HsIPName -> CvtM (Located HsIPName)
forall a b. (a -> b) -> a -> b
$ String -> CvtM HsIPName
ipName String
n
; GenLocated SrcSpanAnnA (HsType GhcPs)
t' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
t
; HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XIParamTy GhcPs
-> XRec GhcPs HsIPName -> LHsType GhcPs -> HsType GhcPs
forall pass.
XIParamTy pass -> XRec pass HsIPName -> LHsType pass -> HsType pass
HsIParamTy XIParamTy GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (Located HsIPName -> LocatedAn NoEpAnns HsIPName
forall e ann. Located e -> LocatedAn ann e
reLocA Located HsIPName
n') LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t')
}
Type
_ -> ConversionFailReason
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. ConversionFailReason -> CvtM a
failWith (TypeOrKind -> Type -> ConversionFailReason
MalformedType TypeOrKind
typeOrKind Type
ty)
}
hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs
hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs
hsTypeToArrow LHsType GhcPs
w = case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
w of
HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (L SrcSpanAnnN
_ (RdrName -> Maybe Name
isExact_maybe -> Just Name
n))
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
oneDataConName -> HsLinearArrowTokens GhcPs -> HsArrow GhcPs
forall pass. HsLinearArrowTokens pass -> HsArrow pass
HsLinearArrow (LHsToken "%1" GhcPs
-> LHsUniToken "->" "\8594" GhcPs -> HsLinearArrowTokens GhcPs
forall pass.
LHsToken "%1" pass
-> LHsUniToken "->" "\8594" pass -> HsLinearArrowTokens pass
HsPct1 LHsToken "%1" GhcPs
GenLocated TokenLocation (HsToken "%1")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok)
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
manyDataConName -> LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok
HsType GhcPs
_ -> LHsToken "%" GhcPs
-> LHsType GhcPs -> LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass.
LHsToken "%" pass
-> LHsType pass -> LHsUniToken "->" "\8594" pass -> HsArrow pass
HsExplicitMult LHsToken "%" GhcPs
GenLocated TokenLocation (HsToken "%")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsType GhcPs
w LHsUniToken "->" "\8594" GhcPs
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok
name_promotedness :: RdrName -> Hs.PromotionFlag
name_promotedness :: RdrName -> PromotionFlag
name_promotedness RdrName
nm
| RdrName -> Bool
isRdrDataCon RdrName
nm = PromotionFlag
IsPromoted
| Bool
otherwise = PromotionFlag
NotPromoted
mk_apps :: HsType GhcPs -> [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)
mk_apps :: HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps HsType GhcPs
head_ty HsTyPats GhcPs
type_args = do
GenLocated SrcSpanAnnA (HsType GhcPs)
head_ty' <- HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsType GhcPs
head_ty
let phead_ty :: LHsType GhcPs
phead_ty :: LHsType GhcPs
phead_ty = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
head_ty'
go :: [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)
go :: HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
go [] = GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> CvtM' ConversionFailReason a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnA (HsType GhcPs)
head_ty'
go (LHsTypeArg GhcPs
arg:HsTyPats GhcPs
args) =
case LHsTypeArg GhcPs
arg of
HsValArg LHsType GhcPs
ty -> do GenLocated SrcSpanAnnA (HsType GhcPs)
p_ty <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall {p :: Pass}.
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
add_parens LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XAppTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy GhcPs
NoExtField
noExtField LHsType GhcPs
phead_ty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
p_ty) HsTyPats GhcPs
args
HsTypeArg XRec GhcPs (HsToken "@")
at LHsType GhcPs
ki ->
do GenLocated SrcSpanAnnA (HsType GhcPs)
p_ki <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall {p :: Pass}.
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
add_parens LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki
HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XAppKindTy GhcPs
-> LHsType GhcPs
-> XRec GhcPs (HsToken "@")
-> LHsType GhcPs
-> HsType GhcPs
forall pass.
XAppKindTy pass
-> LHsType pass -> LHsToken "@" pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy GhcPs
NoExtField
noExtField LHsType GhcPs
phead_ty XRec GhcPs (HsToken "@")
at LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
p_ki) HsTyPats GhcPs
args
HsArgPar SrcSpan
_ -> HsType GhcPs
-> HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
mk_apps (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcPs
phead_ty) HsTyPats GhcPs
args
HsTyPats GhcPs -> CvtM' ConversionFailReason (LHsType GhcPs)
go HsTyPats GhcPs
type_args
where
add_parens :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
add_parens lt :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
lt@(L SrcSpanAnnA
_ HsType (GhcPass p)
t)
| PprPrec -> HsType (GhcPass p) -> Bool
forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
appPrec HsType (GhcPass p)
t = HsType (GhcPass p)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
lt)
| Bool
otherwise = GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnA (HsType (GhcPass p))
lt
wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
wrap_tyarg (HsValArg LHsType GhcPs
ty) = LHsType GhcPs -> LHsTypeArg GhcPs
forall p tm ty. tm -> HsArg p tm ty
HsValArg (LHsType GhcPs -> LHsTypeArg GhcPs)
-> LHsType GhcPs -> LHsTypeArg GhcPs
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType GhcPs
ty
wrap_tyarg (HsTypeArg XRec GhcPs (HsToken "@")
l LHsType GhcPs
ki) = XRec GhcPs (HsToken "@") -> LHsType GhcPs -> LHsTypeArg GhcPs
forall p tm ty. LHsToken "@" p -> ty -> HsArg p tm ty
HsTypeArg XRec GhcPs (HsToken "@")
l (LHsType GhcPs -> LHsTypeArg GhcPs)
-> LHsType GhcPs -> LHsTypeArg GhcPs
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType GhcPs
ki
wrap_tyarg ta :: LHsTypeArg GhcPs
ta@(HsArgPar {}) = LHsTypeArg GhcPs
ta
split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
split_ty_app :: Type -> CvtM (Type, HsTyPats GhcPs)
split_ty_app Type
ty = Type
-> [HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> CvtM'
ConversionFailReason
(Type,
[HsArg
GhcPs
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
forall {p}.
(XRec p (HsToken "@") ~ GenLocated TokenLocation (HsToken "@")) =>
Type
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> CvtM'
ConversionFailReason
(Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
go Type
ty []
where
go :: Type
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> CvtM'
ConversionFailReason
(Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
go (AppT Type
f Type
a) [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as' = do { GenLocated SrcSpanAnnA (HsType GhcPs)
a' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
a; Type
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> CvtM'
ConversionFailReason
(Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
go Type
f (GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. tm -> HsArg p tm ty
HsValArg GenLocated SrcSpanAnnA (HsType GhcPs)
a'HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as') }
go (AppKindT Type
ty Type
ki) [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as' = do { GenLocated SrcSpanAnnA (HsType GhcPs)
ki' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtKind Type
ki
; Type
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> CvtM'
ConversionFailReason
(Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
go Type
ty (XRec p (HsToken "@")
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. LHsToken "@" p -> ty -> HsArg p tm ty
HsTypeArg XRec p (HsToken "@")
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok GenLocated SrcSpanAnnA (HsType GhcPs)
ki' HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
: [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as') }
go (ParensT Type
t) [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as' = do { SrcSpan
loc <- CvtM SrcSpan
getL; Type
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> CvtM'
ConversionFailReason
(Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
go Type
t (SrcSpan
-> HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
forall p tm ty. SrcSpan -> HsArg p tm ty
HsArgPar SrcSpan
locHsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. a -> [a] -> [a]
: [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as') }
go Type
f [HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as = (Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
-> CvtM'
ConversionFailReason
(Type,
[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))])
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
f,[HsArg
p
(GenLocated SrcSpanAnnA (HsType GhcPs))
(GenLocated SrcSpanAnnA (HsType GhcPs))]
as)
cvtTyLit :: TH.TyLit -> HsTyLit (GhcPass p)
cvtTyLit :: forall (p :: Pass). TyLit -> HsTyLit (GhcPass p)
cvtTyLit (TH.NumTyLit Integer
i) = XNumTy (GhcPass p) -> Integer -> HsTyLit (GhcPass p)
forall pass. XNumTy pass -> Integer -> HsTyLit pass
HsNumTy XNumTy (GhcPass p)
SourceText
NoSourceText Integer
i
cvtTyLit (TH.StrTyLit String
s) = XStrTy (GhcPass p) -> FastString -> HsTyLit (GhcPass p)
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy (GhcPass p)
SourceText
NoSourceText (String -> FastString
fsLit String
s)
cvtTyLit (TH.CharTyLit Char
c) = XCharTy (GhcPass p) -> Char -> HsTyLit (GhcPass p)
forall pass. XCharTy pass -> Char -> HsTyLit pass
HsCharTy XCharTy (GhcPass p)
SourceText
NoSourceText Char
c
cvtOpAppT :: PromotionFlag -> TH.Type -> LocatedN RdrName -> LHsType GhcPs -> CvtM (LHsType GhcPs)
cvtOpAppT :: PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
prom (UInfixT Type
x Name
op2 Type
y) LocatedN RdrName
op1 LHsType GhcPs
z
= do { LocatedN RdrName
op2' <- Name -> CvtM (LocatedN RdrName)
tconNameN Name
op2
; GenLocated SrcSpanAnnA (HsType GhcPs)
l <- PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
prom Type
y LocatedN RdrName
op1 LHsType GhcPs
z
; PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
NotPromoted Type
x LocatedN RdrName
op2' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
l }
cvtOpAppT PromotionFlag
prom (PromotedUInfixT Type
x Name
op2 Type
y) LocatedN RdrName
op1 LHsType GhcPs
z
= do { LocatedN RdrName
op2' <- Name -> CvtM (LocatedN RdrName)
cNameN Name
op2
; GenLocated SrcSpanAnnA (HsType GhcPs)
l <- PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
prom Type
y LocatedN RdrName
op1 LHsType GhcPs
z
; PromotionFlag
-> Type
-> LocatedN RdrName
-> LHsType GhcPs
-> CvtM' ConversionFailReason (LHsType GhcPs)
cvtOpAppT PromotionFlag
IsPromoted Type
x LocatedN RdrName
op2' LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
l }
cvtOpAppT PromotionFlag
prom Type
x LocatedN RdrName
op LHsType GhcPs
y
= do { GenLocated SrcSpanAnnA (HsType GhcPs)
x' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType Type
x
; HsType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (PromotionFlag
-> LHsType GhcPs
-> LocatedN (IdP GhcPs)
-> LHsType GhcPs
-> HsType GhcPs
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
PromotionFlag
-> LHsType (GhcPass p)
-> LocatedN (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy PromotionFlag
prom LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x' LocatedN (IdP GhcPs)
LocatedN RdrName
op LHsType GhcPs
y) }
cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
cvtKind :: Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtKind = TypeOrKind -> Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtTypeKind TypeOrKind
KindLevel
cvtSigKind :: TH.Kind -> CvtM (LHsSigType GhcPs)
cvtSigKind :: Type -> CvtM (LHsSigType GhcPs)
cvtSigKind = TypeOrKind -> Type -> CvtM (LHsSigType GhcPs)
cvtSigTypeKind TypeOrKind
KindLevel
cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
-> CvtM (LFamilyResultSig GhcPs)
cvtMaybeKindToFamilyResultSig :: Maybe Type -> CvtM (LFamilyResultSig GhcPs)
cvtMaybeKindToFamilyResultSig Maybe Type
Nothing = FamilyResultSig GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XNoSig GhcPs -> FamilyResultSig GhcPs
forall pass. XNoSig pass -> FamilyResultSig pass
Hs.NoSig XNoSig GhcPs
NoExtField
noExtField)
cvtMaybeKindToFamilyResultSig (Just Type
ki) = do { GenLocated SrcSpanAnnA (HsType GhcPs)
ki' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtKind Type
ki
; FamilyResultSig GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCKindSig GhcPs -> LHsType GhcPs -> FamilyResultSig GhcPs
forall pass. XCKindSig pass -> LHsKind pass -> FamilyResultSig pass
Hs.KindSig XCKindSig GhcPs
NoExtField
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki') }
cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
cvtFamilyResultSig :: FamilyResultSig -> CvtM (LFamilyResultSig GhcPs)
cvtFamilyResultSig FamilyResultSig
TH.NoSig = FamilyResultSig GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XNoSig GhcPs -> FamilyResultSig GhcPs
forall pass. XNoSig pass -> FamilyResultSig pass
Hs.NoSig XNoSig GhcPs
NoExtField
noExtField)
cvtFamilyResultSig (TH.KindSig Type
ki) = do { GenLocated SrcSpanAnnA (HsType GhcPs)
ki' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtKind Type
ki
; FamilyResultSig GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCKindSig GhcPs -> LHsType GhcPs -> FamilyResultSig GhcPs
forall pass. XCKindSig pass -> LHsKind pass -> FamilyResultSig pass
Hs.KindSig XCKindSig GhcPs
NoExtField
noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki') }
cvtFamilyResultSig (TH.TyVarSig TyVarBndr ()
bndr) = do { GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
tv <- TyVarBndr () -> CvtM (LHsTyVarBndr () GhcPs)
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv TyVarBndr ()
bndr
; FamilyResultSig GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XTyVarSig GhcPs -> LHsTyVarBndr () GhcPs -> FamilyResultSig GhcPs
forall pass.
XTyVarSig pass -> LHsTyVarBndr () pass -> FamilyResultSig pass
Hs.TyVarSig XTyVarSig GhcPs
NoExtField
noExtField LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
tv) }
cvtInjectivityAnnotation :: TH.InjectivityAnn
-> CvtM (Hs.LInjectivityAnn GhcPs)
cvtInjectivityAnnotation :: InjectivityAnn -> CvtM (LInjectivityAnn GhcPs)
cvtInjectivityAnnotation (TH.InjectivityAnn Name
annLHS [Name]
annRHS)
= do { LocatedN RdrName
annLHS' <- Name -> CvtM (LocatedN RdrName)
tNameN Name
annLHS
; [LocatedN RdrName]
annRHS' <- (Name -> CvtM (LocatedN RdrName))
-> [Name] -> CvtM' ConversionFailReason [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (LocatedN RdrName)
tNameN [Name]
annRHS
; InjectivityAnn GhcPs
-> CvtM'
ConversionFailReason
(GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCInjectivityAnn GhcPs
-> LIdP GhcPs -> [LIdP GhcPs] -> InjectivityAnn GhcPs
forall pass.
XCInjectivityAnn pass
-> LIdP pass -> [LIdP pass] -> InjectivityAnn pass
Hs.InjectivityAnn XCInjectivityAnn GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP GhcPs
LocatedN RdrName
annLHS' [LIdP GhcPs]
[LocatedN RdrName]
annRHS') }
cvtPatSynSigTy :: TH.Type -> CvtM (LHsSigType GhcPs)
cvtPatSynSigTy :: Type -> CvtM (LHsSigType GhcPs)
cvtPatSynSigTy (ForallT [TyVarBndr Specificity]
univs [Type]
reqs (ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty))
| [TyVarBndr Specificity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr Specificity]
exis, [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
provs = Type -> CvtM (LHsSigType GhcPs)
cvtSigType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
univs [Type]
reqs Type
ty)
| [TyVarBndr Specificity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr Specificity]
univs, [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
reqs = do { GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty)
; GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> CvtM'
ConversionFailReason
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA []
; HsSigType GhcPs
cxtTy <- (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsSigType GhcPs)
-> HsType GhcPs -> CvtM (HsSigType GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsType GhcPs -> HsSigType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs) -> HsSigType GhcPs
mkHsImplicitSigType (HsType GhcPs -> CvtM (HsSigType GhcPs))
-> HsType GhcPs -> CvtM (HsSigType GhcPs)
forall a b. (a -> b) -> a -> b
$
HsQualTy { hst_ctxt :: LHsContext GhcPs
hst_ctxt = LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'
, hst_xqual :: XQualTy GhcPs
hst_xqual = XQualTy GhcPs
NoExtField
noExtField
, hst_body :: LHsType GhcPs
hst_body = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' }
; HsSigType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsSigType GhcPs
cxtTy }
| [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
reqs = do { [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
univs' <- [TyVarBndr Specificity] -> CvtM [LHsTyVarBndr Specificity GhcPs]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs [TyVarBndr Specificity]
univs
; GenLocated SrcSpanAnnA (HsType GhcPs)
ty' <- Type -> CvtM' ConversionFailReason (LHsType GhcPs)
cvtType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty)
; LocatedAn AnnContext [LHsType GhcPs]
ctxt' <- [LHsType GhcPs] -> CvtM (LocatedAn AnnContext [LHsType GhcPs])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA []
; let cxtTy :: HsType GhcPs
cxtTy = HsQualTy { hst_ctxt :: LHsContext GhcPs
hst_ctxt = LHsContext GhcPs
LocatedAn AnnContext [LHsType GhcPs]
ctxt'
, hst_xqual :: XQualTy GhcPs
hst_xqual = XQualTy GhcPs
NoExtField
noExtField
, hst_body :: LHsType GhcPs
hst_body = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty' }
; HsSigType GhcPs
forTy <- (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsSigType GhcPs)
-> HsType GhcPs -> CvtM (HsSigType GhcPs)
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcPs]
-> LHsType GhcPs
-> HsSigType GhcPs
mkHsExplicitSigType EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
univs') HsType GhcPs
cxtTy
; HsSigType GhcPs
-> CvtM'
ConversionFailReason (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsSigType GhcPs
forTy }
| Bool
otherwise = Type -> CvtM (LHsSigType GhcPs)
cvtSigType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
univs [Type]
reqs ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty))
cvtPatSynSigTy Type
ty = Type -> CvtM (LHsSigType GhcPs)
cvtSigType Type
ty
cvtFixity :: TH.Fixity -> Hs.Fixity
cvtFixity :: Fixity -> Fixity
cvtFixity (TH.Fixity SumAlt
prec FixityDirection
dir) = SourceText -> SumAlt -> FixityDirection -> Fixity
Hs.Fixity SourceText
NoSourceText SumAlt
prec (FixityDirection -> FixityDirection
cvt_dir FixityDirection
dir)
where
cvt_dir :: FixityDirection -> FixityDirection
cvt_dir FixityDirection
TH.InfixL = FixityDirection
Hs.InfixL
cvt_dir FixityDirection
TH.InfixR = FixityDirection
Hs.InfixR
cvt_dir FixityDirection
TH.InfixN = FixityDirection
Hs.InfixN
overloadedLit :: Lit -> Bool
overloadedLit :: Lit -> Bool
overloadedLit (IntegerL Integer
_) = Bool
True
overloadedLit (RationalL Rational
_) = Bool
True
overloadedLit Lit
_ = Bool
False
unboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM ()
unboxedSumChecks :: SumAlt -> SumAlt -> CvtM ()
unboxedSumChecks SumAlt
alt SumAlt
arity
| SumAlt
alt SumAlt -> SumAlt -> Bool
forall a. Ord a => a -> a -> Bool
> SumAlt
arity
= ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason -> CvtM ())
-> ConversionFailReason -> CvtM ()
forall a b. (a -> b) -> a -> b
$ SumAlt -> SumAlt -> ConversionFailReason
SumAltArityExceeded SumAlt
alt SumAlt
arity
| SumAlt
alt SumAlt -> SumAlt -> Bool
forall a. Ord a => a -> a -> Bool
<= SumAlt
0
= ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason -> CvtM ())
-> ConversionFailReason -> CvtM ()
forall a b. (a -> b) -> a -> b
$ SumAlt -> ConversionFailReason
IllegalSumAlt SumAlt
alt
| SumAlt
arity SumAlt -> SumAlt -> Bool
forall a. Ord a => a -> a -> Bool
< SumAlt
2
= ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith (ConversionFailReason -> CvtM ())
-> ConversionFailReason -> CvtM ()
forall a b. (a -> b) -> a -> b
$ SumAlt -> ConversionFailReason
IllegalSumArity SumAlt
arity
| Bool
otherwise
= () -> CvtM ()
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mkHsForAllTy :: SrcSpanAnnA
-> HsForAllTelescope GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
mkHsForAllTy :: SrcSpanAnnA
-> HsForAllTelescope GhcPs -> LHsType GhcPs -> LHsType GhcPs
mkHsForAllTy SrcSpanAnnA
loc HsForAllTelescope GhcPs
tele LHsType GhcPs
rho_ty
| Bool
no_tvs = LHsType GhcPs
rho_ty
| Bool
otherwise = SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ HsForAllTy { hst_tele :: HsForAllTelescope GhcPs
hst_tele = HsForAllTelescope GhcPs
tele
, hst_xforall :: XForAllTy GhcPs
hst_xforall = XForAllTy GhcPs
NoExtField
noExtField
, hst_body :: LHsType GhcPs
hst_body = LHsType GhcPs
rho_ty }
where
no_tvs :: Bool
no_tvs = case HsForAllTelescope GhcPs
tele of
HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () GhcPs]
bndrs } -> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
bndrs
HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcPs]
bndrs } -> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
bndrs
mkHsQualTy :: TH.Cxt
-> SrcSpanAnnA
-> LHsContext GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
mkHsQualTy :: [Type]
-> SrcSpanAnnA
-> LHsContext GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
mkHsQualTy [Type]
ctxt SrcSpanAnnA
loc LHsContext GhcPs
ctxt' LHsType GhcPs
ty
| [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
ctxt = LHsType GhcPs
ty
| Bool
otherwise = SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ HsQualTy { hst_xqual :: XQualTy GhcPs
hst_xqual = XQualTy GhcPs
NoExtField
noExtField
, hst_ctxt :: LHsContext GhcPs
hst_ctxt = LHsContext GhcPs
ctxt'
, hst_body :: LHsType GhcPs
hst_body = LHsType GhcPs
ty }
mkHsContextMaybe :: LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe :: LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe lctxt :: LHsContext GhcPs
lctxt@(L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt)
| [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt = Maybe (LHsContext GhcPs)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing
| Bool
otherwise = GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> Maybe a
Just LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
lctxt
mkHsOuterFamEqnTyVarBndrs :: Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
mkHsOuterFamEqnTyVarBndrs :: Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
mkHsOuterFamEqnTyVarBndrs = HsOuterFamEqnTyVarBndrs GhcPs
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> HsOuterFamEqnTyVarBndrs GhcPs)
-> Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> HsOuterFamEqnTyVarBndrs GhcPs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsOuterFamEqnTyVarBndrs GhcPs
forall flag. HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit (EpAnnForallTy
-> [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
forall flag.
EpAnnForallTy
-> [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
mkHsOuterExplicit EpAnnForallTy
forall a. EpAnn a
noAnn)
vNameN, cNameN, vcNameN, tNameN, tconNameN :: TH.Name -> CvtM (LocatedN RdrName)
vNameL :: TH.Name -> CvtM (LocatedA RdrName)
vName, cName, vcName, tName, tconName :: TH.Name -> CvtM RdrName
vNameN :: Name -> CvtM (LocatedN RdrName)
vNameN Name
n = CvtM RdrName -> CvtM (LocatedN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
vName Name
n)
vNameL :: Name -> CvtM (LocatedA RdrName)
vNameL Name
n = CvtM RdrName -> CvtM (LocatedA RdrName)
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (Name -> CvtM RdrName
vName Name
n)
vName :: Name -> CvtM RdrName
vName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.varName Name
n
cNameN :: Name -> CvtM (LocatedN RdrName)
cNameN Name
n = CvtM RdrName -> CvtM (LocatedN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
cName Name
n)
cName :: Name -> CvtM RdrName
cName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.dataName Name
n
vcNameN :: Name -> CvtM (LocatedN RdrName)
vcNameN Name
n = CvtM RdrName -> CvtM (LocatedN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
vcName Name
n)
vcName :: Name -> CvtM RdrName
vcName Name
n = if Name -> Bool
isVarName Name
n then Name -> CvtM RdrName
vName Name
n else Name -> CvtM RdrName
cName Name
n
tNameN :: Name -> CvtM (LocatedN RdrName)
tNameN Name
n = CvtM RdrName -> CvtM (LocatedN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
tName Name
n)
tName :: Name -> CvtM RdrName
tName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.tvName Name
n
tconNameN :: Name -> CvtM (LocatedN RdrName)
tconNameN Name
n = CvtM RdrName -> CvtM (LocatedN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
tconName Name
n)
tconName :: Name -> CvtM RdrName
tconName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.tcClsName Name
n
fldName :: String -> TH.Name -> CvtM RdrName
fldName :: String -> Name -> CvtM RdrName
fldName String
con Name
n = NameSpace -> Name -> CvtM RdrName
cvtName (FastString -> NameSpace
OccName.fieldName (FastString -> NameSpace) -> FastString -> NameSpace
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
con) Name
n
fldNameN :: String -> TH.Name -> CvtM (LocatedN RdrName)
fldNameN :: String -> Name -> CvtM (LocatedN RdrName)
fldNameN String
con Name
n = CvtM RdrName -> CvtM (LocatedN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (String -> Name -> CvtM RdrName
fldName String
con Name
n)
ipName :: String -> CvtM HsIPName
ipName :: String -> CvtM HsIPName
ipName String
n
= do { Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
okVarOcc String
n) (ConversionFailReason -> CvtM ()
forall a. ConversionFailReason -> CvtM a
failWith (NameSpace -> String -> ConversionFailReason
IllegalOccName NameSpace
OccName.varName String
n))
; HsIPName -> CvtM HsIPName
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> HsIPName
HsIPName (String -> FastString
fsLit String
n)) }
cvtName :: OccName.NameSpace -> TH.Name -> CvtM RdrName
cvtName :: NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
ctxt_ns (TH.Name OccName
occ NameFlavour
flavour)
| Bool -> Bool
not (NameSpace -> String -> Bool
okOcc NameSpace
ctxt_ns String
occ_str) = ConversionFailReason -> CvtM RdrName
forall a. ConversionFailReason -> CvtM a
failWith (NameSpace -> String -> ConversionFailReason
IllegalOccName NameSpace
ctxt_ns String
occ_str)
| Bool
otherwise
= do { SrcSpan
loc <- CvtM SrcSpan
getL
; let rdr_name :: RdrName
rdr_name = SrcSpan -> NameSpace -> String -> NameFlavour -> RdrName
thRdrName SrcSpan
loc NameSpace
ctxt_ns String
occ_str NameFlavour
flavour
; RdrName -> CvtM ()
forall a. a -> CvtM ()
force RdrName
rdr_name
; RdrName -> CvtM RdrName
forall a. a -> CvtM' ConversionFailReason a
forall (m :: * -> *) a. Monad m => a -> m a
return RdrName
rdr_name }
where
occ_str :: String
occ_str = OccName -> String
TH.occString OccName
occ
okOcc :: OccName.NameSpace -> String -> Bool
okOcc :: NameSpace -> String -> Bool
okOcc NameSpace
ns String
str
| NameSpace -> Bool
OccName.isVarNameSpace NameSpace
ns = String -> Bool
okVarOcc String
str
| NameSpace -> Bool
OccName.isDataConNameSpace NameSpace
ns = String -> Bool
okConOcc String
str
| Bool
otherwise = String -> Bool
okTcOcc String
str
isVarName :: TH.Name -> Bool
isVarName :: Name -> Bool
isVarName (TH.Name OccName
occ NameFlavour
_)
= case OccName -> String
TH.occString OccName
occ of
String
"" -> Bool
False
(Char
c:String
_) -> Char -> Bool
startsVarId Char
c Bool -> Bool -> Bool
|| Char -> Bool
startsVarSym Char
c
thRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
thRdrName :: SrcSpan -> NameSpace -> String -> NameFlavour -> RdrName
thRdrName SrcSpan
loc NameSpace
ctxt_ns String
th_occ NameFlavour
th_name
= case NameFlavour
th_name of
TH.NameG NameSpace
th_ns PkgName
pkg ModName
mod -> String -> NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName String
th_occ NameSpace
th_ns PkgName
pkg ModName
mod
TH.NameQ ModName
mod -> (ModuleName -> OccName -> RdrName
mkRdrQual (ModuleName -> OccName -> RdrName)
-> ModuleName -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! ModName -> ModuleName
mk_mod ModName
mod) (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! OccName
occ
TH.NameL Integer
uniq -> Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$! (((Unique -> OccName -> SrcSpan -> Name
Name.mkInternalName (Unique -> OccName -> SrcSpan -> Name)
-> Unique -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! Word64 -> Unique
mk_uniq (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
uniq)) (OccName -> SrcSpan -> Name) -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! OccName
occ) SrcSpan
loc)
TH.NameU Integer
uniq -> Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$! (((Unique -> OccName -> SrcSpan -> Name
Name.mkSystemNameAt (Unique -> OccName -> SrcSpan -> Name)
-> Unique -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! Word64 -> Unique
mk_uniq (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
uniq)) (OccName -> SrcSpan -> Name) -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! OccName
occ) SrcSpan
loc)
NameFlavour
TH.NameS | Just Name
name <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ -> Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$! Name
name
| Bool
otherwise -> OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! OccName
occ
where
occ :: OccName.OccName
occ :: OccName
occ = NameSpace -> String -> OccName
mk_occ NameSpace
ctxt_ns String
th_occ
thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName :: String -> NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName String
occ NameSpace
th_ns PkgName
pkg ModName
mod =
let occ' :: OccName
occ' = NameSpace -> String -> OccName
mk_occ (NameSpace -> NameSpace
mk_ghc_ns NameSpace
th_ns) String
occ
mod' :: GenModule Unit
mod' = Unit -> ModuleName -> GenModule Unit
forall u. u -> ModuleName -> GenModule u
mkModule (PkgName -> Unit
mk_pkg PkgName
pkg) (ModName -> ModuleName
mk_mod ModName
mod)
in case OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ' Maybe Name -> Maybe Name -> Maybe Name
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GenModule Unit -> OccName -> Maybe Name
isPunOcc_maybe GenModule Unit
mod' OccName
occ' of
Just Name
name -> Name -> RdrName
nameRdrName Name
name
Maybe Name
Nothing -> (GenModule Unit -> OccName -> RdrName
mkOrig (GenModule Unit -> OccName -> RdrName)
-> GenModule Unit -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! GenModule Unit
mod') (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! OccName
occ'
thRdrNameGuesses :: TH.Name -> [RdrName]
thRdrNameGuesses :: Name -> [RdrName]
thRdrNameGuesses (TH.Name OccName
occ NameFlavour
flavour)
| TH.NameG NameSpace
th_ns PkgName
pkg ModName
mod <- NameFlavour
flavour = [ String -> NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName String
occ_str NameSpace
th_ns PkgName
pkg ModName
mod]
| Bool
otherwise = [ SrcSpan -> NameSpace -> String -> NameFlavour -> RdrName
thRdrName SrcSpan
noSrcSpan NameSpace
gns String
occ_str NameFlavour
flavour
| NameSpace
gns <- [NameSpace]
guessed_nss]
where
guessed_nss :: [NameSpace]
guessed_nss
| FastString -> Bool
isLexCon FastString
occ_txt = [NameSpace
OccName.tcName, NameSpace
OccName.dataName]
| FastString -> Bool
isLexVarSym FastString
occ_txt = [NameSpace
OccName.tcName, NameSpace
OccName.varName]
| Bool
otherwise = [NameSpace
OccName.varName, NameSpace
OccName.tvName]
occ_str :: String
occ_str = OccName -> String
TH.occString OccName
occ
occ_txt :: FastString
occ_txt = String -> FastString
mkFastString String
occ_str
mk_occ :: OccName.NameSpace -> String -> OccName.OccName
mk_occ :: NameSpace -> String -> OccName
mk_occ NameSpace
ns String
occ = NameSpace -> String -> OccName
OccName.mkOccName NameSpace
ns String
occ
mk_ghc_ns :: TH.NameSpace -> OccName.NameSpace
mk_ghc_ns :: NameSpace -> NameSpace
mk_ghc_ns NameSpace
TH.DataName = NameSpace
OccName.dataName
mk_ghc_ns NameSpace
TH.TcClsName = NameSpace
OccName.tcClsName
mk_ghc_ns NameSpace
TH.VarName = NameSpace
OccName.varName
mk_ghc_ns (TH.FldName String
con) = FastString -> NameSpace
OccName.fieldName (String -> FastString
fsLit String
con)
mk_mod :: TH.ModName -> ModuleName
mk_mod :: ModName -> ModuleName
mk_mod ModName
mod = String -> ModuleName
mkModuleName (ModName -> String
TH.modString ModName
mod)
mk_pkg :: TH.PkgName -> Unit
mk_pkg :: PkgName -> Unit
mk_pkg PkgName
pkg = String -> Unit
stringToUnit (PkgName -> String
TH.pkgString PkgName
pkg)
mk_uniq :: Word64 -> Unique
mk_uniq :: Word64 -> Unique
mk_uniq Word64
u = Word64 -> Unique
mkUniqueGrimily Word64
u