{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
-- | The two module-loader helpers the HSE front end's recursive import
--   loader (ReWire.HSE.Cache) needs: computing a module's global-name
--   renamer extension and its effective import list.
module ReWire.HSE.Globs (extendWithGlobs, getImps) where

import ReWire.Annotation (Annotation)
import ReWire.HSE.Exports (sDeclHead)
import ReWire.HSE.Rename

import Control.Arrow ((&&&), second)
import Control.Monad (void)
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import Data.Text (Text, pack, unpack)

import qualified Data.Set                     as Set
import qualified Data.Map.Strict              as Map
import qualified Language.Haskell.Exts.Syntax as S

import Language.Haskell.Exts.Syntax hiding (Annotation, Name, Kind)

isPrimMod :: String -> Bool
isPrimMod :: String -> Bool
isPrimMod = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"RWC.Primitives")

-- Note: runs before desugaring.
-- TODO(chathhorn): GADT style decls?
extendWithGlobs :: Annotation a => S.Module a -> Renamer -> Renamer
extendWithGlobs :: forall a. Annotation a => Module a -> Renamer -> Renamer
extendWithGlobs = \ case
      Module a
l (Just (ModuleHead a
_ (ModuleName a
_ String
m) Maybe (WarningText a)
_ Maybe (ExportSpecList a)
_)) [ModulePragma a]
_ [ImportDecl a]
_ [Decl a]
ds | String -> Bool
isPrimMod String
m -> [Decl a] -> ModuleName a -> Renamer -> Renamer
forall a.
Annotation a =>
[Decl a] -> ModuleName a -> Renamer -> Renamer
extendWith [Decl a]
ds (ModuleName a -> Renamer -> Renamer)
-> ModuleName a -> Renamer -> Renamer
forall a b. (a -> b) -> a -> b
$ a -> String -> ModuleName a
forall l. l -> String -> ModuleName l
ModuleName a
l String
""
      Module a
_ (Just (ModuleHead a
_ ModuleName a
m Maybe (WarningText a)
_ Maybe (ExportSpecList a)
_)) [ModulePragma a]
_ [ImportDecl a]
_ [Decl a]
ds                              -> [Decl a] -> ModuleName a -> Renamer -> Renamer
forall a.
Annotation a =>
[Decl a] -> ModuleName a -> Renamer -> Renamer
extendWith [Decl a]
ds ModuleName a
m
      Module a
_                                                                        -> Renamer -> Renamer
forall a. a -> a
id
      where extendWith :: Annotation a => [Decl a] -> ModuleName a -> Renamer -> Renamer
            extendWith :: forall a.
Annotation a =>
[Decl a] -> ModuleName a -> Renamer -> Renamer
extendWith [Decl a]
ds ModuleName a
m = Ctors -> CtorSigs -> Renamer -> Renamer
setCtors ([Decl a] -> Ctors
forall a. Annotation a => [Decl a] -> Ctors
getModCtors [Decl a]
ds) ([Decl a] -> CtorSigs
forall a. Annotation a => [Decl a] -> CtorSigs
getModCtorSigs [Decl a]
ds) (Renamer -> Renamer) -> (Renamer -> Renamer) -> Renamer -> Renamer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Decl a] -> ModuleName () -> Renamer -> Renamer
forall a.
Annotation a =>
[Decl a] -> ModuleName () -> Renamer -> Renamer
extendWith' [Decl a]
ds (ModuleName a -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ModuleName a
m)

            extendWith' :: Annotation a => [Decl a] -> ModuleName () -> Renamer -> Renamer
            extendWith' :: forall a.
Annotation a =>
[Decl a] -> ModuleName () -> Renamer -> Renamer
extendWith' [Decl a]
ds ModuleName ()
m = Namespace -> [(Name (), FQName)] -> Renamer -> Renamer
forall a.
QNamish a =>
Namespace -> [(a, FQName)] -> Renamer -> Renamer
extend Namespace
Value ([Name ()] -> [FQName] -> [(Name (), FQName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Decl a] -> [Name ()]
forall a. Annotation a => [Decl a] -> [Name ()]
getGlobValDefs [Decl a]
ds) ([FQName] -> [(Name (), FQName)])
-> [FQName] -> [(Name (), FQName)]
forall a b. (a -> b) -> a -> b
$ (Name () -> FQName) -> [Name ()] -> [FQName]
forall a b. (a -> b) -> [a] -> [b]
map (QName () -> FQName
forall a b. (QNamish a, QNamish b) => a -> b
qnamish (QName () -> FQName) -> (Name () -> QName ()) -> Name () -> FQName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
S.Qual () ModuleName ()
m) ([Name ()] -> [FQName]) -> [Name ()] -> [FQName]
forall a b. (a -> b) -> a -> b
$ [Decl a] -> [Name ()]
forall a. Annotation a => [Decl a] -> [Name ()]
getGlobValDefs [Decl a]
ds)
                             (Renamer -> Renamer) -> (Renamer -> Renamer) -> Renamer -> Renamer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> [(Name (), FQName)] -> Renamer -> Renamer
