content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# LANGUAGE CPP                 #-}
  {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  module Main where
  import Data.Maybe
  import Data.Aeson (decode, encode)
  import Data.Algorithm.Diff
  import qualified Data.ByteString.Lazy as BL
  import qualified Data.Map as Map
  #if !MIN_VERSION_base(4,11,0)
  import Data.Semigroup ((<>), Semigroup)
  #endif
  import Data.Text (Text)
  import qualified Data.Text as Text
  import qualified Data.Text.IO as Text
  import qualified Data.Text.Encoding as TE
  import System.Directory
  import System.Environment (getArgs)
  import System.FilePath
  import System.Exit (exitFailure)
  import System.IO (hSetEncoding, utf8, openFile, IOMode(..))
  import Test.QuickCheck
  import Test.Tasty
  import Test.Tasty.Golden.Advanced (goldenTest)
  import Test.Tasty.HUnit
  import Test.Tasty.QuickCheck (testProperty)
  import Text.Show.Pretty
  import GHC.IO.Encoding (setLocaleEncoding)
  import Skylighting.Core
  
  readTextFile :: FilePath -> IO Text
  readTextFile fp = do
    h <- openFile fp ReadMode
    hSetEncoding h utf8
    Text.hGetContents h
  
  tokToText :: Token -> Text
  tokToText (_, s) = s
  
  xmlPath :: FilePath
  xmlPath = "xml/"
  
  main :: IO ()
  main = do
    setLocaleEncoding utf8
    sMap <- do
        result <- loadSyntaxesFromDir xmlPath
        case result of
            Left e -> do
                putStrLn $ "Error loading syntax definitions from " <> xmlPath <> ": " <> e
                exitFailure
            Right m -> return m
  
    let syntaxes = Map.elems sMap
        defConfig = TokenizerConfig { traceOutput = False
                                    , syntaxMap = sMap
                                    }
    let getMatchers = map rMatcher .  concatMap cRules . sContexts
    let getRegexFromMatcher (RegExpr re) = Just $ reString re
        getRegexFromMatcher _ = Nothing
    let getRegexesFromSyntax = mapMaybe getRegexFromMatcher . getMatchers
    inputs <- filter (\fp -> take 1 fp /= ".")
           <$> getDirectoryContents ("test" </> "cases")
    allcases <- mapM (fmap (Text.take 240)
                      . readTextFile . (("test" </> "cases") </>)) inputs
    args <- getArgs
    let regen = "--accept" `elem` args
    defaultTheme <- BL.readFile ("test" </> "default.theme")
    defaultMain $ testGroup "skylighting tests" $
      [ testGroup "tokenizer tests" $
          map (tokenizerTest defConfig sMap regen) inputs
      , testGroup "FromJSON instance tests"
         [ testCase "decode simple color" $
              Just (RGB 0x15 0xff 0xa0) @=? decode "\"#15ffa0\""
         , testCase "decode TokenStyle" $
              Just (TokenStyle{tokenColor = Just (RGB 0x1f 0x1c 0x1b),
                               tokenBackground = Nothing,
                               tokenBold = True,
                               tokenItalic = False,
                               tokenUnderline = False }) @=?
              decode "{ \"text-color\": \"#1f1c1b\", \"bold\": true }"
         , testCase "decode KDE theme to Style" $
              Just kate @=? decode defaultTheme
         , testCase "round trip style -> theme -> style" $
              Just kate @=? decode (encode kate)
         ]
      , testGroup "Skylighting" $
        [ testCase "syntaxesByFilename" $
              ["Perl"] @=?
                map sName (syntaxesByFilename sMap "foo/bar.pl")
        ]
      , testGroup "Doesn't hang or drop text on a mixed syntax sample" $
          map (noDropTest defConfig allcases) syntaxes
      , testGroup "Doesn't hang or drop text on fuzz" $
          map (\syn -> testProperty (Text.unpack (sName syn)) (p_no_drop defConfig syn))
          syntaxes
      , testGroup "All regexes compile" $
          map
             (\syn -> testGroup ("syntax " <> sFilename syn)
              (map
                (\regex ->
                  testCase ("regex " <>
                             (Text.unpack $ TE.decodeUtf8 regex) <> " in "
                             <> sFilename syn)
               $ case compileRegex True regex of
                   Right _ -> assertBool "regex does not compile" True
                   Left e -> assertFailure ("regex does not compile: " <> show e))
                           $ getRegexesFromSyntax syn))
          syntaxes
      , testGroup "Regex module" $ map regexTest regexTests
      , testGroup "Regression tests" $
        let perl = maybe (error "could not find Perl syntax") id
                               (lookupSyntax "Perl" sMap)
            html = maybe (error "could not find HTML syntax") id
                               (lookupSyntax "html" sMap)
            cpp  = maybe (error "could not find CPP syntax") id
                               (lookupSyntax "cpp" sMap)
            bash  = maybe (error "could not find bash syntax") id
                               (lookupSyntax "bash" sMap)
            c    = maybe (error "could not find C syntax") id
                               (lookupSyntax "c" sMap) in
        [ testCase "perl NUL case" $ Right
               [[(OtherTok,"s\NULb\NUL")
                ,(StringTok,"c")
                ,(OtherTok,"\NUL")]]
               @=? tokenize defConfig perl "s\0b\0c\0"
        , testCase "perl backslash case 1" $ Right
            [[(OtherTok,"m\\'")]]
              @=? tokenize defConfig perl
                       "m\\'"
        , testCase "perl backslash case 2" $ Right
            [[(OtherTok,"m\\a\\")]]
              @=? tokenize defConfig perl
                       "m\\a\\"
        , testCase "perl quoting case" $ Right
            [[(KeywordTok,"my")
             ,(NormalTok," ")
             ,(DataTypeTok,"$foo")
             ,(NormalTok," = ")
             ,(OtherTok,"q/")
             ,(SpecialStringTok,"bar")
             ,(OtherTok,"/")
             ,(NormalTok,";")]
            ,[(KeywordTok,"my")
             ,(NormalTok," ")
             ,(DataTypeTok,"$baz")
             ,(NormalTok," = ")
             ,(OtherTok,"'")
             ,(SpecialStringTok,"quux")
             ,(OtherTok,"'")
             ,(NormalTok,";")]]
               @=? tokenize defConfig perl
                       "my $foo = q/bar/;\nmy $baz = 'quux';\n"
        , testCase "cpp floats" $ Right
             [ [ (FloatTok,"0.1") , (BuiltInTok,"f")]
             , [ (FloatTok,"1.0") , (BuiltInTok,"f")]
             , [ (OperatorTok,"-") , (FloatTok,"0.1") , (BuiltInTok,"f")]
             , [ (OperatorTok,"-") , (FloatTok,"1.0") , (BuiltInTok,"F")]
             , [ (OperatorTok,"-") , (FloatTok,"1.0") , (BuiltInTok,"L")]
             , [ (FloatTok,"1e3")]
             , [ (OperatorTok,"-") , (FloatTok,"15e+3")]
             , [ (FloatTok,"0.") , (BuiltInTok,"f")]
             , [ (FloatTok,"1.") , (BuiltInTok,"F")]
             , [ (FloatTok,"1.E3")]
             ] @=? tokenize defConfig cpp
                       "0.1f\n1.0f\n-0.1f\n-1.0F\n-1.0L\n1e3\n-15e+3\n0.f\n1.F\n1.E3"
        , testCase "cpp identifier (#76)" $ Right
             [ [ (NormalTok,"ng_or") ]
             ] @=? tokenize defConfig cpp "ng_or"
  
        , testCase "c '\\0' (#82)" $ Right
             [ [ (CharTok,"'"),(SpecialCharTok,"\\0"),(CharTok,"'") ]
             ] @=? tokenize defConfig c "'\\0'"
  
        , testCase "c very long integer (#81)" $ Right
             [ [ (DecValTok, "1111111111111111111111") ]
             ] @=? tokenize defConfig c "1111111111111111111111"
  
        , testCase "Chinese characters in HTML (#110)" $ Right
            [ [ ( NormalTok , "\35797\65306" ) , ( DataTypeTok , "<" ) ,
                ( KeywordTok , "a" ) , ( DataTypeTok , ">" ) ]
            ] @=? tokenize defConfig html "试：<a>"
  
        , testCase "Bash closing brace (#119)" $ Right
            [ [ ( FunctionTok , "f()" )
              , ( NormalTok , " " )
              , ( KeywordTok , "{" ) ]
            , [ ( NormalTok , "    " )
              , ( BuiltInTok , "echo" )
              , ( NormalTok , " " )
              , ( OperatorTok , ">" )
              , ( NormalTok , " f" ) ]
            , [ ( KeywordTok , "}" ) ] ]
               @=? tokenize defConfig bash
                       "f() {\n    echo > f\n}\n"
  
        , testCase "C floating-point literal (#174)" $ Right
            [ [ ( DataTypeTok , "double")
              , ( NormalTok , " x " )
              , ( OperatorTok , "=" )
              , ( NormalTok , " " )
              , ( FloatTok , "0.5")
              , ( OperatorTok , ";" ) ] ]
               @=? tokenize defConfig c
                       "double x = 0.5;\n"
  
        ]
      ]
  
  compareValues :: FilePath -> Text -> Text -> IO (Maybe String)
  compareValues referenceFile expected actual =
     if expected == actual
        then return $ Nothing
        else return $ Just $ makeDiff referenceFile
                             (Text.lines expected) (Text.lines actual)
  
  makeDiff :: FilePath -> [Text] -> [Text] -> String
  makeDiff referenceFile expected actual = unlines $
    [ "--- " ++ referenceFile
    , "+++ actual" ] ++
    map (Text.unpack . vividize) (filter notBoth (getDiff expected actual))
      where notBoth (Both _ _ ) = False
            notBoth _           = True
  
  instance Arbitrary Text where
    arbitrary = Text.pack <$> arbitrary
    shrink xs = Text.pack <$> shrink (Text.unpack xs)
  
  p_no_drop :: TokenizerConfig -> Syntax -> Text -> Bool
  p_no_drop cfg syntax t =
    case tokenize cfg syntax t of
         Right ts -> Text.lines t == map (mconcat . map tokToText) ts
         Left _   -> False
  
  noDropTest :: TokenizerConfig -> [Text] -> Syntax -> TestTree
  noDropTest cfg inps syntax =
    localOption (mkTimeout 75000000)
    $ testCase (Text.unpack (sName syntax))
    $ mapM_ go inps
      where go inp =
                case tokenize cfg syntax inp of
                      Right ts -> assertBool ("Text has been dropped:\n" ++ diffs)
                                   (inplines == toklines)
                           where inplines = Text.lines inp
                                 toklines = map (mconcat . map tokToText) ts
                                 diffs = makeDiff "expected" inplines toklines
                      Left  e  ->
                        assertFailure ("Unexpected error: " ++ e ++ "\ninput = " ++ show inp)
  
  tokenizerTest :: TokenizerConfig -> SyntaxMap -> Bool -> FilePath -> TestTree
  tokenizerTest cfg sMap regen inpFile = localOption (mkTimeout 75000000) $
    goldenTest testname getExpected getActual
        (compareValues referenceFile) updateGolden
    where testname = lang ++ " tokenizing of " ++ inpFile
          getExpected = readTextFile referenceFile
          getActual = do
            code <- readTextFile (casesdir </> inpFile)
            syntax <- case lookupSyntax (Text.pack lang) sMap of
                           Just s  -> return s
                           Nothing -> fail $
                              "Could not find syntax definition for " ++ lang
            case tokenize cfg syntax $! code of
                   Left e   -> fail e
                   Right ls -> return $ Text.pack $ ppShow ls ++ "\n"
          updateGolden = if regen
                            then Text.writeFile referenceFile
                            else \_ -> return ()
          expecteddir = "test" </> "expected"
          casesdir = "test" </> "cases"
          referenceFile = expecteddir </> inpFile <.> "native"
          lang = drop 1 $ takeExtension inpFile
  
  regexTest :: (String, String, Maybe (String, [(Int,String)])) -> TestTree
  regexTest (re, inp, expected) =
    testCase ("/" ++ re ++ "/ " ++ inp) $
      expected @=? testRegex True re inp
  
  regexTests :: [(String, String, Maybe (String, [(Int,String)]))]
  regexTests =
    [ (".", "aab", Just ("a", []))
    , ("ab", "aab", Nothing)
    , ("ab", "abb", Just ("ab", []))
    , ("a{2}b", "aaab", Nothing)
    , ("a{2,}b", "aaab", Just ("aaab", []))
    , ("a{2,3}b", "aab", Just ("aab", []))
    , ("a{2,3}b", "aaab", Just ("aaab", []))
    , ("a(b)", "abb", Just ("ab", [(1,"b")]))
    , ("a(b.)*", "abbbcb", Just ("abbbc", [(1,"bc")]))
    , ("a(?:b.)*", "abbbcb", Just ("abbbc", []))
    , ("a(?=b)", "abb", Just ("a", []))
    , ("a(?=b)", "acb", Nothing)
    , ("a(?!b)", "abb", Nothing)
    , ("a(?!b)", "acb", Just ("a", []))
    , ("a?b+", "bbb", Just ("bbb", []))
    , ("a?b+", "abbb", Just ("abbb", []))
    , ("a?b+", "ac", Nothing)
    , ("a*", "bbb", Just ("", []))
    , ("abc|ab$", "ab", Just ("ab", []))
    , ("abc|ab$", "abcd", Just ("abc", []))
    , ("abc|ab$", "abd", Nothing)
    , ("[\\x50-\\x51]*", "PQR", Just ("PQ", []))
    , ("[\\x{2019}]*", "\x2019PQR", Just ("\x2019", []))
    , ("(?:ab)*|a.*", "abababa", Just ("abababa", []))
    , ("a[b-e]*", "abcdefg", Just ("abcde", []))
    , ("a[b-e\\n-]*", "abcde\nb-bcfg", Just ("abcde\nb-bc", []))
    , ("^\\s+\\S+\\s+$", "   abc  ", Just ("   abc  ", []))
    , ("\\$", "$$", Just ("$", []))
    , ("[\\z12bb]", "\x12bb", Just ("\x12bb", []))
    , ("[\\p{Lu}\\p{Ll}]*", "Σφa1B", Just ("Σφa", []))
    , ("\\bhello\\b|hell", "hello there", Just ("hello", []))
    , ("\\bhello\\b|hell", "hellothere", Just ("hell", []))
    , ("u\\b", "ue", Nothing)
    , ("[[:space:]]{2,4}.", "  abc", Just ("  a", []))
    , ("[[:space:]]{2,4}.", " abc", Nothing)
    , ("[[:space:]]{2,4}.", "     abc", Just ("     ", []))
    , ("((..)\\+\\2)", "aa+aabb+bbbc+cb",
            Just ("aa+aa", [(1,"aa+aa"), (2,"aa")]))
    , ("(\\d+)/(\\d+) == \\{1}", "22/2 == 22",
           Just ("22/2 == 22", [(1,"22"), (2,"2")]))
    , ("([a-z]+){2}", "htabc", Just ("htabc", [(1,"c")]))
    , ("((.+)(.+)(.+))*", (replicate 400 'a'),
            Just (replicate 400 'a',
                   [(1, replicate 400 'a')
                   ,(2,replicate 398 'a')
                   ,(3,"a")
                   ,(4,"a")]))
    , ("a++a", "aaaaa", Nothing)
    , ("\\w+e", "aaaeeee", Just ("aaaeeee", []))
    , ("\\w+?e", "aaaeeee", Just ("aaae", []))
    , ("a+b??", "aaab", Just ("aaa", []))
    , ("\\([a-z]+(?R)*\\)", "(aa(b(c)(d)))", Just ("(aa(b(c)(d)))", []))
    , ("a{}", "aaa", Nothing)
    , ("a{}", "a{}", Just ("a{}", []))
    , ("a{3", "a{3", Just ("a{3", []))
    , ("(?|(abc)|(def))", "abc", Just ("abc", [(1,"abc")]))
    , ("(?|(abc)|(def))", "def", Just ("def", [(1,"def")]))
    , ("(?:(abc)|(def))", "def", Just ("def", [(2,"def")]))
    , ("((?i:infinity|e|pi)|NaN)", "InfInity",
        Just ("InfInity", [(1,"InfInity")]))
  --  , ("(?im)foo", "Foo", Just ("Foo", []))
    , ("d(?=(bc)|(ef))", "def", Just ("d", [(2,"ef")]))
    , ("([bcd])([efg])(?2)(?1)", "befd", Just ("befd", [(1,"b"),(2,"e")]))
    , ("([abc](?1)*)", "abcd", Just ("abc", [(1,"abc")]))
    , ("(x(?1)*)", "xxxxy", Just ("xxxx", [(1,"xxxx")]))
    , ("a|\\((?0)\\)", "(((a)))", Just ("(((a)))", []))
    , ("([abc](x(?1))*)", "axbxcc", Just ("axbxc", [(1,"axbxc"),(2,"xc")]))
      -- note: pcre gives insetad (2, "xbxc") -- I don't understand why
    , ("[\\p{Nd}]", "33", Just ("3", []))
    , ("\\p{N}", "33", Just ("3", []))
    ]
  
  
  vividize :: Diff Text -> Text
  vividize (Both s _) = "  " <> s
  vividize (First s)  = "- " <> s
  vividize (Second s) = "+ " <> s
  