content: {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE CPP                  #-}
  {-# LANGUAGE FlexibleInstances    #-}
  {-# LANGUAGE OverloadedStrings    #-}
  {-# LANGUAGE ScopedTypeVariables  #-}
  {-# LANGUAGE TypeSynonymInstances #-}
  
  import Prelude
  import qualified Control.Exception      as E
  import           Control.Monad
  import           Data.Aeson
  import           Data.Aeson.Types       (Parser)
  import qualified Data.ByteString.Lazy   as BL
  import           Data.Char              (isSpace, toLower)
  import           Data.List              (isInfixOf, sort)
  import qualified Data.Map               as M
  import           System.Directory
  import           System.Environment     (getArgs)
  import           System.Exit
  import           System.FilePath
  import           System.IO.Temp         (withSystemTempDirectory)
  import           System.Process
  import           Text.CSL
  import           Text.CSL.Compat.Pandoc (writeHtmlString)
  import           Text.CSL.Reference
  import           Text.CSL.Style         hiding (Number)
  import           Text.Pandoc            (Block (..), Format (..), Inline (..),
                                           Pandoc (..), bottomUp, nullMeta)
  import qualified Text.Pandoc.UTF8       as UTF8
  import           Text.Printf
  import qualified Data.Text              as T
  import           Data.Text              (Text)
  
  data TestCase = TestCase{
      testMode          :: Mode        -- mode
    , testBibopts       :: BibOpts     -- bibsection
    , testCitations     :: [CiteObject] -- citations
    , testCitationItems :: Citations   -- citation-items
    , testCsl           :: Style       -- csl
    , testAbbreviations :: Abbreviations -- abbreviations
    , testReferences    :: [Reference] -- input
    , testResult        :: Text        -- result
    } deriving (Show)
  
  data Mode = CitationMode
            | CitationRTFMode
            | BibliographyMode
            | BibliographyHeaderMode
            | BibliographyNoSortMode
            deriving Show
  
  instance FromJSON Mode where
    parseJSON (String "citation")            = return CitationMode
    parseJSON (String "citation-rtf")        = return CitationRTFMode
    parseJSON (String "bibliography")        = return BibliographyMode
    parseJSON (String "bibliography-header") = return BibliographyHeaderMode
    parseJSON (String "bibliography-nosort") = return BibliographyNoSortMode
    parseJSON _                              = fail "Unknown mode"
  
  instance FromJSON TestCase where
    parseJSON (Object v) = TestCase <$>
                v .:  "mode" <*>
                v .:? "bibsection" .!= Select [] [] <*>
                ((v .: "citations") >>= parseCitations) <*>
                v .:? "citation_items" .!= [] <*>
                (parseCSL <$> (v .: "csl")) <*>
                v .:? "abbreviations" .!= (Abbreviations M.empty) <*>
                v .:  "input" <*>
                v .:  "result"
          where parseCitations :: Data.Aeson.Value -> Parser [CiteObject]
                parseCitations x@Array{} = parseJSON x
                parseCitations _         = return []
    parseJSON _ = fail "Could not parse test case"
  
  newtype CiteObject =
          CiteObject { unCiteObject :: [Cite] } deriving Show
  
  instance FromJSON CiteObject where
    parseJSON (Array v) =
      case fromJSON (Array v) of
           Success [Object x, Array _, Array _] ->
                              CiteObject <$> x .: "citationItems"
           Error e         -> fail $ "Could not parse CiteObject: " ++ e
           x               -> fail $ "Could not parse CiteObject" ++ show x
    parseJSON x = fail $ "Could not parse CiteObject " ++ show x
  
  #if MIN_VERSION_aeson(0,10,0)
  #else
  instance FromJSON [CiteObject] where
    parseJSON (Array v) = mapM parseJSON $ V.toList v
    parseJSON _         = return []
  #endif
  
  data TestResult =
      Passed
    | Skipped
    | Failed
    | Errored
    deriving (Show, Eq)
  
  testDir :: FilePath
  testDir = "citeproc-test" </> "processor-tests" </> "machines"
  
  handler :: FilePath -> E.SomeException -> IO TestResult
  handler path e = do
    putStrLn $ "[ERROR] " ++ path ++ "\n" ++ show e
    return Errored
  
  runTest :: FilePath -> IO TestResult
  runTest path = E.handle (handler path) $ do
    raw <- BL.readFile path
    let testCase = either error id $ eitherDecode raw
    let procOpts' = ProcOpts (testBibopts testCase) False
    style <- localizeCSL Nothing
             $ (testCsl testCase) { styleAbbrevs = testAbbreviations testCase }
    let refs     = testReferences testCase
    let cites    = map unCiteObject (testCitations testCase) ++ testCitationItems testCase
    let cites'   = if null cites
                      then [map (\ref -> emptyCite{ citeId = unLiteral $ refId ref}) refs]
                      else cites
    let expected = adjustEntities $ fixBegins $ trimEnd $ testResult testCase
    let mode     = testMode testCase
    let assemble BibliographyMode xs =
           "<div class=\"csl-bib-body\">\n" <>
           T.unlines (map (\x -> "  <div class=\"csl-entry\">" <> x <>
                                 "</div>") xs) <> "</div>\n"
        assemble _ xs = T.unlines xs
    case mode of
         BibliographyHeaderMode  -> do
            putStrLn $ "[SKIPPED] " ++ path ++ "\n"
            return Skipped
         BibliographyNoSortMode  -> do
            putStrLn $ "[SKIPPED] " ++ path ++ "\n"
            return Skipped
         _ -> do
           let result   = assemble mode
                $ map (inlinesToString . renderPandoc style) $
                  (case mode of {CitationMode -> citations; _ -> bibliography})
                  $ citeproc procOpts' style refs cites'
           if result == expected
              then do
                putStrLn $ "[PASSED] " ++ path ++ "\n"
                return Passed
              else do
                putStrLn $ "[FAILED] " ++ path
                showDiff (T.unpack expected) (T.unpack result)
                putStrLn ""
                return Failed
  
  trimEnd :: Text -> Text
  trimEnd t = T.stripEnd t <> "\n"
  
  -- this is designed to mimic the test suite's output:
  inlinesToString  :: [Inline]  -> Text
  inlinesToString ils =
    writeHtmlString
      $ bottomUp (concatMap adjustSpans)
      $ Pandoc nullMeta [Plain ils]
  
  -- We want &amp; instead of &#38; etc.
  adjustEntities :: Text -> Text
  adjustEntities = T.replace "&#38;" "&amp;"
  
  -- citeproc-js test suite expects "citations" to be formatted like
  -- .. [0] Smith (2007)
  -- >> [1] Jones (2008)
  -- To get a meaningful comparison, we remove this.
  fixBegins :: Text -> Text
  fixBegins = T.unlines . map fixLine . T.lines
    where fixLine t =
           case T.stripPrefix "..[" t `mplus` T.stripPrefix ">>[" t of
             Just rest ->
               T.dropWhile isSpace . T.dropWhile (not . isSpace) $ rest
             Nothing -> t
  
  -- adjust the spans so we fit what the test suite expects.
  adjustSpans :: Inline -> [Inline]
  adjustSpans (Note [Para xs]) = xs
  adjustSpans (Link _ ils _) = ils
  adjustSpans (Span ("",[],[]) xs) = xs
  adjustSpans (Span ("",["nocase"],[]) xs) = xs
  adjustSpans (Span ("",["citeproc-no-output"],[]) _) =
    [Str "[CSL STYLE ERROR: reference with no printed form.]"]
  adjustSpans (Span (id',classes,kvs) ils) =
    [Span (id',classes',kvs') ils]
    where classes' = filter (`notElem` ["csl-no-emph","csl-no-strong","csl-no-smallcaps"]) classes
          kvs' = if null styles then kvs else (("style", mconcat styles) : kvs)
          styles = ["font-style:normal;" | "csl-no-emph" `elem` classes]
                ++ ["font-weight:normal;" | "csl-no-strong" `elem` classes]
                ++ ["font-variant:normal;" | "csl-no-smallcaps" `elem` classes]
  adjustSpans (Emph xs) =
    RawInline (Format "html") "<i>" : xs ++ [RawInline (Format "html") "</i>"]
  adjustSpans (Strong xs) =
    RawInline (Format "html") "<b>" : xs ++ [RawInline (Format "html") "</b>"]
  adjustSpans (SmallCaps xs) =
    RawInline (Format "html") "<span style=\"font-variant:small-caps;\">" : xs ++ [RawInline (Format "html") "</span>"]
  adjustSpans x = [x]
  
  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'
      withDirectory fp $ void $ rawSystem "diff" ["-u","expected","actual"]
  
  withDirectory :: FilePath -> IO a -> IO a
  withDirectory fp action = do
      oldDir <- getCurrentDirectory
      setCurrentDirectory fp
      result <- action
      setCurrentDirectory oldDir
      return result
  
  main :: IO ()
  main = do
    args <- getArgs
    let matchesPattern x
          | null args = True
          | otherwise = any (`isInfixOf` (map toLower x))
                          (map (map toLower . takeBaseName) args)
    exists <- doesDirectoryExist testDir
    unless exists $ do
      putStrLn "Downloading test suite"
      _ <- rawSystem "git" ["clone", "https://github.com/citation-style-language/test-suite.git", "citeproc-test"]
      withDirectory "citeproc-test" $
        void $ rawSystem "python" ["processor.py", "--grind"]
  
    testFiles <- if any ('/' `elem`) args
                 then return args
                 else (map (testDir </>) . sort .
                    filter matchesPattern .
                    filter (\f -> takeExtension f == ".json"))
                   <$> getDirectoryContents testDir
    results <- mapM runTest testFiles
    let numpasses  = length $ filter (== Passed) results
    let numskipped = length $ filter (== Skipped) results
    let numfailures = length $ filter (== Failed) results
    let numerrors = length $ filter (== Errored) results
    putStrLn $ show numpasses ++ " passed; " ++ show numfailures ++
                " failed; " ++ show numskipped ++ " skipped; " ++
                show numerrors ++ " errored."
    let summary = unlines $ zipWith (\fp res -> printf "%-10s %s" (show res) fp) testFiles results
    when (null args) $ do -- write log if complete test suite run
      ex <- doesFileExist "test-citeproc.log"
      when ex $ do
        putStrLn "Copying existing test-citeproc.log to test-citeproc.log.old"
        copyFile "test-citeproc.log" "test-citeproc.log.old"
      putStrLn "Writing test-citeproc.log."
      UTF8.writeFile "test-citeproc.log" summary
    exitWith $ if numfailures == 0
                  then ExitSuccess
                  else ExitFailure $ numfailures + numerrors
  