forall a.
QNamish a =>
Namespace -> [(a, FQName)] -> Renamer -> Renamer
extend Namespace
Type  ([Name ()] -> [FQName] -> [(Name (), FQName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Decl a] -> [Name ()]
forall a. Annotation a => [Decl a] -> [Name ()]
getGlobTyDefs [Decl a]
ds)  ([FQName] -> [(Name (), FQName)])
-> [FQName] -> [(Name (), FQName)]
forall a b. (a -> b) -> a -> b
$ (Name () -> FQName) -> [Name ()] -> [FQName]
forall a b. (a -> b) -> [a] -> [b]
map (QName () -> FQName
forall a b. (QNamish a, QNamish b) => a -> b
qnamish (QName () -> FQName) -> (Name () -> QName ()) -> Name () -> FQName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
S.Qual () ModuleName ()
m) ([Name ()] -> [FQName]) -> [Name ()] -> [FQName]
forall a b. (a -> b) -> a -> b
$ [Decl a] -> [Name ()]
forall a. Annotation a => [Decl a] -> [Name ()]
getGlobTyDefs [Decl a]
ds)

            getGlobValDefs :: Annotation a => [Decl a] -> [S.Name ()]
            getGlobValDefs :: forall a. Annotation a => [Decl a] -> [Name ()]
getGlobValDefs = (Decl a -> [Name ()]) -> [Decl a] -> [Name ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Decl a -> [Name ()]) -> [Decl a] -> [Name ()])
-> (Decl a -> [Name ()]) -> [Decl a] -> [Name ()]
forall a b. (a -> b) -> a -> b
$ \ case
                  DataDecl a
_ DataOrNew a
_ Maybe (Context a)
_ DeclHead a
_ [QualConDecl a]
cons [Deriving a]
_               -> Set (Name ()) -> [Name ()]
forall a. Set a -> [a]
Set.toList (Set (Name ()) -> [Name ()]) -> Set (Name ()) -> [Name ()]
forall a b. (a -> b) -> a -> b
$ [Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ (QualConDecl a -> Set (Name ()))
-> [QualConDecl a] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl a -> Set (Name ())
forall l. QualConDecl l -> Set (Name ())
getCtor [QualConDecl a]
cons
                  PatBind a
_ (PVar a
_ Name a
n) Rhs a
_ Maybe (Binds a)
_              -> [Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
n]
                  FunBind a
_ (Match a
_ Name a
n [Pat a]
_ Rhs a
_ Maybe (Binds a)
_ : [Match a]
_)       -> [Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
n]
                  FunBind a
_ (InfixMatch a
_ Pat a
_ Name a
n [Pat a]
_ Rhs a
_ Maybe (Binds a)
_: [Match a]
_) -> [Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
n]
                  Decl a
_                                     -> []

            getGlobTyDefs :: Annotation a => [Decl a] -> [S.Name ()]
            getGlobTyDefs :: forall a. Annotation a => [Decl a] -> [Name ()]
getGlobTyDefs = (Decl a -> [Name ()]) -> [Decl a] -> [Name ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Decl a -> [Name ()]) -> [Decl a] -> [Name ()])
-> (Decl a -> [Name ()]) -> [Decl a] -> [Name ()]
forall a b. (a -> b) -> a -> b
$ \ case
                  DataDecl a
_ DataOrNew a
_ Maybe (Context a)
_ DeclHead a
hd [QualConDecl a]
_ [Deriving a]
_ -> [(Name (), [TyVarBind ()]) -> Name ()
forall a b. (a, b) -> a
fst ((Name (), [TyVarBind ()]) -> Name ())
-> (Name (), [TyVarBind ()]) -> Name ()
forall a b. (a -> b) -> a -> b
$ DeclHead a -> (Name (), [TyVarBind ()])
forall a. DeclHead a -> (Name (), [TyVarBind ()])
sDeclHead DeclHead a
hd]
                  TypeDecl a
