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