{-# LANGUAGE TupleSections #-}

module Refact.Apply
  ( applyRefactorings
  , applyRefactorings'
  , runRefactoring
  , parseExtensions
  ) where

import Control.Monad (unless)
import Data.List (intercalate)
import Language.Haskell.GHC.ExactPrint.Types (Anns)
import Refact.Fixity (applyFixities)
import Refact.Internal
import Refact.Types (Refactoring, SrcSpan)
import Refact.Utils (Module)

-- | Apply a set of refactorings as supplied by HLint
applyRefactorings
  :: Maybe (Int, Int)
  -- ^ Apply hints relevant to a specific position
  -> [[Refactoring SrcSpan]]
  -- ^ 'Refactoring's to apply. Each inner list corresponds to an HLint
  -- <https://hackage.haskell.org/package/hlint/docs/Language-Haskell-HLint.html#t:Idea Idea>.
  -- An @Idea@ may have more than one 'Refactoring'.
  --
  -- The @Idea@s are sorted in ascending order of starting location, and are applied
  -- in that order. If two @Idea@s start at the same location, the one with the larger
  -- source span comes first. An @Idea@ is filtered out (ignored) if there is an @Idea@
  -- prior to it which has an overlapping source span and is not filtered out.
  -> FilePath
  -- ^ Target file
  -> [String]
  -- ^ GHC extensions, e.g., @LambdaCase@, @NoStarIsType@. The list is processed from left
  -- to right. An extension (e.g., @StarIsType@) may be overridden later (e.g., by @NoStarIsType@).
  --
  -- These are in addition to the @LANGUAGE@ pragmas in the target file. When they conflict
  -- with the @LANGUAGE@ pragmas, pragmas win.
  -> IO String
applyRefactorings :: Maybe (Int, Int)
-> [[Refactoring SrcSpan]] -> FilePath -> [FilePath] -> IO FilePath
applyRefactorings Maybe (Int, Int)
optionsPos [[Refactoring SrcSpan]]
inp FilePath
file [FilePath]
exts = do
  let ([Extension]
enabled, [Extension]
disabled, [FilePath]
invalid) = [FilePath] -> ([Extension], [Extension], [FilePath])
parseExtensions [FilePath]
exts
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
invalid) (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Unsupported extensions: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
invalid
  (Anns
as, Module
m) <- (Errors -> IO (Anns, Module))
-> ((Anns, Module) -> IO (Anns, Module))
-> Either Errors (Anns, Module)
-> IO (Anns, Module)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Errors -> IO (Anns, Module)
forall a. FilePath -> Errors -> a
onError FilePath
"apply") ((Anns -> Module -> IO (Anns, Module))
-> (Anns, Module) -> IO (Anns, Module)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Anns -> Module -> IO (Anns, Module)
applyFixities)
              (Either Errors (Anns, Module) -> IO (Anns, Module))
-> IO (Either Errors (Anns, Module)) -> IO (Anns, Module)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Extension], [Extension])
-> FilePath -> IO (Either Errors (Anns, Module))
parseModuleWithArgs ([Extension]
enabled, [Extension]
disabled) FilePath
file
  Maybe (Int, Int)
-> Bool
-> [(FilePath, [Refactoring SrcSpan])]
-> Maybe FilePath
-> Verbosity
-> Anns
-> Module
-> IO FilePath
apply Maybe (Int, Int)
optionsPos Bool
False ((FilePath
forall a. Monoid a => a
mempty,) ([Refactoring SrcSpan] -> (FilePath, [Refactoring SrcSpan]))
-> [[Refactoring SrcSpan]] -> [(FilePath, [Refactoring SrcSpan])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Refactoring SrcSpan]]
inp) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file) Verbosity
Silent Anns
as Module
m

-- | Like 'applyRefactorings', but takes a parsed module rather than a file path to parse.
applyRefactorings'
  :: Maybe (Int, Int)
  -> [[Refactoring SrcSpan]]
  -> Anns
  -- ^ ghc-exactprint AST annotations. This can be obtained from
  -- 'Language.Haskell.GHC.ExactPrint.Parsers.postParseTransform'.
  -> Module
  -- ^ Parsed module
  -> IO String
applyRefactorings' :: Maybe (Int, Int)
-> [[Refactoring SrcSpan]] -> Anns -> Module -> IO FilePath
applyRefactorings' Maybe (Int, Int)
optionsPos [[Refactoring SrcSpan]]
inp = Maybe (Int, Int)
-> Bool
-> [(FilePath, [Refactoring SrcSpan])]
-> Maybe FilePath
-> Verbosity
-> Anns
-> Module
-> IO FilePath
apply Maybe (Int, Int)
optionsPos Bool
False ((FilePath
forall a. Monoid a => a
mempty,) ([Refactoring SrcSpan] -> (FilePath, [Refactoring SrcSpan]))
-> [[Refactoring SrcSpan]] -> [(FilePath, [Refactoring SrcSpan])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Refactoring SrcSpan]]
inp) Maybe FilePath
forall a. Maybe a
Nothing Verbosity
Silent