_ DeclHead a
hd Type a
_       -> [(Name (), [TyVarBind ()]) -> Name ()
forall a b. (a, b) -> a
fst ((Name (), [TyVarBind ()]) -> Name ())
-> (Name (), [TyVarBind ()]) -> Name ()
forall a b. (a -> b) -> a -> b
$ DeclHead a -> (Name (), [TyVarBind ()])
forall a. DeclHead a -> (Name (), [TyVarBind ()])
sDeclHead DeclHead a
hd]
                  Decl a
_                     -> []

            getModCtors :: Annotation a => [S.Decl a] -> Ctors
            getModCtors :: forall a. Annotation a => [Decl a] -> Ctors
getModCtors [Decl a]
ds =  [Ctors] -> Ctors
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Ctors] -> Ctors) -> [Ctors] -> Ctors
forall a b. (a -> b) -> a -> b
$ (Decl a -> Ctors) -> [Decl a] -> [Ctors]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> Ctors
forall l. Decl l -> Ctors
getCtors' [Decl a]
ds

            getCtors' :: Decl l -> Ctors
            getCtors' :: forall l. Decl l -> Ctors
getCtors' = \ case
                  DataDecl l
_ DataOrNew l
_ Maybe (Context l)
_ DeclHead l
dh [QualConDecl l]
cons [Deriving l]
_ -> Name () -> Set (Name ()) -> Ctors
forall k a. k -> a -> Map k a
Map.singleton ((Name (), [TyVarBind ()]) -> Name ()
forall a b. (a, b) -> a
fst ((Name (), [TyVarBind ()]) -> Name ())
-> (Name (), [TyVarBind ()]) -> Name ()
forall a b. (a -> b) -> a -> b
$ DeclHead l -> (Name (), [TyVarBind ()])
forall a. DeclHead a -> (Name (), [TyVarBind ()])
sDeclHead DeclHead l
dh) (Set (Name ()) -> Ctors) -> Set (Name ()) -> Ctors
forall a b. (a -> b) -> a -> b
$ [Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ (QualConDecl l -> Set (Name ()))
-> [QualConDecl l] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Set (Name ())
forall l. QualConDecl l -> Set (Name ())
getCtor [QualConDecl l]
cons
                  Decl l
_                        -> Ctors
forall a. Monoid a => a
mempty

            getModCtorSigs :: Annotation a => [S.Decl a] -> CtorSigs
            getModCtorSigs :: forall a. Annotation a => [Decl a] -> CtorSigs
getModCtorSigs [Decl a]
ds = [CtorSigs] -> CtorSigs
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([CtorSigs] -> CtorSigs) -> [CtorSigs] -> CtorSigs
forall a b. (a -> b) -> a -> b
$ (Decl a -> CtorSigs) -> [Decl a] -> [CtorSigs]
forall a b. (a -> b) -> [a] -> [b]
map Decl a -> CtorSigs
forall l. Decl l -> CtorSigs
getCtorSigs' [Decl a]
ds

            getCtorSigs' :: Decl l -> CtorSigs
            getCtorSigs' :: forall l. Decl l -> CtorSigs
getCtorSigs' = \ case
                  DataDecl l
_ DataOrNew l
_ Maybe (Context l)
_ DeclHead l
dh [QualConDecl l]
cons [Deriving l]
_ -> (Name (), [TyVarBind ()]) -> [QualConDecl l] -> CtorSigs
forall l. (Name (), [TyVarBind ()]) -> [QualConDecl l] -> CtorSigs
getCtorSigs (DeclHead l -> (Name (), [TyVarBind ()])
forall a. DeclHead a -> (Name (), [TyVarBind ()])
sDeclHead DeclHead l
dh) [QualConDecl l]
cons
                  Decl l
_                        -> CtorSigs
forall a. Monoid a => a
mempty

            getCtorSigs :: (S.Name (), [S.TyVarBind ()]) -> [QualConDecl l] -> CtorSigs
            getCtorSigs :: forall l. (Name (), [TyVarBind ()]) -> [QualConDecl l] -> CtorSigs
getCtorSigs (Name (), [TyVarBind ()])
dsig = [(Name (), [(Maybe (Name ()), Type ())])] -> CtorSigs
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name (), [(Maybe (Name ()), Type ())])] -> CtorSigs)
-> ([QualConDecl l] -> [(Name (), [(Maybe (Name ()), Type ())])])
-> [QualConDecl l]
-> CtorSigs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualConDecl l -> (Name (), [(Maybe (Name ()), Type ())]))
-> [QualConDecl l] -> [(Name (), [(Maybe (Name ()), Type ())])]
forall a b. (a -> b) -> [a] -> [b]
map (QualConDecl l -> Name ()
forall l. QualConDecl l -> Name ()
getCtorName (QualConDecl l -> Name ())
-> (QualConDecl l -> [(Maybe (Name ()), Type ())])
-> QualConDecl l
-> (Name (), [(Maybe (Name ()), Type ())])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Maybe (Name ()), Type ()) -> (Maybe (Name ()), Type ()))
-> [(Maybe (Name ()), Type ())] -> [(Maybe (Name ()), Type ())]
forall a b. (a -> b) -> [a] -> [b]
map (Type () -> (Maybe (Name ()), Type ()) -> (Maybe (Name ()), Type ())
forall n. Type () -> (n, Type ()) -> (n, Type ())
extendCtorSig (Type ()
 -> (Maybe (Name ()), Type ()) -> (Maybe (Name ()), Type ()))
-> Type ()
-> (Maybe (Name ()), Type ())
-> (Maybe (Name ()), Type ())
forall a b. (a -> b) -> a -> b
$ (Name (), [TyVarBind ()]) -> Type ()
dsigToTyApp (Name (), [TyVarBind ()])
dsig) ([(Maybe (Name ()), Type ())] -> [(Maybe (Name ()), Type ())])
-> (QualConDecl l -> [(Maybe (Name ()), Type ())])
-> QualConDecl l
-> [(Maybe (Name ()), Type ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualConDecl l -> [(Maybe (Name ()), Type ())]
forall l. QualConDecl l -> [(Maybe (Name ()), Type ())]
getFields)

            dsigToTyApp  :: (S.Name (), [S.TyVarBind ()]) -> S.Type ()
            dsigToTyApp :: (Name (), [TyVarBind ()]) -> Type ()
dsigToTyApp (Name ()
n, [TyVarBind ()]
vs) = (Type () -> Type () -> Type ()) -> Type () -> [Type ()] -> Type ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
S.TyApp ()) (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
S.TyCon () (QName () -> Type ()) -> QName () -> Type ()
forall a b. (a -> b) -> a -> b
$ Name () -> QName ()
forall a b. (QNamish a, QNamish b) => a -> b
qnamish Name ()
n) ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$ (TyVarBind () -> Type ()) -> [TyVarBind ()] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind () -> Type ()
toTyVar [TyVarBind ()]
vs

            toTyVar :: S.TyVarBind () -> S.Type ()
            toTyVar :: TyVarBind () -> Type ()
