module Language.Haskell.Format.Utilities ( defaultFormatter , hunitTest , showDiff , wasReformatted ) where import System.IO.Unsafe import Language.Haskell.Format import Language.Haskell.Source.Enumerator import Conduit import Control.Monad import Data.Algorithm.DiffContext import Data.List import Data.Maybe import Test.HUnit import Text.PrettyPrint type ErrorString = String data CheckResult = InvalidCheckResult HaskellSource ErrorString | CheckResult HaskellSource Reformatted checkResultPath :: CheckResult -> FilePath checkResultPath :: CheckResult -> FilePath checkResultPath (InvalidCheckResult (HaskellSource FilePath filepath FilePath _) FilePath _) = FilePath filepath checkResultPath (CheckResult (HaskellSource FilePath filepath FilePath _) Reformatted _) = FilePath filepath hunitTest :: FilePath -> Test hunitTest :: FilePath -> Test hunitTest FilePath filepath = FilePath -> Test -> Test TestLabel FilePath filepath (Test -> Test) -> (FilePath -> Test) -> FilePath -> Test forall b c a. (b -> c) -> (a -> b) -> a -> c . IO Test -> Test forall a. IO a -> a unsafePerformIO (IO Test -> Test) -> (FilePath -> IO Test) -> FilePath -> Test forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> IO Test testPath (FilePath -> Test) -> FilePath -> Test forall a b. (a -> b) -> a -> b $ FilePath filepath testPath :: FilePath -> IO Test testPath :: FilePath -> IO Test testPath FilePath filepath = do Formatter formatter <- IO Formatter defaultFormatter [Test] -> Test TestList ([Test] -> Test) -> IO [Test] -> IO Test forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ConduitT () Void IO [Test] -> IO [Test] forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (Formatter -> FilePath -> ConduitT () CheckResult IO () check Formatter formatter FilePath filepath ConduitT () CheckResult IO () -> ConduitM CheckResult Void IO [Test] -> ConduitT () Void IO [Test] forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| (CheckResult -> Test) -> ConduitT CheckResult Test IO () forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m () mapC CheckResult -> Test makeTestCase ConduitT CheckResult Test IO () -> ConduitM Test Void IO [Test] -> ConduitM CheckResult Void IO [Test] forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitM Test Void IO [Test] forall (m :: * -> *) a o. Monad m => ConduitT a o m [a] sinkList) makeTestCase :: CheckResult -> Test makeTestCase :: CheckResult -> Test makeTestCase CheckResult result = FilePath -> Test -> Test TestLabel (CheckResult -> FilePath checkResultPath CheckResult result) (Test -> Test) -> (Assertion -> Test) -> Assertion -> Test forall b c a. (b -> c) -> (a -> b) -> a -> c . Assertion -> Test TestCase (Assertion -> Test) -> Assertion -> Test forall a b. (a -> b) -> a -> b $ CheckResult -> Assertion assertCheckResult CheckResult result assertCheckResult :: CheckResult -> IO () assertCheckResult :: CheckResult -> Assertion assertCheckResult CheckResult result = case CheckResult result of (InvalidCheckResult HaskellSource _ FilePath errorString) -> FilePath -> Assertion forall a. HasCallStack => FilePath -> IO a assertFailure (FilePath "Error: " FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath errorString) (CheckResult HaskellSource source Reformatted reformatted) -> Bool -> Assertion -> Assertion forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (HaskellSource -> Reformatted -> Bool wasReformatted HaskellSource source Reformatted reformatted) (Assertion -> Assertion) -> Assertion -> Assertion forall a b. (a -> b) -> a -> b $ FilePath -> Assertion forall a. HasCallStack => FilePath -> IO a assertFailure (HaskellSource -> Reformatted -> FilePath showReformatted HaskellSource source Reformatted reformatted) where showReformatted :: HaskellSource -> Reformatted -> String showReformatted :: HaskellSource -> Reformatted -> FilePath showReformatted HaskellSource source Reformatted reformatted = FilePath -> [FilePath] -> FilePath forall a. [a] -> [[a]] -> [a] intercalate FilePath "\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath forall a b. (a -> b) -> a -> b $ [Maybe FilePath] -> [FilePath] forall a. [Maybe a] -> [a] catMaybes [ HaskellSource -> Reformatted -> Maybe FilePath showSourceChanges HaskellSource source Reformatted reformatted , HaskellSource -> Reformatted -> Maybe FilePath forall p. p -> Reformatted -> Maybe FilePath showSuggestions HaskellSource source Reformatted reformatted ] showSourceChanges :: HaskellSource -> Reformatted -> Maybe FilePath showSourceChanges HaskellSource source Reformatted reformatted = Bool -> FilePath -> Maybe FilePath forall a. Bool -> a -> Maybe a whenMaybe (HaskellSource -> Reformatted -> Bool sourceChanged HaskellSource source Reformatted reformatted) (HaskellSource -> HaskellSource -> FilePath showDiff HaskellSource source (Reformatted -> HaskellSource reformattedSource Reformatted reformatted)) showSuggestions :: p -> Reformatted -> Maybe FilePath showSuggestions p _ Reformatted reformatted = Bool -> FilePath -> Maybe FilePath forall a. Bool -> a -> Maybe a whenMaybe (Reformatted -> Bool hasSuggestions Reformatted reformatted) ((Suggestion -> FilePath) -> [Suggestion] -> FilePath forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Suggestion -> FilePath forall a. Show a => a -> FilePath show (Reformatted -> [Suggestion] suggestions Reformatted reformatted)) whenMaybe :: Bool -> a -> Maybe a whenMaybe :: Bool -> a -> Maybe a whenMaybe Bool cond a val = a val a -> Maybe () -> Maybe a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard Bool cond showDiff :: HaskellSource -> HaskellSource -> String showDiff :: HaskellSource -> HaskellSource -> FilePath showDiff (HaskellSource FilePath _ FilePath a) (HaskellSource FilePath _ FilePath b) = Doc -> FilePath render (ContextDiff FilePath -> Doc toDoc ContextDiff FilePath diff) where toDoc :: ContextDiff FilePath -> Doc toDoc = Doc -> Doc -> (FilePath -> Doc) -> ContextDiff FilePath -> Doc forall c. Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc prettyContextDiff (FilePath -> Doc text FilePath "Original") (FilePath -> Doc text FilePath "Reformatted") FilePath -> Doc text diff :: ContextDiff FilePath diff = Int -> [FilePath] -> [FilePath] -> ContextDiff FilePath forall a. Eq a => Int -> [a] -> [a] -> ContextDiff a getContextDiff Int linesOfContext (FilePath -> [FilePath] lines FilePath a) (FilePath -> [FilePath] lines FilePath b) linesOfContext :: Int linesOfContext = Int 1 check :: Formatter -> FilePath -> ConduitT () CheckResult IO () check :: Formatter -> FilePath -> ConduitT () CheckResult IO () check Formatter formatter FilePath filepath = FilePath -> ConduitT () FilePath IO () enumeratePath FilePath filepath ConduitT () FilePath IO () -> ConduitM FilePath CheckResult IO () -> ConduitT () CheckResult IO () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| (FilePath -> IO HaskellSource) -> ConduitT FilePath HaskellSource IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> ConduitT a b m () mapMC FilePath -> IO HaskellSource readSourceFile ConduitT FilePath HaskellSource IO () -> ConduitM HaskellSource CheckResult IO () -> ConduitM FilePath CheckResult IO () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| (HaskellSource -> CheckResult) -> ConduitM HaskellSource CheckResult IO () forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m () mapC (Formatter -> HaskellSource -> CheckResult checkFormatting Formatter formatter) readSourceFile :: FilePath -> IO HaskellSource readSourceFile :: FilePath -> IO HaskellSource readSourceFile FilePath filepath = FilePath -> FilePath -> HaskellSource HaskellSource FilePath filepath (FilePath -> HaskellSource) -> IO FilePath -> IO HaskellSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO FilePath readFile FilePath filepath checkFormatting :: Formatter -> HaskellSource -> CheckResult checkFormatting :: Formatter -> HaskellSource -> CheckResult checkFormatting (Formatter HaskellSource -> Either FilePath Reformatted doFormat) HaskellSource source = case HaskellSource -> Either FilePath Reformatted doFormat HaskellSource source of Left FilePath err -> HaskellSource -> FilePath -> CheckResult InvalidCheckResult HaskellSource source FilePath err Right Reformatted reformatted -> HaskellSource -> Reformatted -> CheckResult CheckResult HaskellSource source Reformatted reformatted defaultFormatter :: IO Formatter defaultFormatter :: IO Formatter defaultFormatter = [Formatter] -> Formatter forall a. Monoid a => [a] -> a mconcat ([Formatter] -> Formatter) -> IO [Formatter] -> IO Formatter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (IO Settings autoSettings IO Settings -> (Settings -> IO [Formatter]) -> IO [Formatter] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Settings -> IO [Formatter] formatters) wasReformatted :: HaskellSource -> Reformatted -> Bool wasReformatted :: HaskellSource -> Reformatted -> Bool wasReformatted HaskellSource source Reformatted reformatted = Reformatted -> Bool hasSuggestions Reformatted reformatted Bool -> Bool -> Bool || HaskellSource -> Reformatted -> Bool sourceChanged HaskellSource source Reformatted reformatted sourceChanged :: HaskellSource -> Reformatted -> Bool sourceChanged :: HaskellSource -> Reformatted -> Bool sourceChanged HaskellSource source Reformatted reformatted = HaskellSource source HaskellSource -> HaskellSource -> Bool forall a. Eq a => a -> a -> Bool /= Reformatted -> HaskellSource reformattedSource Reformatted reformatted hasSuggestions :: Reformatted -> Bool hasSuggestions :: Reformatted -> Bool hasSuggestions Reformatted reformatted = Bool -> Bool not ([Suggestion] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (Reformatted -> [Suggestion] suggestions Reformatted reformatted))