{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}
module NriPrelude.Plugin
( plugin,
)
where
import Data.Function ((&))
import qualified Data.List
#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Plugins as GhcPlugins
#else
import GhcPlugins
#endif
import NriPrelude.Plugin.GhcVersionDependent
( hsmodImports,
hsmodName,
ideclImplicit,
ideclName,
ideclQualified,
isQualified,
mkQualified,
simpleImportDecl,
)
import qualified Set
import Prelude
plugin :: GhcPlugins.Plugin
plugin :: Plugin
plugin =
Plugin
GhcPlugins.defaultPlugin
{ parsedResultAction :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
GhcPlugins.parsedResultAction = [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
addImplicitImports,
pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
GhcPlugins.pluginRecompile = [CommandLineOption] -> IO PluginRecompile
GhcPlugins.purePlugin
}
addImplicitImports ::
[GhcPlugins.CommandLineOption] ->
GhcPlugins.ModSummary ->
GhcPlugins.HsParsedModule ->
GhcPlugins.Hsc GhcPlugins.HsParsedModule
addImplicitImports :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
addImplicitImports [CommandLineOption]
_ ModSummary
_ HsParsedModule
parsed =
HsParsedModule -> Hsc HsParsedModule
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
HsParsedModule
parsed
{ hpm_module :: Located (HsModule GhcPs)
GhcPlugins.hpm_module =
(HsModule GhcPs -> HsModule GhcPs)
-> Located (HsModule GhcPs) -> Located (HsModule GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsModule GhcPs -> HsModule GhcPs
forall (p :: Pass). HsModule (GhcPass p) -> HsModule (GhcPass p)
addImportsWhenNotPath (HsParsedModule -> Located (HsModule GhcPs)
GhcPlugins.hpm_module HsParsedModule
parsed)
}
where
addImportsWhenNotPath :: HsModule (GhcPass p) -> HsModule (GhcPass p)
addImportsWhenNotPath HsModule (GhcPass p)
hsModule =
case (GenLocated SrcSpan ModuleName -> CommandLineOption)
-> Maybe (GenLocated SrcSpan ModuleName) -> Maybe CommandLineOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpan ModuleName -> CommandLineOption
forall l. GenLocated l ModuleName -> CommandLineOption
unLocate (HsModule (GhcPass p) -> Maybe (GenLocated SrcSpan ModuleName)
forall pass. HsModule pass -> Maybe (GenLocated SrcSpan ModuleName)
hsmodName HsModule (GhcPass p)
hsModule) of
Maybe CommandLineOption
Nothing -> HsModule (GhcPass p) -> HsModule (GhcPass p)
forall (p :: Pass). HsModule (GhcPass p) -> HsModule (GhcPass p)
addImports HsModule (GhcPass p)
hsModule
Just CommandLineOption
modName ->
if CommandLineOption -> CommandLineOption -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isPrefixOf CommandLineOption
"Paths_" CommandLineOption
modName
then HsModule (GhcPass p)
hsModule
else HsModule (GhcPass p) -> HsModule (GhcPass p)
forall (p :: Pass). HsModule (GhcPass p) -> HsModule (GhcPass p)
addImports HsModule (GhcPass p)
hsModule
addImports :: HsModule (GhcPass p) -> HsModule (GhcPass p)
addImports HsModule (GhcPass p)
hsModule =
HsModule (GhcPass p)
hsModule
{ hsmodImports :: [LImportDecl (GhcPass p)]
hsmodImports =
HsModule (GhcPass p) -> [LImportDecl (GhcPass p)]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule (GhcPass p)
hsModule
[LImportDecl (GhcPass p)]
-> [LImportDecl (GhcPass p)] -> [LImportDecl (GhcPass p)]
forall a. [a] -> [a] -> [a]
++ ( Set Import -> Set Import -> Set Import
forall comparable.
Ord comparable =>
Set comparable -> Set comparable -> Set comparable
Set.diff Set Import
extraImports (HsModule (GhcPass p) -> Set Import
forall pass. HsModule pass -> Set Import
existingImports HsModule (GhcPass p)
hsModule)
Set Import -> (Set Import -> List Import) -> List Import
forall a b. a -> (a -> b) -> b
& Set Import -> List Import
forall a. Set a -> List a
Set.toList
List Import
-> (List Import -> [LImportDecl (GhcPass p)])
-> [LImportDecl (GhcPass p)]
forall a b. a -> (a -> b) -> b
& (Import -> LImportDecl (GhcPass p))
-> List Import -> [LImportDecl (GhcPass p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( \Import
imp ->
case Import
imp of
Unqualified CommandLineOption
name -> CommandLineOption -> LImportDecl (GhcPass p)
forall (f :: * -> *) pass (p :: Pass).
(HasSrcSpan (f (ImportDecl pass)), Functor f,
SrcSpanLess (f (ImportDecl pass)) ~ ImportDecl (GhcPass p)) =>
CommandLineOption -> f (ImportDecl pass)
unqualified CommandLineOption
name
Qualified CommandLineOption
name -> CommandLineOption -> LImportDecl (GhcPass p)
forall (f :: * -> *) pass (p :: Pass).
(Functor f, HasSrcSpan (f (ImportDecl pass)),
SrcSpanLess (f (ImportDecl pass)) ~ ImportDecl (GhcPass p)) =>
CommandLineOption -> f (ImportDecl pass)
qualified CommandLineOption
name
)
)
}
existingImports :: HsModule pass -> Set Import
existingImports HsModule pass
hsModule =
HsModule pass -> [LImportDecl pass]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule pass
hsModule
[LImportDecl pass]
-> ([LImportDecl pass] -> List Import) -> List Import
forall a b. a -> (a -> b) -> b
& (LImportDecl pass -> Import) -> [LImportDecl pass] -> List Import
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( \(GhcPlugins.L SrcSpan
_ ImportDecl pass
imp) ->
case (ImportDecl pass -> Bool
forall pass. ImportDecl pass -> Bool
isQualified ImportDecl pass
imp, GenLocated SrcSpan ModuleName -> CommandLineOption
forall l. GenLocated l ModuleName -> CommandLineOption
unLocate (ImportDecl pass -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclName ImportDecl pass
imp)) of
(Bool
True, CommandLineOption
name) -> CommandLineOption -> Import
Qualified CommandLineOption
name
(Bool
False, CommandLineOption
name) -> CommandLineOption -> Import
Unqualified CommandLineOption
name
)
List Import -> (List Import -> Set Import) -> Set Import
forall a b. a -> (a -> b) -> b
& List Import -> Set Import
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList
unLocate :: GenLocated l ModuleName -> CommandLineOption
unLocate (GhcPlugins.L l
_ ModuleName
x) = ModuleName -> CommandLineOption
GhcPlugins.moduleNameString ModuleName
x
unqualified :: CommandLineOption -> f (ImportDecl pass)
unqualified CommandLineOption
name =
SrcSpanLess (f (ImportDecl pass)) -> f (ImportDecl pass)
forall a. HasSrcSpan a => SrcSpanLess a -> a
GhcPlugins.noLoc (ModuleName -> ImportDecl (GhcPass p)
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl (CommandLineOption -> ModuleName
GhcPlugins.mkModuleName CommandLineOption
name))
f (ImportDecl pass)
-> (f (ImportDecl pass) -> f (ImportDecl pass))
-> f (ImportDecl pass)
forall a b. a -> (a -> b) -> b
& (ImportDecl pass -> ImportDecl pass)
-> f (ImportDecl pass) -> f (ImportDecl pass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ImportDecl pass
qual -> ImportDecl pass
qual {ideclImplicit :: Bool
ideclImplicit = Bool
True})
qualified :: CommandLineOption -> f (ImportDecl pass)
qualified CommandLineOption
name =
(ImportDecl pass -> ImportDecl pass)
-> f (ImportDecl pass) -> f (ImportDecl pass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ImportDecl pass
qual -> ImportDecl pass
qual {ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
mkQualified}) (CommandLineOption -> f (ImportDecl pass)
forall (f :: * -> *) pass (p :: Pass).
(HasSrcSpan (f (ImportDecl pass)), Functor f,
SrcSpanLess (f (ImportDecl pass)) ~ ImportDecl (GhcPass p)) =>
CommandLineOption -> f (ImportDecl pass)
unqualified CommandLineOption
name)
data Import
= Unqualified String
| Qualified String
deriving (Import -> Import -> Bool
(Import -> Import -> Bool)
-> (Import -> Import -> Bool) -> Eq Import
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Eq Import
Eq Import
-> (Import -> Import -> Ordering)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Import)
-> (Import -> Import -> Import)
-> Ord Import
Import -> Import -> Bool
Import -> Import -> Ordering
Import -> Import -> Import
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Import -> Import -> Import
$cmin :: Import -> Import -> Import
max :: Import -> Import -> Import
$cmax :: Import -> Import -> Import
>= :: Import -> Import -> Bool
$c>= :: Import -> Import -> Bool
> :: Import -> Import -> Bool
$c> :: Import -> Import -> Bool
<= :: Import -> Import -> Bool
$c<= :: Import -> Import -> Bool
< :: Import -> Import -> Bool
$c< :: Import -> Import -> Bool
compare :: Import -> Import -> Ordering
$ccompare :: Import -> Import -> Ordering
$cp1Ord :: Eq Import
Ord)
extraImports :: Set.Set Import
=
List Import -> Set Import
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList
[ CommandLineOption -> Import
Unqualified CommandLineOption
"NriPrelude",
CommandLineOption -> Import
Qualified CommandLineOption
"Basics",
CommandLineOption -> Import
Qualified CommandLineOption
"Char",
CommandLineOption -> Import
Qualified CommandLineOption
"Debug",
CommandLineOption -> Import
Qualified CommandLineOption
"List",
CommandLineOption -> Import
Qualified CommandLineOption
"Maybe",
CommandLineOption -> Import
Qualified CommandLineOption
"Platform",
CommandLineOption -> Import
Qualified CommandLineOption
"Result",
CommandLineOption -> Import
Qualified CommandLineOption
"Text",
CommandLineOption -> Import
Qualified CommandLineOption
"Tuple",
CommandLineOption -> Import
Qualified CommandLineOption
"Log",
CommandLineOption -> Import
Qualified CommandLineOption
"Task"
]