toTyVar = \ case
                  KindedVar   ()
_ Name ()
n Type ()
_ -> () -> Name () -> Type ()
forall l. l -> Name l -> Type l
TyVar () Name ()
n
                  UnkindedVar ()
_ Name ()
n   -> () -> Name () -> Type ()
forall l. l -> Name l -> Type l
TyVar () Name ()
n

            extendCtorSig :: S.Type () -> (n, S.Type ()) -> (n, S.Type ())
            extendCtorSig :: forall n. Type () -> (n, Type ()) -> (n, Type ())
extendCtorSig Type ()
t = (Type () -> Type ()) -> (n, Type ()) -> (n, Type ())
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Type () -> Type ()) -> (n, Type ()) -> (n, Type ()))
-> (Type () -> Type ()) -> (n, Type ()) -> (n, Type ())
forall a b. (a -> b) -> a -> b
$ () -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
S.TyFun () Type ()
t

            getCtor :: QualConDecl l -> Set (S.Name ())
            getCtor :: forall l. QualConDecl l -> Set (Name ())
getCtor QualConDecl l
d = [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList ([Name ()] -> Set (Name ())) -> [Name ()] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ QualConDecl l -> Name ()
forall l. QualConDecl l -> Name ()
getCtorName QualConDecl l
d Name () -> [Name ()] -> [Name ()]
forall a. a -> [a] -> [a]
: [(Maybe (Name ()), Type ())] -> [Name ()]
getFieldNames (QualConDecl l -> [(Maybe (Name ()), Type ())]
forall l. QualConDecl l -> [(Maybe (Name ()), Type ())]
getFields QualConDecl l
d)

            getCtorName :: QualConDecl l -> S.Name ()
            getCtorName :: forall l. QualConDecl l -> Name ()
getCtorName = \ case
                  QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ (ConDecl l
_ Name l
n [Type l]
_)        -> Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n
                  QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ (InfixConDecl l
_ Type l
_ Name l
n Type l
_) -> Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n
                  QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ (RecDecl l
_ Name l
n [FieldDecl l]
_)        -> Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n

            getFields :: QualConDecl l -> [(Maybe (S.Name ()), S.Type ())]
            getFields :: forall l. QualConDecl l -> [(Maybe (Name ()), Type ())]
getFields = \ case
                  QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ (ConDecl l
_ Name l
_ [Type l]
ts)         -> (Type l -> (Maybe (Name ()), Type ()))
-> [Type l] -> [(Maybe (Name ()), Type ())]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (Name ())
forall a. Maybe a
Nothing, ) (Type () -> (Maybe (Name ()), Type ()))
-> (Type l -> Type ()) -> Type l -> (Maybe (Name ()), Type ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type l -> Type ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) [Type l]
ts
                  QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ (InfixConDecl l
_ Type l
t1 Name l
_ Type l
t2) -> [(Maybe (Name ())
forall a. Maybe a
Nothing, Type l -> Type ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Type l
t1), (Maybe (Name ())
forall a. Maybe a
Nothing, Type l -> Type ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Type l
t2)]
                  QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ (RecDecl l
_ Name l
_ [FieldDecl l]
fs)         -> (FieldDecl l -> [(Maybe (Name ()), Type ())])
-> [FieldDecl l] -> [(Maybe (Name ()), Type ())]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldDecl l -> [(Maybe (Name ()), Type ())]
forall l. FieldDecl l -> [(Maybe (Name ()), Type ())]
getFields' [FieldDecl l]
fs

            getFields' :: FieldDecl l -> [(Maybe (S.Name ()), S.Type ())]
            getFields' :: forall l. FieldDecl l -> [(Maybe (Name ()), Type ())]
