-- Copyright (c) Facebook, Inc. and its affiliates.
--
-- This source code is licensed under the MIT license found in the
-- LICENSE file in the root directory of this source tree.
--
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Retrie.CPP
  ( CPP(..)
  , addImportsCPP
  , parseCPPFile
  , parseCPP
  , printCPP
    -- ** Internal interface exported for tests
  , cppFork
  ) where

import Data.Char (isSpace)
import Data.Function (on)
import Data.Functor.Identity
import Data.List (nubBy, sortOn)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Debug.Trace
import Retrie.ExactPrint
import Retrie.GHC
import Retrie.Replace

-- Note [CPP]
-- We can't just run the pre-processor on files and then rewrite them, because
-- the rewrites will apply to a module that never exists as code! Exactprint
-- has no support for roundtripping CPP, because the GHC parser doesn't
-- actually parse it (it looks for the pragma and then delegates to the
-- pre-processor).
--
-- To solve this, we instead generate all possible versions of the module
-- (exponential in the number of #if directives :-P). We then apply rewrites
-- to all versions, and collect all the 'Replacement's that they generate.
-- We can then use these to splice results back into the original file.
--
-- Suprisingly, this works. It depends on a few observations:
--
-- * We don't need to actually evaluate any CPP directives. This is because
--   we want all versions of the file.
--
-- * Since we don't need to evaluate, we can simply replace all CPP directives
--   with blank lines and the locations of all AST elements in each version of
--   the module will be exactly the same as in the original module. This is the
--   key to splicing properly.
--
-- * Replacements can be spliced in directly with no smarts about binders, etc,
--   because retrie did the instantiation during matching.
--

-- The CPP Type ----------------------------------------------------------------

data CPP a
  = NoCPP a
  | CPP Text [AnnotatedImports] [a]

instance Functor CPP where
  fmap :: (a -> b) -> CPP a -> CPP b
fmap a -> b
f (NoCPP a
x) = b -> CPP b
forall a. a -> CPP a
NoCPP (a -> b
f a
x)
  fmap a -> b
f (CPP Text
orig [AnnotatedImports]
is [a]
xs) = Text -> [AnnotatedImports] -> [b] -> CPP b
forall a. Text -> [AnnotatedImports] -> [a] -> CPP a
CPP Text
orig [AnnotatedImports]
is ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)

instance Foldable CPP where
  foldMap :: (a -> m) -> CPP a -> m
foldMap a -> m
f (NoCPP a
x) = a -> m
f a
x
  foldMap a -> m
f (CPP Text
_ [AnnotatedImports]
_ [a]
xs) = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
xs

instance Traversable CPP where
  traverse :: (a -> f b) -> CPP a -> f (CPP b)
