File: test-pandoc-citeproc.hs

package info (click to toggle)
haskell-pandoc-citeproc 0.14.3.1-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,588 kB
  • sloc: xml: 14,814; haskell: 7,752; makefile: 13
file content (158 lines) | stat: -rw-r--r-- 5,859 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Prelude
import qualified Data.Aeson             as Aeson
import           Data.List              (isSuffixOf)
import           Data.Maybe             (fromMaybe)
import           System.Directory
import           System.Environment
import           System.Exit
import           System.FilePath
import           System.IO
import           System.IO.Temp         (withSystemTempDirectory)
import           System.Process         (rawSystem)
import           Text.CSL.Compat.Pandoc (pipeProcess, writeNative)
import           Text.Pandoc.Definition
import qualified Text.Pandoc.UTF8       as UTF8
#if MIN_VERSION_pandoc(2,0,0)
import qualified Control.Exception      as E
#endif

main :: IO ()
main = do
  args <- getArgs
  let regenerate = "--accept" `elem` args
  testnames <- (map (dropExtension . takeBaseName) .
                     filter (".in.native" `isSuffixOf`)) <$>
               getDirectoryContents "tests"
  citeprocTests <- mapM (testCase regenerate) testnames
  fs <- filter (\f -> takeExtension f `elem` [".bibtex",".biblatex"])
           `fmap` getDirectoryContents "tests/biblio2yaml"
  biblio2yamlTests <- mapM (biblio2yamlTest regenerate) fs
  let allTests = citeprocTests ++ biblio2yamlTests
  let numpasses  = length $ filter (== Passed) allTests
  let numskipped = length $ filter (== Skipped) allTests
  let numfailures = length $ filter (== Failed) allTests
  let numerrors = length $ filter (== Errored) allTests
  putStrLn $ show numpasses ++ " passed; " ++ show numfailures ++
              " failed; " ++ show numskipped ++ " skipped; " ++
              show numerrors ++ " errored."
  exitWith $ if numfailures == 0 && numerrors == 0
                then ExitSuccess
                else ExitFailure $ numfailures + numerrors

err :: String -> IO ()
err = hPutStrLn stderr

data TestResult =
    Passed
  | Skipped
  | Failed
  | Errored
  deriving (Show, Eq)

testCase :: Bool -> String -> IO TestResult
testCase regenerate csl = do
  hPutStr stderr $ "[" ++ csl ++ ".in.native] "
  indataNative <- UTF8.readFile $ "tests/" ++ csl ++ ".in.native"
  expectedNative <- UTF8.readFile $ "tests/" ++ csl ++ ".expected.native"
  let jsonIn = Aeson.encode (read indataNative :: Pandoc)
  let expectedDoc = read expectedNative
  testProgPath <- getExecutablePath
  let pandocCiteprocPath = takeDirectory testProgPath </> ".." </>
        "pandoc-citeproc" </> "pandoc-citeproc"
  (ec, jsonOut) <- pipeProcess
                     (Just [("LANG","en_US.UTF-8"),("HOME",".")])
                     pandocCiteprocPath
                     [] jsonIn
  if ec == ExitSuccess
     then do
       let outDoc = fromMaybe mempty $Aeson.decode jsonOut
       if outDoc == expectedDoc
          then err "PASSED" >> return Passed
          else
            if regenerate
               then do
                 UTF8.writeFile ("tests/" ++ csl ++ ".expected.native") $
#if MIN_VERSION_pandoc(1,19,0)
                   writeNative outDoc
#else
                   writeNative outDoc
#endif
                 err "PASSED (accepted)"
                 return Passed
               else do
                 err "FAILED"
                 showDiff (writeNative expectedDoc) (writeNative outDoc)
                 return Failed
     else do
       err "ERROR"
       err $ "Error status " ++ show ec
       return Errored

showDiff :: String -> String -> IO ()
showDiff expected result =
  withSystemTempDirectory "test-pandoc-citeproc-XXX" $ \fp -> do
    let expectedf = fp </> "expected"
    let actualf   = fp </> "actual"
    UTF8.writeFile expectedf expected
    UTF8.writeFile actualf result
    oldDir <- getCurrentDirectory
    setCurrentDirectory fp
    _ <- rawSystem "diff" ["-U1","expected","actual"]
    setCurrentDirectory oldDir

biblio2yamlTest :: Bool -> String -> IO TestResult
biblio2yamlTest regenerate fp = do
  hPutStr stderr $ "[biblio2yaml/" ++ fp ++ "] "
  let yamld = "tests/biblio2yaml/"
#if MIN_VERSION_pandoc(2,0,0)
  -- in a few cases we need different test output for pandoc >= 2
  -- because smallcaps render differently, for example.
  raw <- E.catch (UTF8.readFile (yamld ++ "/pandoc-2/" ++ fp))
         (\(_ :: E.SomeException) ->
           (UTF8.readFile (yamld ++ fp)))
#else
  raw <- UTF8.readFile (yamld ++ fp)
#endif
  let yamlStart = "---"
  let (biblines, yamllines) = break (== yamlStart) $ lines raw
  let bib = unlines biblines
  let expected = unlines yamllines
  testProgPath <- getExecutablePath
  let pandocCiteprocPath = takeDirectory testProgPath </> ".." </>
        "pandoc-citeproc" </> "pandoc-citeproc"
  (ec, result') <- pipeProcess
                     (Just [("LANG","en_US.UTF-8"),("HOME",".")])
                     pandocCiteprocPath
                     ["--bib2yaml", "-f", drop 1 $ takeExtension fp]
                     (UTF8.fromStringLazy bib)
  let result = UTF8.toStringLazy result'
  if ec == ExitSuccess
     then do
       if expected == result
          then err "PASSED" >> return Passed
          else
            if regenerate
               then do
                 let accepted = bib ++ result
#if MIN_VERSION_pandoc(2,0,0)
                 p2version <- doesFileExist (yamld ++ "/pandoc-2/" ++ fp)
                 UTF8.writeFile (if p2version
                                    then (yamld ++ "/pandoc-2/" ++ fp)
                                    else (yamld ++ fp)) accepted
#else
                 UTF8.writeFile (yamld ++ fp) accepted
#endif
                 err "PASSED (accepted)"
                 return Passed
               else do
                 err $ "FAILED"
                 showDiff expected result
                 return Failed
     else do
       err "ERROR"
       err $ "Error status " ++ show ec
       return Errored