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 (InvalidCheckResult (HaskellSource filepath _) _) = filepath checkResultPath (CheckResult (HaskellSource filepath _) _) = filepath hunitTest :: FilePath -> Test hunitTest filepath = TestLabel filepath . unsafePerformIO . testPath $ filepath testPath :: FilePath -> IO Test testPath filepath = do formatter <- defaultFormatter TestList <$> runConduit (check formatter filepath .| mapC makeTestCase .| sinkList) makeTestCase :: CheckResult -> Test makeTestCase result = TestLabel (checkResultPath result) . TestCase $ assertCheckResult result assertCheckResult :: CheckResult -> IO () assertCheckResult result = case result of (InvalidCheckResult _ errorString) -> assertFailure ("Error: " ++ errorString) (CheckResult source reformatted) -> when (wasReformatted source reformatted) $ assertFailure (showReformatted source reformatted) where showReformatted :: HaskellSource -> Reformatted -> String showReformatted source reformatted = intercalate "\n" $ catMaybes [ showSourceChanges source reformatted , showSuggestions source reformatted ] showSourceChanges source reformatted = whenMaybe (sourceChanged source reformatted) (showDiff source (reformattedSource reformatted)) showSuggestions _ reformatted = whenMaybe (hasSuggestions reformatted) (concatMap show (suggestions reformatted)) whenMaybe :: Bool -> a -> Maybe a whenMaybe cond val = const val <$> guard cond showDiff :: HaskellSource -> HaskellSource -> String showDiff (HaskellSource _ a) (HaskellSource _ b) = render (toDoc diff) where toDoc = prettyContextDiff (text "Original") (text "Reformatted") text diff = getContextDiff linesOfContext (lines a) (lines b) linesOfContext = 1 check :: Formatter -> FilePath -> ConduitT () CheckResult IO () check formatter filepath = enumeratePath filepath .| mapMC readSourceFile .| mapC (checkFormatting formatter) readSourceFile :: FilePath -> IO HaskellSource readSourceFile filepath = HaskellSource filepath <$> readFile filepath checkFormatting :: Formatter -> HaskellSource -> CheckResult checkFormatting (Formatter doFormat) source = case doFormat source of Left err -> InvalidCheckResult source err Right reformatted -> CheckResult source reformatted defaultFormatter :: IO Formatter defaultFormatter = mconcat <$> (autoSettings >>= formatters) wasReformatted :: HaskellSource -> Reformatted -> Bool wasReformatted source reformatted = hasSuggestions reformatted || sourceChanged source reformatted sourceChanged :: HaskellSource -> Reformatted -> Bool sourceChanged source reformatted = source /= reformattedSource reformatted hasSuggestions :: Reformatted -> Bool hasSuggestions reformatted = not (null (suggestions reformatted))