traverse a -> f b
f (NoCPP a
x) = b -> CPP b
forall a. a -> CPP a
NoCPP (b -> CPP b) -> f b -> f (CPP b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
  traverse a -> f b
f (CPP Text
orig [AnnotatedImports]
is [a]
xs) = Text -> [AnnotatedImports] -> [b] -> CPP b
forall a. Text -> [AnnotatedImports] -> [a] -> CPP a
CPP Text
orig [AnnotatedImports]
is ([b] -> CPP b) -> f [b] -> f (CPP b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
xs

addImportsCPP
  :: [AnnotatedImports]
  -> CPP AnnotatedModule
  -> CPP AnnotatedModule
addImportsCPP :: [AnnotatedImports] -> CPP AnnotatedModule -> CPP AnnotatedModule
addImportsCPP [AnnotatedImports]
is (NoCPP AnnotatedModule
m) =
  AnnotatedModule -> CPP AnnotatedModule
forall a. a -> CPP a
NoCPP (AnnotatedModule -> CPP AnnotatedModule)
-> AnnotatedModule -> CPP AnnotatedModule
forall a b. (a -> b) -> a -> b
$ Identity AnnotatedModule -> AnnotatedModule
forall a. Identity a -> a
runIdentity (Identity AnnotatedModule -> AnnotatedModule)
-> Identity AnnotatedModule -> AnnotatedModule
forall a b. (a -> b) -> a -> b
$ AnnotatedModule
-> (Located HsModule -> TransformT Identity (Located HsModule))
-> Identity AnnotatedModule
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA AnnotatedModule
m ((Located HsModule -> TransformT Identity (Located HsModule))
 -> Identity AnnotatedModule)
-> (Located HsModule -> TransformT Identity (Located HsModule))
-> Identity AnnotatedModule
forall a b. (a -> b) -> a -> b
$ [AnnotatedImports]
-> Located HsModule -> TransformT Identity (Located HsModule)
forall (m :: * -> *).
Monad m =>
[AnnotatedImports]
-> Located HsModule -> TransformT m (Located HsModule)
insertImports [AnnotatedImports]
is
addImportsCPP [AnnotatedImports]
is (CPP Text
orig [AnnotatedImports]
is' [AnnotatedModule]
ms) = Text
-> [AnnotatedImports] -> [AnnotatedModule] -> CPP AnnotatedModule
forall a. Text -> [AnnotatedImports] -> [a] -> CPP a
CPP Text
orig ([AnnotatedImports]
is[AnnotatedImports] -> [AnnotatedImports] -> [AnnotatedImports]
forall a. [a] -> [a] -> [a]
++[AnnotatedImports]
is') [AnnotatedModule]
ms

-- Parsing a CPP Module --------------------------------------------------------

parseCPPFile
  :: (FilePath -> String -> IO AnnotatedModule)
  -> FilePath
  -> IO (CPP AnnotatedModule)
parseCPPFile :: (FilePath -> FilePath -> IO AnnotatedModule)
-> FilePath -> IO (CPP AnnotatedModule)
parseCPPFile FilePath -> FilePath -> IO AnnotatedModule
p FilePath
fp =
  -- read file strictly
  FilePath -> IO Text
Text.readFile FilePath
fp IO Text
-> (Text -> IO (CPP AnnotatedModule)) -> IO (CPP AnnotatedModule)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO AnnotatedModule)
-> Text -> IO (CPP AnnotatedModule)
forall (m :: * -> *).
Monad m =>
(FilePath -> m AnnotatedModule) -> Text -> m (CPP AnnotatedModule)
parseCPP (FilePath -> FilePath -> IO AnnotatedModule
p FilePath
fp)

parseCPP
  :: Monad m
  => (String -> m AnnotatedModule)
  -> Text -> m (CPP AnnotatedModule)
parseCPP :: (FilePath -> m AnnotatedModule) -> Text -> m (CPP AnnotatedModule)
parseCPP FilePath -> m AnnotatedModule
p Text
orig
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
isCPP (Text -> [Text]
Text.lines Text
orig) =
    Text
-> [AnnotatedImports] -> [AnnotatedModule] -> CPP AnnotatedModule
forall a. Text -> [AnnotatedImports] -> [a] -> CPP a
CPP Text
orig [] ([AnnotatedModule] -> CPP AnnotatedModule)
-> m [AnnotatedModule] -> m (CPP AnnotatedModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> m AnnotatedModule) -> [Text] -> m [AnnotatedModule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> m AnnotatedModule
p (FilePath -> m AnnotatedModule)
-> (Text -> FilePath) -> Text -> m AnnotatedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack) (Text -> [Text]
cppFork Text
orig)
  | Bool
otherwise = AnnotatedModule -> CPP AnnotatedModule
forall a. a -> CPP a
NoCPP (AnnotatedModule -> CPP AnnotatedModule)
-> m AnnotatedModule -> m (CPP AnnotatedModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m AnnotatedModule
p (Text -> FilePath
Text.unpack Text
orig)

-- Printing a CPP Module -------------------------------------------------------

printCPP :: [Replacement] -> CPP AnnotatedModule -> String
printCPP :: [Replacement] -> CPP AnnotatedModule -> FilePath
printCPP [Replacement]
_ (NoCPP AnnotatedModule
m) = AnnotatedModule -> FilePath
forall ast. Annotate ast => Annotated (Located ast) -> FilePath
printA AnnotatedModule
m
printCPP [Replacement]
repls (CPP Text
orig [AnnotatedImports]
is [AnnotatedModule]
ms) = Text -> FilePath
Text.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
  case [AnnotatedImports]
is of
    [] -> Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice Text
"" Int
1 Int
1 [(RealSrcSpan, FilePath)]
sorted [Text]
origLines
    [AnnotatedImports]
_ ->
      Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice
        ([Text] -> Text
Text.unlines [Text]
newHeader)
        ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
revHeader Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Int
1
        [(RealSrcSpan, FilePath)]
sorted
        ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
revDecls)
  where
    sorted :: [(RealSrcSpan, FilePath)]
sorted = ((RealSrcSpan, FilePath) -> RealSrcSpan)
-> [(RealSrcSpan, FilePath)] -> [(RealSrcSpan, FilePath)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (RealSrcSpan, FilePath) -> RealSrcSpan
forall a b. (a, b) -> a
fst
      [ (RealSrcSpan
r, FilePath
replReplacement)
      | Replacement{FilePath
SrcSpan
replReplacement :: Replacement -> FilePath
replOriginal :: Replacement -> FilePath
replLocation :: Replacement -> SrcSpan
replOriginal :: FilePath
replLocation :: SrcSpan
replReplacement :: FilePath
..} <- [Replacement]
repls
      , Just RealSrcSpan
r <- [SrcSpan -> Maybe RealSrcSpan
getRealSpan SrcSpan
replLocation]
      ]

    origLines :: [Text]
origLines = Text -> [Text]
Text.lines Text
orig
    mbName :: Maybe ModuleName
mbName = Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule -> Maybe (Located ModuleName)
forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName (Located HsModule -> SrcSpanLess (Located HsModule)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located HsModule -> SrcSpanLess (Located HsModule))
-> Located HsModule -> SrcSpanLess (Located HsModule)
forall a b. (a -> b) -> a -> b
$ AnnotatedModule -> Located HsModule
forall ast. Annotated ast -> ast
astA (AnnotatedModule -> Located HsModule)
-> AnnotatedModule -> Located HsModule
forall a b. (a -> b) -> a -> b
$ [AnnotatedModule] -> AnnotatedModule
forall a. [a] -> a
head [AnnotatedModule]
ms)
    importLines :: [Text]
importLines = Identity [Text] -> [Text]
forall a. Identity a -> a
runIdentity (Identity [Text] -> [Text]) -> Identity [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Annotated [Text] -> [Text])
-> Identity (Annotated [Text]) -> Identity [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Annotated [Text] -> [Text]
forall ast. Annotated ast -> ast
astA (Identity (Annotated [Text]) -> Identity [Text])
-> Identity (Annotated [Text]) -> Identity [Text]
forall a b. (a -> b) -> a -> b
$ AnnotatedImports
-> ([LImportDecl GhcPs] -> TransformT Identity [Text])
-> Identity (Annotated [Text])
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA (Maybe ModuleName -> [AnnotatedImports] -> AnnotatedImports
filterAndFlatten Maybe ModuleName
mbName [AnnotatedImports]
is) (([LImportDecl GhcPs] -> TransformT Identity [Text])
 -> Identity (Annotated [Text]))
-> ([LImportDecl GhcPs] -> TransformT Identity [Text])
-> Identity (Annotated [Text])
forall a b. (a -> b) -> a -> b
$
      (LImportDecl GhcPs -> TransformT Identity Text)
-> [LImportDecl GhcPs] -> TransformT Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((LImportDecl GhcPs -> TransformT Identity Text)
 -> [LImportDecl GhcPs] -> TransformT Identity [Text])
-> (LImportDecl GhcPs -> TransformT Identity Text)
-> [LImportDecl GhcPs]
-> TransformT Identity [Text]
forall a b. (a -> b) -> a -> b
$ (Annotated (LImportDecl GhcPs) -> Text)
-> TransformT Identity (Annotated (LImportDecl GhcPs))
-> TransformT Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Text
Text.pack (FilePath -> Text)
-> (Annotated (LImportDecl GhcPs) -> FilePath)
-> Annotated (LImportDecl GhcPs)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (Annotated (LImportDecl GhcPs) -> FilePath)
-> Annotated (LImportDecl GhcPs)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated (LImportDecl GhcPs) -> FilePath
forall ast. Annotate ast => Annotated (Located ast) -> FilePath
printA) (TransformT Identity (Annotated (LImportDecl GhcPs))
 -> TransformT Identity Text)
-> (LImportDecl GhcPs
    -> TransformT Identity (Annotated (LImportDecl GhcPs)))
-> LImportDecl GhcPs
-> TransformT Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs
-> TransformT Identity (Annotated (LImportDecl GhcPs))
forall ast (m :: * -> *).
(Data ast, Monad m) =>
ast -> TransformT m (Annotated ast)
pruneA

    p :: Text -> Bool
p Text
t = Text -> Bool
isImport Text
t Bool -> Bool -> Bool
|| Text -> Bool
isModule Text
t Bool -> Bool -> Bool
|| Text -> Bool
isPragma Text
t
    ([Text]
revDecls, [Text]
revHeader) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
p ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
origLines)
    newHeader :: [Text]
newHeader = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
revHeader [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
importLines

splice :: Text -> Int -> Int -> [(RealSrcSpan, String)] -> [Text] -> [Text]
splice :: Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice Text
_ Int
_ Int
_ [(RealSrcSpan, FilePath)]
_ [] = []
splice Text
prefix Int
_ Int
_ [] (Text
t:[Text]
ts) = Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts
splice Text
prefix Int
l Int
c rs :: [(RealSrcSpan, FilePath)]
rs@((RealSrcSpan
r, FilePath
repl):[(RealSrcSpan, FilePath)]
rs') ts :: [Text]
ts@(Text
t:[Text]
ts')
  | RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l =
      -- Next rewrite is not on this line. Output line.
      Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice Text
"" (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
1 [(RealSrcSpan, FilePath)]
rs [Text]
ts'
  | RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
|| RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c =
      -- Next rewrite starts before current position. This happens when
      -- the same rewrite is made in multiple versions of the CPP'd module.
      -- Drop the duplicate rewrite and keep going.
      Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice Text
prefix Int
l Int
c [(RealSrcSpan, FilePath)]
rs' [Text]
ts
  | ([Text]
old, Text
ln:[Text]
lns) <- Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) [Text]
ts =
      -- The next rewrite starts on this line.
      let
        start :: Int
start = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
r
        end :: Int
end = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
r

        prefix' :: Text
prefix' = Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.take (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
repl
        ln' :: Text
ln' = Int -> Text -> Text
Text.drop (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Text
ln

        -- For an example of how this can happen, see the CPPConflict test.
        errMsg :: FilePath
errMsg = [FilePath] -> FilePath
unlines
          [ FilePath
"Refusing to rewrite across CPP directives."
          , FilePath
""
          , FilePath
"Location: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
locStr
          , FilePath
""
          , FilePath
"Original:"
          , FilePath
""
          , Text -> FilePath
Text.unpack Text
orig
          , FilePath
""
          , FilePath
"Replacement:"
          , FilePath
""
          , FilePath
repl
          ]
        orig :: Text
orig =
          [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 [Text]
old) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Int -> Text -> Text
Text.take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Text
ln]
        locStr :: FilePath
locStr = FastString -> FilePath
unpackFS (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
r) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
start
      in
        if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
isCPP [Text]
old
        then FilePath -> [Text] -> [Text]
forall a. FilePath -> a -> a
trace FilePath
errMsg ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice Text
prefix Int
l Int
c [(RealSrcSpan, FilePath)]
rs' [Text]
ts
        else Text -> Int -> Int -> [(RealSrcSpan, FilePath)] -> [Text] -> [Text]
splice Text
prefix' (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
r) Int
end [(RealSrcSpan, FilePath)]
rs' (Text
ln'Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
lns)
  | Bool
otherwise = FilePath -> [Text]
forall a. HasCallStack => FilePath -> a
error FilePath
"printCPP: impossible replacement past end of file"

-- Forking the module ----------------------------------------------------------

cppFork :: Text -> [Text]
cppFork :: Text -> [Text]
cppFork = CPPTree -> [Text]
cppTreeToList (CPPTree -> [Text]) -> (Text -> CPPTree) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CPPTree
mkCPPTree

-- | Tree representing the module. Each #endif becomes a Node.
data CPPTree
  = Node [Text] CPPTree CPPTree
  | Leaf [Text]

-- | Stack type used to keep track of how many #ifs we are nested into.
-- Controls whether we emit lines into each version of the module.
data CPPBranch
  = CPPTrue -- print until an 'else'
  | CPPFalse -- print blanks until an 'else' or 'endif'
  | CPPOmit -- print blanks until an 'endif'

-- | Build CPPTree from lines of the module.
mkCPPTree :: Text -> CPPTree
mkCPPTree :: Text -> CPPTree
mkCPPTree = Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
False [] [] ([Text] -> CPPTree) -> (Text -> [Text]) -> Text -> CPPTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
  -- We reverse the lines once up front, then process the module from bottom
  -- to top, branching at #endifs. If we were to process from top to bottom,
  -- we'd have to reverse each version later, rather than reversing the original
  -- once. This also makes it easy to spot import statements and stop branching
  -- since we don't care about differences in imports.
  where
    go :: Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
    go :: Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
_ [CPPBranch]
_ [Text]
suffix [] = [Text] -> CPPTree
Leaf [Text]
suffix
    go Bool
True [] [Text]
suffix [Text]
ls =
      [Text] -> CPPTree
Leaf ([Text] -> [Text] -> [Text]
blankifyAndReverse [Text]
suffix [Text]
ls) -- See Note [Imports]
    go Bool
seenImport [CPPBranch]
st [Text]
suffix (Text
l:[Text]
ls) =
      case Text -> Maybe CPPCond
extractCPPCond Text
l of
        Just CPPCond
If -> -- pops from stack
          case [CPPBranch]
st of
            (CPPBranch
_:[CPPBranch]
st') -> [CPPBranch] -> CPPTree
emptyLine [CPPBranch]
st'
            [] -> FilePath -> CPPTree
forall a. HasCallStack => FilePath -> a
error FilePath
"mkCPPTree: if with empty stack"
        Just CPPCond
ElIf -> -- stack same size
          case [CPPBranch]
st of
            (CPPBranch
CPPOmit:[CPPBranch]
_) -> [CPPBranch] -> CPPTree
emptyLine [CPPBranch]
st
            (CPPBranch
CPPFalse:[CPPBranch]
st') -> [CPPBranch] -> CPPTree
emptyLine (CPPBranch
CPPOmitCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st')
            (CPPBranch
CPPTrue:[CPPBranch]
st') -> -- See Note [ElIf]
              let
                omittedSuffix :: [Text]
omittedSuffix = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
suffix) Text
""
              in
                [Text] -> CPPTree -> CPPTree -> CPPTree
Node
                  []
                  ([CPPBranch] -> CPPTree
emptyLine (CPPBranch
CPPOmitCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st'))
                  (Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport (CPPBranch
CPPTrueCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st') (Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
omittedSuffix) [Text]
ls)
            [] -> FilePath -> CPPTree
forall a. HasCallStack => FilePath -> a
error FilePath
"mkCPPTree: else with empty stack"
        Just CPPCond
Else -> -- stack same size
          case [CPPBranch]
st of
            (CPPBranch
CPPOmit:[CPPBranch]
_) -> [CPPBranch] -> CPPTree
emptyLine [CPPBranch]
st
            (CPPBranch
CPPTrue:[CPPBranch]
st') -> [CPPBranch] -> CPPTree
emptyLine (CPPBranch
CPPFalseCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st')
            (CPPBranch
CPPFalse:[CPPBranch]
st') -> [CPPBranch] -> CPPTree
emptyLine (CPPBranch
CPPTrueCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st')
            [] -> FilePath -> CPPTree
forall a. HasCallStack => FilePath -> a
error FilePath
"mkCPPTree: else with empty stack"
        Just CPPCond
EndIf -> -- push to stack
          case [CPPBranch]
st of
            (CPPBranch
CPPOmit:[CPPBranch]
_) -> [CPPBranch] -> CPPTree
emptyLine (CPPBranch
CPPOmitCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st)
            (CPPBranch
CPPFalse:[CPPBranch]
_) -> [CPPBranch] -> CPPTree
emptyLine (CPPBranch
CPPOmitCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st)
            [CPPBranch]
_ ->
              [Text] -> CPPTree -> CPPTree -> CPPTree
Node
                [Text]
suffix
                (Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport (CPPBranch
CPPTrueCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st) [Text
""] [Text]
ls)
                (Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport (CPPBranch
CPPFalseCPPBranch -> [CPPBranch] -> [CPPBranch]
forall a. a -> [a] -> [a]
:[CPPBranch]
st) [Text
""] [Text]
ls)
        Maybe CPPCond
Nothing -> -- stack same size
          case [CPPBranch]
st of
            (CPPBranch
CPPOmit:[CPPBranch]
_) -> Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport' [CPPBranch]
st (Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
suffix) [Text]
ls
            (CPPBranch
CPPFalse:[CPPBranch]
_) -> Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport' [CPPBranch]
st (Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
suffix) [Text]
ls
            [CPPBranch]
_ -> Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport' [CPPBranch]
st (Text -> Text
blankCPP Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
suffix) [Text]
ls
      where
        emptyLine :: [CPPBranch] -> CPPTree
emptyLine [CPPBranch]
st' = Bool -> [CPPBranch] -> [Text] -> [Text] -> CPPTree
go Bool
seenImport [CPPBranch]
st' (Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
suffix) [Text]
ls
        seenImport' :: Bool
seenImport' = Bool
seenImport Bool -> Bool -> Bool
|| Text -> Bool
isImport Text
l

    blankifyAndReverse :: [Text] -> [Text] -> [Text]
    blankifyAndReverse :: [Text] -> [Text] -> [Text]
blankifyAndReverse [Text]
suffix [] = [Text]
suffix
    blankifyAndReverse [Text]
suffix (Text
l:[Text]
ls) = [Text] -> [Text] -> [Text]
blankifyAndReverse (Text -> Text
blankCPP Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
suffix) [Text]
ls

-- Note [Imports]
-- If we have seen an import statement, and have an empty stack, that means all
-- conditionals above this point only control imports/exports, etc. Retrie
-- doesn't match in those places anyway, and the imports don't matter because
-- we only parse, no renaming. As a micro-optimization, we can stop branching.
-- This saves forking the module in the common case that CPP is used to choose
-- imports. We have to wait for stack to be empty because we might have seen an
-- import in one branch, but there is a decl in the other branch.

-- Note [ElIf]
-- The way we handle #elif is pretty subtle. Some observations:
-- If we're on the CPPOmit branch, keep omitting up to the next #if, like usual.
-- If we're on the CPPFalse branch, we didn't show the #elif, but either we
-- showed the #else, or this whole #if might not output anything. So either way,
-- we need to omit up to the next #if.
-- If we're on the CPPTrue branch, we definitely showed the #elif, so we need to
-- fork with a Node. One side of the branch omits up to the next #if. The other
-- side is as if we have omitted everything from the last #endif, and we
-- continue showing up from here. This will show whatever is above the #elif.
-- It is crucial we do this branching on the CPPTrue branch, so any #elif
-- above this point is also handled correctly.

-- | Expand CPPTree into 2^h-1 versions of the module.
cppTreeToList :: CPPTree -> [Text]
cppTreeToList :: CPPTree -> [Text]
cppTreeToList CPPTree
t = [Text] -> CPPTree -> [Text] -> [Text]
go [] CPPTree
t []
  where
    go :: [Text] -> CPPTree -> [Text] -> [Text]
go [Text]
rest (Leaf [Text]
suffix) = ([Text] -> Text
Text.unlines ([Text]
suffix [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
rest) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
    go [Text]
rest (Node [Text]
suffix CPPTree
l CPPTree
r) =
      let rest' :: [Text]
rest' = [Text]
suffix [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
rest -- right-nested
      in [Text] -> CPPTree -> [Text] -> [Text]
go [Text]
rest' CPPTree
l ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> CPPTree -> [Text] -> [Text]
go [Text]
rest' CPPTree
r

-- Spotting CPP directives -----------------------------------------------------

data CPPCond = If | ElIf | Else | EndIf

extractCPPCond :: Text -> Maybe CPPCond
extractCPPCond :: Text -> Maybe CPPCond
extractCPPCond Text
t
  | Just (Char
'#',Text
t') <- Text -> Maybe (Char, Text)
Text.uncons Text
t =
    case Text -> [Text]
Text.words Text
t' of
      (Text
"if":[Text]
_) -> CPPCond -> Maybe CPPCond
forall a. a -> Maybe a
Just CPPCond
If
      (Text
"else":[Text]
_) -> CPPCond -> Maybe CPPCond
forall a. a -> Maybe a
Just CPPCond
Else
      (Text
"elif":[Text]
_) -> CPPCond -> Maybe CPPCond
forall a. a -> Maybe a
Just CPPCond
ElIf
      (Text
"endif":[Text]
_) -> CPPCond -> Maybe CPPCond
forall a. a -> Maybe a
Just CPPCond
EndIf
      [Text]
_ -> Maybe CPPCond
forall a. Maybe a
Nothing
  | Bool
otherwise = Maybe CPPCond
forall a. Maybe a
Nothing

blankCPP :: Text -> Text
blankCPP :: Text -> Text
blankCPP Text
t
  | Text -> Bool
isCPP Text
t = Text
""
  | Bool
otherwise = Text
t

isCPP :: Text -> Bool
isCPP :: Text -> Bool
isCPP = Text -> Text -> Bool
Text.isPrefixOf Text
"#"

isImport :: Text -> Bool
isImport :: Text -> Bool
isImport = Text -> Text -> Bool
Text.isPrefixOf Text
"import"

isModule :: Text -> Bool
isModule :: Text -> Bool
isModule = Text -> Text -> Bool
Text.isPrefixOf Text
"module"

isPragma :: Text -> Bool
isPragma :: Text -> Bool
isPragma = Text -> Text -> Bool
Text.isPrefixOf Text
"{-#"

-------------------------------------------------------------------------------
-- This would make more sense in Retrie.Expr, but that creates an import cycle.
-- Ironic, I know.

insertImports
  :: Monad m
  => [AnnotatedImports]   -- ^ imports and their annotations
  -> Located HsModule     -- ^ target module
  -> TransformT m (Located HsModule)
insertImports :: [AnnotatedImports]
-> Located HsModule -> TransformT m (Located HsModule)
insertImports [AnnotatedImports]
is (L SrcSpan
l HsModule
m) = do
  [LImportDecl GhcPs]
imps <- AnnotatedImports -> TransformT m [LImportDecl GhcPs]
forall ast (m :: * -> *).
(Data ast, Monad m) =>
Annotated ast -> TransformT m ast
graftA (AnnotatedImports -> TransformT m [LImportDecl GhcPs])
-> AnnotatedImports -> TransformT m [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> [AnnotatedImports] -> AnnotatedImports
filterAndFlatten (Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule -> Maybe (Located ModuleName)
forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName HsModule
m) [AnnotatedImports]
is
  let
    deduped :: [LImportDecl GhcPs]
deduped = (LImportDecl GhcPs -> LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
eqImportDecl (ImportDecl GhcPs -> ImportDecl GhcPs -> Bool)
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> LImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule
m [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. [a] -> [a] -> [a]
++ [LImportDecl GhcPs]
imps
  Located HsModule -> TransformT m (Located HsModule)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located HsModule -> TransformT m (Located HsModule))
-> Located HsModule -> TransformT m (Located HsModule)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsModule -> Located HsModule
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsModule
m { hsmodImports :: [LImportDecl GhcPs]
hsmodImports = [LImportDecl GhcPs]
deduped }

filterAndFlatten :: Maybe ModuleName -> [AnnotatedImports] -> AnnotatedImports
filterAndFlatten :: Maybe ModuleName -> [AnnotatedImports] -> AnnotatedImports
filterAndFlatten Maybe ModuleName
mbName [AnnotatedImports]
is =
  Identity AnnotatedImports -> AnnotatedImports
forall a. Identity a -> a
runIdentity (Identity AnnotatedImports -> AnnotatedImports)
-> Identity AnnotatedImports -> AnnotatedImports
forall a b. (a -> b) -> a -> b
$ AnnotatedImports
-> ([LImportDecl GhcPs] -> TransformT Identity [LImportDecl GhcPs])
-> Identity AnnotatedImports
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA ([AnnotatedImports] -> AnnotatedImports
forall a. Monoid a => [a] -> a
mconcat [AnnotatedImports]
is) (([LImportDecl GhcPs] -> TransformT Identity [LImportDecl GhcPs])
 -> Identity AnnotatedImports)
-> ([LImportDecl GhcPs] -> TransformT Identity [LImportDecl GhcPs])
-> Identity AnnotatedImports
forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs] -> TransformT Identity [LImportDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return ([LImportDecl GhcPs] -> TransformT Identity [LImportDecl GhcPs])
-> ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [LImportDecl GhcPs]
-> TransformT Identity [LImportDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ModuleName -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
externalImps Maybe ModuleName
mbName
  where
    externalImps :: Maybe ModuleName -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    externalImps :: Maybe ModuleName -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
externalImps (Just ModuleName
mn) = (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
mn) (ModuleName -> Bool)
-> (LImportDecl GhcPs -> ModuleName) -> LImportDecl GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> (LImportDecl GhcPs -> Located ModuleName)
-> LImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName (ImportDecl GhcPs -> Located ModuleName)
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
    externalImps Maybe ModuleName
_ = [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. a -> a
id

eqImportDecl :: ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
eqImportDecl :: ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
eqImportDecl ImportDecl GhcPs
x ImportDecl GhcPs
y =
  (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModuleName -> ModuleName -> Bool)
-> (ImportDecl GhcPs -> ModuleName)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> (ImportDecl GhcPs -> Located ModuleName)
-> ImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName) ImportDecl GhcPs
x ImportDecl GhcPs
y
  Bool -> Bool -> Bool
&& (ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified) ImportDecl GhcPs
x ImportDecl GhcPs
y
  Bool -> Bool -> Bool
&& (Maybe (Located ModuleName) -> Maybe (Located ModuleName) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe (Located ModuleName) -> Maybe (Located ModuleName) -> Bool)
-> (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs) ImportDecl GhcPs
x ImportDecl GhcPs
y
  Bool -> Bool -> Bool
&& (Maybe (Bool, Located [LIE GhcPs])
-> Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe (Bool, Located [LIE GhcPs])
 -> Maybe (Bool, Located [LIE GhcPs]) -> Bool)
-> (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs]))
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding) ImportDecl GhcPs
x ImportDecl GhcPs
y
  Bool -> Bool -> Bool
&& (Maybe StringLiteral -> Maybe StringLiteral -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe StringLiteral -> Maybe StringLiteral -> Bool)
-> (ImportDecl GhcPs -> Maybe StringLiteral)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual) ImportDecl GhcPs
x ImportDecl GhcPs
y
  Bool -> Bool -> Bool
&& (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool)
-> (ImportDecl GhcPs -> Bool)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclSource) ImportDecl GhcPs
x ImportDecl GhcPs
y
  Bool -> Bool -> Bool
&& (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool)
-> (ImportDecl GhcPs -> Bool)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclSafe) ImportDecl GhcPs
x ImportDecl GhcPs
y
  -- intentionally leave out ideclImplicit and ideclSourceSrc
  -- former doesn't matter for this check, latter is prone to whitespace issues