{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}

-- | A GHC plugin for a more Elm-like Haskell experience. It automatically
-- adds an unqualified import of the NriPrelude module, and qualified imports of
-- other base modules such as List and Maybe.
--
-- To use it make sure your project has @nri-prelude@ listed as a dependency,
-- then add the follwing ghc option to your cabal or package yaml file:
--
-- > -fplugin=NriPrelude.Plugin
module NriPrelude.Plugin
  ( plugin,
  )
where

-- Useful documentation
-- - Elm's default imports: https://package.elm-lang.org/packages/elm/core/latest/
-- - GHC user guide on compiler plugins: https://ghc.gitlab.haskell.org/ghc/doc/users_guide/extending_ghc.html#compiler-plugins
-- - Module providing API for creating plugins: https://www.stackage.org/haddock/lts-17.4/ghc-lib-8.10.4.20210206/GhcPlugins.html

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

-- | adds an unqualified import of the NriPrelude module, and qualified imports of
-- other base modules such as List and Maybe.
--
-- To use it make sure your project has @nri-prelude@ listed as a dependency,
-- then add the follwing ghc option to your cabal or package yaml file:
--
-- > -fplugin=NriPrelude.Plugin
plugin :: GhcPlugins.Plugin
plugin :: Plugin
plugin =
  Plugin
GhcPlugins.defaultPlugin
    { parsedResultAction :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
GhcPlugins.parsedResultAction = [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
addImplicitImports,
      -- Let GHC know this plugin doesn't perform arbitrary IO. Given the same
      -- input file it will make the same changes. Without this GHC will
      -- recompile modules using this plugin every time which is expensive.
      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 =
            -- Add default Elm-like imports when the user hasn't imported them
            -- explicitly yet, in order to avoid duplicate import warnings.
            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)

-- taken from https://package.elm-lang.org/packages/elm/core/latest/
extraImports :: Set.Set Import
extraImports :: Set Import
extraImports =
  List Import -> Set Import
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList
    [ CommandLineOption -> Import
Unqualified CommandLineOption
"NriPrelude", -- Elm exports types from withi these modules. We re-export them from NriPrelude. Same effect.
      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", -- equivalent to Elm's String
      CommandLineOption -> Import
Qualified CommandLineOption
"Tuple",
      -- Additionally Task and Log because we use them everywhere
      CommandLineOption -> Import
Qualified CommandLineOption
"Log",
      CommandLineOption -> Import
Qualified CommandLineOption
"Task"
    ]