getFields' (FieldDecl l
_ [Name l]
ns Type l
t) = (Name l -> (Maybe (Name ()), Type ()))
-> [Name l] -> [(Maybe (Name ()), Type ())]
forall a b. (a -> b) -> [a] -> [b]
map ((, Type l -> Type ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Type l
t) (Maybe (Name ()) -> (Maybe (Name ()), Type ()))
-> (Name l -> Maybe (Name ()))
-> Name l
-> (Maybe (Name ()), Type ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name () -> Maybe (Name ())
forall a. a -> Maybe a
Just (Name () -> Maybe (Name ()))
-> (Name l -> Name ()) -> Name l -> Maybe (Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) [Name l]
ns

            getFieldNames :: [(Maybe (S.Name ()), S.Type ())] -> [S.Name ()]
            getFieldNames :: [(Maybe (Name ()), Type ())] -> [Name ()]
getFieldNames = ((Maybe (Name ()), Type ()) -> Maybe (Name ()))
-> [(Maybe (Name ()), Type ())] -> [Name ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe (Name ()), Type ()) -> Maybe (Name ())
forall a b. (a, b) -> a
fst

getImps :: Annotation a => S.Module a -> [ImportDecl a]
getImps :: forall a. Annotation a => Module a -> [ImportDecl a]
getImps = \ case
      -- TODO(chathhorn): hacky. The prim/ReWire module really shouldn't depend on Prelude.
      S.Module a
_ (Just (ModuleHead a
_ (ModuleName a
_ String
m) Maybe (WarningText a)
_ Maybe (ExportSpecList a)
_)) [ModulePragma a]
_ [ImportDecl a]
_ [Decl a]
_ | String -> Bool
isPrimMod String
m     -> [] -- all imports ignored in the Prim module.
      S.Module a
l (Just (ModuleHead a
_ (ModuleName a
_ String
"ReWire.Prelude") Maybe (WarningText a)
_ Maybe (ExportSpecList a)
_)) [ModulePragma a]
_ [ImportDecl a]
imps [Decl a]
_ -> a -> Text -> [ImportDecl a] -> [ImportDecl a]
forall a.
Annotation a =>
a -> Text -> [ImportDecl a] -> [ImportDecl a]
addMod a
l Text
"ReWire" ([ImportDecl a] -> [ImportDecl a])
-> [ImportDecl a] -> [ImportDecl a]
forall a b. (a -> b) -> a -> b
$ (ImportDecl a -> Bool) -> [ImportDecl a] -> [ImportDecl a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ImportDecl a -> Bool) -> ImportDecl a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImportDecl a -> Bool
forall a. Annotation a => Text -> ImportDecl a -> Bool
isMod Text
"Prelude") [ImportDecl a]
imps -- TODO(chathhorn) gah!
      S.Module a
l Maybe (ModuleHead a)
_ [ModulePragma a]
_ [ImportDecl a]
imps [Decl a]
_                                                         -> a -> Text -> [ImportDecl a] -> [ImportDecl a]
forall a.
Annotation a =>
a -> Text -> [ImportDecl a] -> [ImportDecl a]
addMod a
l Text
"ReWire.Prelude" ([ImportDecl a] -> [ImportDecl a])
-> [ImportDecl a] -> [ImportDecl a]
forall a b. (a -> b) -> a -> b
$ a -> Text -> [ImportDecl a] -> [ImportDecl a]
forall a.
Annotation a =>
a -> Text -> [ImportDecl a] -> [ImportDecl a]
addMod a
l Text
"ReWire" ([ImportDecl a] -> [ImportDecl a])
-> [ImportDecl a] -> [ImportDecl a]
forall a b. (a -> b) -> a -> b
$ (ImportDecl a -> Bool) -> [ImportDecl a] -> [ImportDecl a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ImportDecl a -> Bool) -> ImportDecl a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImportDecl a -> Bool
forall a. Annotation a => Text -> ImportDecl a -> Bool
isMod Text
"Prelude") [ImportDecl a]
imps
      S.XmlPage {}                                                                  -> []
      S.XmlHybrid a
