hindent-4.2.2: test/Spec.hs

module Main (main) where

import           Control.Monad
import           Control.Applicative
import           Data.List (find, unfoldr, break, isPrefixOf, intercalate)

import           Test.Hspec
import           System.Directory
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as L

import qualified HIndent

styles :: [FilePath]
styles = ["fundamental", "gibiansky", "chris-done", "johan-tibell"]

testDir, expectedDir :: String
testDir = "tests"
expectedDir = "expected"

main :: IO ()
main = forM_ styles testStyle

testStyle :: FilePath -> IO ()
testStyle style = do
  let Just theStyle = find ((== T.pack style) . HIndent.styleName) HIndent.styles
  testFilenames <- filter (not . isPrefixOf ".") <$> getDirectoryContents tests
  let expFiles = map ((expected ++) . expectedFilename) testFilenames
      testFiles = map (tests ++) testFilenames
  specs <- forM (zip testFiles expFiles) (uncurry $ useTestFiles theStyle)
  hspec $ foldl1 (>>) specs

  where
    tests = "test/" ++ style ++ "/" ++ testDir ++ "/"
    expected = "test/" ++ style ++ "/" ++ expectedDir ++ "/"

    expectedFilename filename = take (length filename - 4) filename ++ "exp"

useTestFiles :: HIndent.Style -> FilePath -> FilePath -> IO Spec
useTestFiles style test exp = do
  testContents <- readFile test
  expContents <- readFile exp
  let testDecls = parsePieces testContents
      expDecls = parsePieces expContents
  when (length testDecls /= length expDecls) $
    error $ concat
              [ "Mismatched number of pieces in files "
              , test
              , " ("
              , show $ length testDecls
              , ")"
              , " and "
              , exp
              , " ("
              , show $ length expDecls
              , ")"
              ]
  return $ describe ("hindent applied to chunks in " ++ test) $ foldl1 (>>) $ zipWith (mkSpec style)
                                                                                testDecls expDecls

mkSpec :: HIndent.Style -> String -> String -> Spec
mkSpec style input desired = it "works" $
  case HIndent.reformat style Nothing (L.pack input) of
    Left err      -> expectationFailure ("Error: " ++ err)
    Right builder -> L.unpack (L.toLazyText builder) `shouldBe` desired

parsePieces :: String -> [String]
parsePieces str = map (intercalate "\n" . map mkNewlines) pieces
  where
    pieces = unfoldr unfolder (lines str)

    unfolder :: [String] -> Maybe ([String], [String])
    unfolder [] = Nothing
    unfolder remaining = Just $
      case break pieceBreak (zip remaining (tail remaining ++ [""])) of
        (nonNull, [])     -> (map fst nonNull, [])
        (nonNull, _:rest) -> (map fst nonNull, map fst rest)

    pieceBreak :: (String, String) -> Bool
    pieceBreak ("", "") = error "Two consecutive line breaks!"
    pieceBreak (line, next) = null line && head next /= ' '

    mkNewlines :: String -> String
    mkNewlines ">" = ""
    mkNewlines x = x