Utilities.hs

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))