l Maybe (ModuleHead a)
_ [ModulePragma a]
_ [ImportDecl a]
imps [Decl a]
_ XName a
_ [XAttr a]
_ Maybe (Exp a)
_ [Exp a]
_                                              -> a -> Text -> [ImportDecl a] -> [ImportDecl a]
forall a.
Annotation a =>
a -> Text -> [ImportDecl a] -> [ImportDecl a]
addMod a
l Text
"ReWire.Prelude" ([ImportDecl a] -> [ImportDecl a])
-> [ImportDecl a] -> [ImportDecl a]
forall a b. (a -> b) -> a -> b
$ a -> Text -> [ImportDecl a] -> [ImportDecl a]
forall a.
Annotation a =>
a -> Text -> [ImportDecl a] -> [ImportDecl a]
addMod a
l Text
"ReWire" ([ImportDecl a] -> [ImportDecl a])
-> [ImportDecl a] -> [ImportDecl a]
forall a b. (a -> b) -> a -> b
$ (ImportDecl a -> Bool) -> [ImportDecl a] -> [ImportDecl a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ImportDecl a -> Bool) -> ImportDecl a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImportDecl a -> Bool
forall a. Annotation a => Text -> ImportDecl a -> Bool
isMod Text
"Prelude") [ImportDecl a]
imps
      where addMod :: Annotation a => a -> Text -> [ImportDecl a] -> [ImportDecl a]
            addMod :: forall a.
Annotation a =>
a -> Text -> [ImportDecl a] -> [ImportDecl a]
addMod a
l Text
m [ImportDecl a]
imps = if (ImportDecl a -> Bool) -> [ImportDecl a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> ImportDecl a -> Bool
forall a. Annotation a => Text -> ImportDecl a -> Bool
isMod Text
m) [ImportDecl a]
imps then [ImportDecl a]
imps
                  else a
-> ModuleName a
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName a)
-> Maybe (ImportSpecList a)
-> ImportDecl a
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl a
l (a -> String -> ModuleName a
forall l. l -> String -> ModuleName l
ModuleName a
l (Text -> String
unpack Text
m)) Bool
False Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName a)
forall a. Maybe a
Nothing Maybe (ImportSpecList a)
forall a. Maybe a
Nothing ImportDecl a -> [ImportDecl a] -> [ImportDecl a]
forall a. a -> [a] -> [a]
: [ImportDecl a]
imps

            isMod :: Annotation a => Text -> ImportDecl a -> Bool
            isMod :: forall a. Annotation a => Text -> ImportDecl a -> Bool
isMod Text
m ImportDecl { importModule :: forall l. ImportDecl l -> ModuleName l
importModule = ModuleName a
_ String
n } = String -> Text
pack String
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
m