content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE PackageImports #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE TupleSections #-}
  
  module Data.YamlSpec (main, spec) where
  
  import qualified Text.Libyaml as Y
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Char8 as B8
  import Data.Int (Int64)
  import qualified Data.Scientific as S
  
  import Test.HUnit hiding (Test, path)
  
  import Data.Conduit (runConduitRes, (.|), ConduitM)
  import qualified Data.Conduit.List as CL
  
  import Control.Monad
  import Control.Exception (try, SomeException)
  import Test.Hspec
  import Test.Hspec.QuickCheck
  import Data.Either.Compat
  import System.Directory (createDirectory, createDirectoryIfMissing)
  import Test.Mockery.Directory
  
  import qualified Data.Yaml as D
  import qualified Data.Yaml.Builder as B
  import qualified Data.Yaml.Internal as Internal
  import qualified Data.Yaml.Pretty as Pretty
  import Data.Yaml (object, array, (.=))
  import Data.Maybe
  import qualified Data.HashMap.Strict as HM
  #if MIN_VERSION_aeson(2,0,0)
  import qualified Data.Aeson.KeyMap as M
  import qualified Data.Aeson.Key as K
  import Data.Aeson.KeyMap (KeyMap)
  #else
  import qualified Data.HashMap.Strict as M
  #endif
  import qualified Data.Text as T
  import Data.Aeson.TH
  import Data.Scientific (Scientific)
  import Data.String (fromString)
  import Data.Text (Text)
  import Data.Text.Encoding (decodeUtf8, encodeUtf8)
  import Data.Vector (Vector)
  import qualified Data.Vector as V
  import Data.HashMap.Strict (HashMap)
  import qualified Data.HashMap.Strict as HM
  import System.IO (hClose)
  import System.IO.Temp (withSystemTempFile)
  
  #if MIN_VERSION_aeson(2,0,0)
  fromText :: T.Text -> K.Key
  fromText = K.fromText
  
  toText :: K.Key -> T.Text
  toText = K.toText
  #else
  fromText :: T.Text -> T.Text
  fromText = id
  
  toText :: Key -> T.Text
  toText = id
  
  type KeyMap a = M.HashMap Text a
  type Key = Text
  #endif
  
  data TestJSON = TestJSON
                { string :: Text
                , number :: Int
                , anArray  :: Vector Text
                , hash   :: HashMap Text Text
                , extrastring :: Text
                } deriving (Show, Eq)
  
  deriveJSON defaultOptions ''TestJSON
  
  testJSON :: TestJSON
  testJSON = TestJSON
           { string = "str"
           , number = 2
           , anArray = V.fromList ["a", "b"]
           , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]
           , extrastring = "1234-foo"
           }
  
  shouldDecode :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> a -> IO ()
  shouldDecode bs expected = do
      actual <- D.decodeThrow bs
      actual `shouldBe` expected
  
  shouldDecodeAll :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> [a] -> IO ()
  shouldDecodeAll bs expected = do
      actual <- D.decodeAllThrow bs
      actual `shouldBe` expected
  
  shouldDecodeEvents :: B8.ByteString -> [Y.Event] -> IO ()
  shouldDecodeEvents bs expected = do
      actual <- runConduitRes $ Y.decode bs .| CL.consume
      map anyStyle actual `shouldBe` map anyStyle expected
  
  anyStyle :: Y.Event -> Y.Event
  anyStyle (Y.EventScalar bs tag _ anchor)     = Y.EventScalar bs tag Y.Any anchor
  anyStyle (Y.EventSequenceStart tag _ anchor) = Y.EventSequenceStart tag Y.AnySequence anchor
  anyStyle (Y.EventMappingStart tag _ anchor)  = Y.EventMappingStart tag Y.AnyMapping anchor
  anyStyle event = event
  
  testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString
  testEncodeWith opts es = runConduitRes $ CL.sourceList (eventStream es) .| Y.encodeWith opts
  
  eventStream :: [Y.Event] -> [Y.Event]
  eventStream events =
      [Y.EventStreamStart, Y.EventDocumentStart]
      ++ events
      ++ [Y.EventDocumentEnd, Y.EventStreamEnd]
  
  main :: IO ()
  main = hspec spec
  
  spec :: Spec
  spec = do
      describe "streaming" $ do
          it "count scalars with anchor" caseCountScalarsWithAnchor
          it "count sequences with anchor" caseCountSequencesWithAnchor
          it "count mappings with anchor" caseCountMappingsWithAnchor
          it "count sequences with custom tag" caseCountSequenceTags
          it "count mappings with custom tag" caseCountMappingTags
          it "count count sequences with ! tag" caseCountEmptySequenceTags
          it "count count mappings with ! tag" caseCountEmptyMappingTags
          it "count block style sequences" caseCountBlockStyleSequences
          it "count flow style sequences" caseCountFlowStyleSequences
          it "count block style mappings" caseCountBlockStyleMappings
          it "count flow style mappings" caseCountFlowStyleMappings
          it "count aliases" caseCountAliases
          it "count scalars" caseCountScalars
          it "largest string" caseLargestString
          it "encode/decode" caseEncodeDecode
          it "encode/decode events" caseEncodeDecodeEvents
          it "encode/decode file" caseEncodeDecodeFile
          it "interleaved encode/decode" caseInterleave
          it "decode invalid document (without segfault)" caseDecodeInvalidDocument
      describe "Data.Yaml" $ do
          it "encode/decode" caseEncodeDecodeData
          it "encode/decode file" caseEncodeDecodeFileData
          it "encode/decode files with non-ASCII names" caseEncodeDecodeNonAsciiFileData
          it "encode/decode strings" caseEncodeDecodeStrings
          it "decode invalid file" caseDecodeInvalid
          it "processes datatypes" caseDataTypes
          it "encode invalid numbers" caseEncodeInvalidNumbers
      describe "Data.Yaml.Pretty" $ do
          it "encode/decode" caseEncodeDecodeDataPretty
          it "encode/decode strings" caseEncodeDecodeStringsPretty
          it "processes datatypes" caseDataTypesPretty
      describe "Data.Yaml.Builder" $ do
          it "encode/decode" caseEncodeDecodeDataBuilder
          it "encode/decode complex mapping" caseEncodeDecodeComplexMappingBuilder
      describe "Data.Yaml aliases" $ do
          it "simple scalar alias" caseSimpleScalarAlias
          it "simple sequence alias" caseSimpleSequenceAlias
          it "simple mapping alias" caseSimpleMappingAlias
          it "mapping alias before anchor" caseMappingAliasBeforeAnchor
          it "mapping alias inside anchor" caseMappingAliasInsideAnchor
          it "scalar alias overriding" caseScalarAliasOverriding
      describe "Data.Yaml merge keys" $ do
          it "test uniqueness of keys" caseAllKeysShouldBeUnique
          it "test mapping merge" caseSimpleMappingMerge
          it "test sequence of mappings merging" caseMergeSequence
      describe "numbers" $ do
          it "parses as string when quoted" caseQuotedNumber
          it "parses as number when unquoted" caseUnquotedNumber
          it "parses as number !!str is present" caseAttribNumber
          it "integers have no decimals" caseIntegerDecimals
      describe "booleans" $ do
          it "parses when all lowercase" caseLowercaseBool
          it "parses when all uppercase" caseUppercaseBool
          it "parses when titlecase" caseTitlecaseBool
      describe "empty input" $ do
          it "parses as Null" caseEmptyInput
          it "parses as Null from file" caseEmptyInputFile
      describe "comment only input" $ do
          it "parses as Null" caseCommentOnlyInput
          it "parses as Null from file" caseCommentOnlyInputFile
      describe "alias stripping" $ do
          it "works" caseStripAlias
      describe "nulls" $ do
          checkNull "null"
          checkNull "Null"
          checkNull "NULL"
          checkNull "~"
          checkNull ""
  
      describe "pretty output" $ do
          it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n"
          it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n"
          it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n"
          it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n"
          it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n"
          it "*" $ D.encode (object ["foo" .= ("*" :: T.Text)]) `shouldBe` "foo: '*'\n"
  
      describe "special keys" $ do
          let tester key = it (T.unpack key) $
                  let value = object [fromText key .= True]
                   in D.encode value `shouldDecode` value
          mapM_ tester specialStrings
  
      describe "special values" $ do
          let tester value = it (T.unpack value) $
                  let value' = object ["foo" .= value]
                   in D.encode value' `shouldDecode` value'
          mapM_ tester specialStrings
  
      describe "decodeFileEither" $ do
          it "loads YAML through JSON into Haskell data" $ do
            tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"
            tj `shouldBe` testJSON
  
          context "when file does not exist" $ do
              it "returns Left" $ do
                  (D.decodeFileEither "./does_not_exist.yaml" :: IO (Either D.ParseException D.Value)) >>= (`shouldSatisfy` isLeft)
  
      describe "multiple document support" $ do
          it "decodes zero-length input" $
              "" `shouldDecodeAll` ([] :: [D.Value])
          it "decodes comment-only input" $
              "# foo\n# bar" `shouldDecodeAll` ([] :: [D.Value])
          it "decodes a single document stream" $
              "foo: true" `shouldDecodeAll` [object ["foo" .= True]]
          it "decodes multiple documents" $
              "--- 1\n--- 2" `shouldDecodeAll` [D.Number 1, D.Number 2]
  
      describe "round-tripping of special scalars" $ do
          let special = words "y Y On ON false 12345 12345.0 12345a 12e3"
          forM_ special $ \w -> it w $
              let v = object ["word" .= w]
               in D.encode v `shouldDecode` v
          it "no tags" $ D.encode (object ["word" .= ("true" :: String)]) `shouldBe` "word: 'true'\n"
  
      it "aliases in keys #49" caseIssue49
  
      it "serialization of +123 #64" $ do
          D.encode ("+123" :: String) `shouldDecode` ("+123" :: String)
  
      it "preserves Scientific precision" casePreservesScientificPrecision
  
      it "truncates files" caseTruncatesFiles
  
      it "encode quotes special keys #137" $ caseSpecialKeys D.encode
  
      it "encodePretty quotes special keys #179" $ caseSpecialKeys (Pretty.encodePretty Pretty.defConfig)
  
      describe "non-decimal numbers #135" $ do
        let go str val = it str $ encodeUtf8 (T.pack str) `shouldDecode` val
        go "12345" (12345 :: Int)
        go "+12345" (12345 :: Int)
        go "0o14" (12 :: Int)
        go "0o123" (83 :: Int)
        go "0xC" (12 :: Int)
        go "0xc" (12 :: Int)
        go "0xdeadBEEF" (3735928559 :: Int64)
        go "0xDEADBEEF" (3735928559 :: Int64)
        go "1.23015e+3" (1230.15 :: Scientific)
        go "12.3015e+02" (1230.15 :: Scientific)
        go "1230.15" (1230.15 :: Scientific)
  
      describe "Text.Libyaml with default tag rendering" $ do
        let enc = testEncodeWith Y.defaultFormatOptions
        it "elides custom sequence tags" $
          enc taggedSequence `shouldReturn` "[]\n"
        it "elides custom mapping tags" $
          enc taggedMapping `shouldReturn` "{}\n"
        it "elides default sequence tags" $
          enc defaultTaggedSequence `shouldReturn` "[]\n"
        it "elides default mapping tags" $
          enc defaultTaggedMapping `shouldReturn` "{}\n"
        it "handles NoTag on sequences" $
          enc untaggedSequence `shouldReturn` "[]\n"
        it "handles NoTag on mappings" $
          enc untaggedMapping `shouldReturn` "{}\n"
        it "handles mixed tag usages but elides all mapping and sequence tags" $
          enc mixedTagSampleA `shouldReturn` "- {}\n"
        it "in combination of tags, anchors and styles, outputs only the scalar tags" $
          enc mixedTagSampleB `shouldReturn` "&a\n&b !<bar> foo: &c [&d !!null '']\n"
        it "outputs tags when double quoted" $
          enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "!!str \"foo\"\n"
        it "outputs tags when single quoted" $
          enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "!!str 'foo'\n"
        it "outputs tags on literal text" $
          enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "!!str |-\n  foo\n"
        it "outputs tags on folded text" $
          enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` "!!str >-\n  foo\n"
      describe "Text.Libyaml with all tags on" $ do
        let enc = testEncodeWith $ Y.setTagRendering Y.renderAllTags Y.defaultFormatOptions
        it "will output custom sequence tags" $
          enc taggedSequence `shouldReturn` "!foo []\n"
        it "will output custom mapping tags" $
          enc taggedMapping `shouldReturn` "!foo {}\n"
        it "will output default sequence tags" $
          enc defaultTaggedSequence `shouldReturn` "!!seq []\n"
        it "will output default mapping tags" $
          enc defaultTaggedMapping `shouldReturn` "!!map {}\n"
        it "handles NoTag on sequences" $
          enc untaggedSequence `shouldReturn` "[]\n"
        it "handles NoTag on mappings" $
          enc untaggedMapping `shouldReturn` "{}\n"
        it "handles mixed tag usages outputting all mapping and sequence tags" $
          enc mixedTagSampleA `shouldReturn` "- !foo {}\n"
        it "in combination of tags, anchors and styles, outputs all the tags" $
          enc mixedTagSampleB `shouldReturn` "&a\n&b !<bar> foo: &c !baz [&d !!null '']\n"
        it "outputs plain tags" $
          enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "!!str foo\n"
        it "respects PlainNoTag tags" $
          enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n"
      describe "Text.Libyaml with uri tags on" $ do
        let enc = testEncodeWith $ Y.setTagRendering Y.renderUriTags Y.defaultFormatOptions
        it "will output custom sequence tags" $
          enc taggedSequence `shouldReturn` "!foo []\n"
        it "will output custom mapping tags" $
          enc taggedMapping `shouldReturn` "!foo {}\n"
        it "will output default sequence tags" $
          enc defaultTaggedSequence `shouldReturn` "[]\n"
        it "will output default mapping tags" $
          enc defaultTaggedMapping `shouldReturn` "{}\n"
        it "handles NoTag on sequences" $
          enc untaggedSequence `shouldReturn` "[]\n"
        it "handles NoTag on mappings" $
          enc untaggedMapping `shouldReturn` "{}\n"
        it "handles mixed tag usages outputting all mapping and sequence tags" $
          enc mixedTagSampleA `shouldReturn` "- !foo {}\n"
        it "in combination of tags, anchors and styles, outputs all the tags" $
          enc mixedTagSampleB `shouldReturn` "&a\n&b !<bar> foo: &c !baz [&d '']\n"
      describe "Text.Libyaml with tags off" $ do
        let enc = testEncodeWith $ Y.setTagRendering Y.renderNoTags Y.defaultFormatOptions
        it "outputs plain tags" $
          enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "foo\n"
        it "respects PlainNoTag tags" $
          enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n"
        it "elides tags when double quoted" $
          enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "\"foo\"\n"
        it "elides tags when single quoted" $
          enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "'foo'\n"
        it "elides tags on literal text" $
          enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "|-\n  foo\n"
        it "elides tags on folded text" $
          enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` ">-\n  foo\n"
      describe "Text.Libyaml with only UriTags set to render " $ do
        let enc =
              testEncodeWith $
              Y.setTagRendering Y.renderUriTags $ Y.defaultFormatOptions
        it "outputs only UriTags" $
          enc
            [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing
            , Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing
            , Y.EventScalar "99" Y.IntTag Y.Plain Nothing
            , Y.EventScalar "99.99" Y.FloatTag Y.Plain Nothing
            , Y.EventScalar "bar" Y.NoTag Y.Plain Nothing
            , Y.EventScalar "foo" (Y.UriTag "!foo") Y.DoubleQuoted Nothing
            , Y.EventScalar "foo" (Y.UriTag "!foo") Y.Plain Nothing
            , Y.EventSequenceEnd
            ] `shouldReturn`
          "[\"foo\", 99, 99.99, bar, !foo \"foo\", !foo foo]\n"
  
        prop "Scientific values round-trip" $ \coeff expon -> do
          let val = D.Number $ S.scientific coeff expon
          let rendered = D.encode val
          case D.decodeEither' rendered of
            Left e -> error $ show (coeff, expon, e)
            Right val' -> val' `shouldBe` val
  
  specialStrings :: [T.Text]
  specialStrings =
      [ "fo\"o"
      , "fo\'o"
      , "fo\\'o"
      , "fo: o"
      , "foo\nbar\nbaz\n"
      ]
  
  counter :: Monad m => (Y.Event -> Bool) -> ConduitM Y.Event o m Int
  counter pred' =
      CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
  
  caseHelper :: String
             -> (Y.Event -> Bool)
             -> Int
             -> Assertion
  caseHelper yamlString pred' expRes = do
      res <- runConduitRes $ Y.decode (B8.pack yamlString) .| counter pred'
      res @?= expRes
  
  caseCountScalarsWithAnchor :: Assertion
  caseCountScalarsWithAnchor =
      caseHelper yamlString isScalarA 1
    where
      yamlString = "foo:\n  - &anchor bin1\n  - bin2\n  - bin3"
      isScalarA (Y.EventScalar _ _ _ (Just _)) = True
      isScalarA _ = False
  
  caseCountSequencesWithAnchor :: Assertion
  caseCountSequencesWithAnchor =
      caseHelper yamlString isSequenceStartA 1
    where
      yamlString = "foo: &anchor\n  - bin1\n  - bin2\n  - bin3"
      isSequenceStartA (Y.EventSequenceStart Y.NoTag _ (Just _)) = True
      isSequenceStartA _ = False
  
  caseCountMappingsWithAnchor :: Assertion
  caseCountMappingsWithAnchor =
      caseHelper yamlString isMappingA 1
    where
      yamlString = "foo: &anchor\n  key1: bin1\n  key2: bin2\n  key3: bin3"
      isMappingA (Y.EventMappingStart _ _ (Just _)) = True
      isMappingA _ = False
  
  caseCountAliases :: Assertion
  caseCountAliases =
      caseHelper yamlString isAlias 1
    where
      yamlString = "foo: &anchor\n  key1: bin1\n  key2: bin2\n  key3: bin3\nboo: *anchor"
      isAlias Y.EventAlias{} = True
      isAlias _ = False
  
  caseCountMappingTags :: Assertion
  caseCountMappingTags =
      caseHelper yamlString isCustomTaggedMapping 1
    where
      yamlString = "foo: !bar\n  k: v\n  k2: v2"
      isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _ _) = True
      isCustomTaggedMapping _ = False
  
  caseCountEmptyMappingTags :: Assertion
  caseCountEmptyMappingTags =
      caseHelper yamlString isCustomTaggedMapping 1
    where
      yamlString = "foo: !\n  k: v\n  k2: v2"
      isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!") _ _) = True
      isCustomTaggedMapping _ = False
  
  caseCountSequenceTags :: Assertion
  caseCountSequenceTags =
      caseHelper yamlString isCustomTaggedSequence 1
    where
      yamlString = "foo: !bar [x, y, z]"
      isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True
      isCustomTaggedSequence _ = False
  
  caseCountEmptySequenceTags :: Assertion
  caseCountEmptySequenceTags =
      caseHelper yamlString isCustomTaggedSequence 1
    where
      yamlString = "foo: ! [x, y, z]"
      isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!") _ _) = True
      isCustomTaggedSequence _ = False
  
  caseCountFlowStyleSequences :: Assertion
  caseCountFlowStyleSequences =
      caseHelper yamlString isFlowStyleSequence 1
    where
      yamlString = "foo: [x, y, z]"
      isFlowStyleSequence (Y.EventSequenceStart _ Y.FlowSequence _) = True
      isFlowStyleSequence _ = False
  
  caseCountBlockStyleSequences :: Assertion
  caseCountBlockStyleSequences =
      caseHelper yamlString isBlockStyleSequence 1
    where
      yamlString = "foo:\n- x\n- y\n- z\n"
      isBlockStyleSequence (Y.EventSequenceStart _ Y.BlockSequence _) = True
      isBlockStyleSequence _ = False
  
  caseCountFlowStyleMappings :: Assertion
  caseCountFlowStyleMappings =
      caseHelper yamlString isFlowStyleMapping 1
    where
      yamlString = "foo: { bar: 1, baz: 2 }"
      isFlowStyleMapping (Y.EventMappingStart _ Y.FlowMapping _) = True
      isFlowStyleMapping _ = False
  
  caseCountBlockStyleMappings :: Assertion
  caseCountBlockStyleMappings =
      caseHelper yamlString isBlockStyleMapping 1
    where
      yamlString = "foo: bar\nbaz: quux"
      isBlockStyleMapping (Y.EventMappingStart _ Y.BlockMapping _) = True
      isBlockStyleMapping _ = False
  
  caseCountScalars :: Assertion
  caseCountScalars = do
      res <- runConduitRes $ Y.decode yamlBS .| CL.fold adder accum
      res @?= (7, 1, 2)
    where
      yamlString = "foo:\n  baz: [bin1, bin2, bin3]\nbaz: bazval"
      yamlBS = B8.pack yamlString
      adder (s, l, m) (Y.EventScalar{})        = (s + 1, l, m)
      adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)
      adder (s, l, m) (Y.EventMappingStart{})  = (s, l, m + 1)
      adder a         _                      = a
      accum = (0, 0, 0) :: (Int, Int, Int)
  
  caseLargestString :: Assertion
  caseLargestString = do
      res <- runConduitRes $ Y.decodeFile filePath .| CL.fold adder accum
      res @?= (length expected, expected)
      where
          expected = "this one is just a little bit bigger than the others"
          filePath = "test/largest-string.yaml"
          adder (i, s) (Y.EventScalar bs _ _ _) =
              let s' = B8.unpack bs
                  i' = length s'
               in if i' > i then (i', s') else (i, s)
          adder acc _ = acc
          accum = (0, "no strings found")
  
  newtype MyEvent = MyEvent Y.Event deriving Show
  instance Eq MyEvent where
      (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
          s == s' && t == t'
      MyEvent e1 == MyEvent e2 = e1 == e2
  
  caseEncodeDecode :: Assertion
  caseEncodeDecode = do
      eList <- runConduitRes $ Y.decode yamlBS .| CL.consume
      bs <- runConduitRes $ CL.sourceList eList .| Y.encode
      eList2 <- runConduitRes $ Y.decode bs .| CL.consume
      map MyEvent eList @=? map MyEvent eList2
    where
      yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
      yamlBS = B8.pack yamlString
  
  caseEncodeDecodeEvents :: Assertion
  caseEncodeDecodeEvents = do
      let events = Internal.objToEvents D.defaultStringStyle testJSON []
      result <- Internal.decodeHelper_ . CL.sourceList $ eventStream events
      let (_, value) = either (error . show) id result
      value @?= testJSON
  
  caseEncodeDecodeFile :: Assertion
  caseEncodeDecodeFile = withFile "" $ \tmpPath -> do
      eList <- runConduitRes $ Y.decodeFile filePath .| CL.consume
      runConduitRes $ CL.sourceList eList .| Y.encodeFile tmpPath
      eList2 <- runConduitRes $ Y.decodeFile filePath .| CL.consume
      map MyEvent eList @=? map MyEvent eList2
    where
      filePath = "test/largest-string.yaml"
  
  caseInterleave :: Assertion
  caseInterleave = withFile "" $ \tmpPath -> withFile "" $ \tmpPath2 -> do
      () <- runConduitRes $ Y.decodeFile filePath .| Y.encodeFile tmpPath
      () <- runConduitRes $ Y.decodeFile tmpPath .| Y.encodeFile tmpPath2
      f1 <- readFile tmpPath
      f2 <- readFile tmpPath2
      f1 @=? f2
    where
      filePath = "test/largest-string.yaml"
  
  caseDecodeInvalidDocument :: Assertion
  caseDecodeInvalidDocument = do
      x <- try $ runConduitRes $ Y.decode yamlBS .| CL.sinkNull
      case x of
          Left (_ :: SomeException) -> return ()
          Right y -> do
              putStrLn $ "bad return value: " ++ show y
              assertFailure "expected parsing exception, but got no errors"
    where
      yamlString = "  - foo\n  - baz\nbuz"
      yamlBS = B8.pack yamlString
  
  mkScalar :: String -> D.Value
  mkScalar = mkStrScalar
  
  mkStrScalar :: String -> D.Value
  mkStrScalar = D.String . T.pack
  
  mappingKey :: D.Value-> String -> D.Value
  mappingKey (D.Object m) k = (fromJust . M.lookup (fromText $ T.pack k) $ m)
  mappingKey _ _ = error "expected Object"
  
  sample :: D.Value
  sample = array
      [ D.String "foo"
      , object
          [ ("bar1", D.String "bar2")
          , ("bar3", D.String "")
          ]
      , D.String ""
      , D.Number 1
      , D.Number 0.1
      , D.Bool True
      , D.Null
      ]
  
  sampleBuilder :: B.YamlBuilder
  sampleBuilder = B.array
      [ B.string "foo"
      , B.mapping
          [ ("bar1", B.string "bar2")
          , ("bar3", B.string "")
          ]
      , B.string ""
      , B.scientific 1
      , B.scientific 0.1
      , B.bool True
      , B.null
      ]
  
  caseEncodeDecodeData :: Assertion
  caseEncodeDecodeData = D.encode sample `shouldDecode` sample
  
  caseEncodeDecodeDataPretty :: Assertion
  caseEncodeDecodeDataPretty =
      Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample
  
  caseEncodeDecodeDataBuilder :: Assertion
  caseEncodeDecodeDataBuilder = do
      let events = B.unYamlBuilder sampleBuilder []
      bs <- testEncodeWith Y.defaultFormatOptions events
      bs `shouldDecodeEvents` eventStream events
  
  caseEncodeDecodeComplexMappingBuilder :: Assertion
  caseEncodeDecodeComplexMappingBuilder = do
      let events = B.unYamlBuilder builder []
      bs <- testEncodeWith Y.defaultFormatOptions events
      bs `shouldDecodeEvents` eventStream events
    where
      builder :: B.YamlBuilder
      builder = B.mappingComplex
          [ ( B.mapping
                [ ("foo", B.scientific 1)
                , ("bar", B.scientific 2)
                ]
            , B.bool True
            )
          ]
  
  caseEncodeDecodeFileData :: Assertion
  caseEncodeDecodeFileData = withFile "" $ \fp -> do
      D.encodeFile fp sample
      out <- D.decodeFileThrow fp
      out @?= sample
  
  caseEncodeDecodeNonAsciiFileData :: Assertion
  caseEncodeDecodeNonAsciiFileData = do
    let mySample = (object ["foo" .= True])
    inTempDirectory $ do
      createDirectory "accenté"
      D.encodeFile "accenté/bar.yaml" mySample
      out1 <- D.decodeFileThrow "accenté/bar.yaml"
      out1 @?= mySample
  
    c <- readFile "test/resources/accent/foo.yaml"
    inTempDirectory $ do
      createDirectoryIfMissing True "test/resources/unicode/accenté/"
      writeFile "test/resources/unicode/accenté/foo.yaml" c
      out2 <- D.decodeFileThrow "test/resources/unicode/accenté/foo.yaml"
      out2 @?= mySample
  
  caseEncodeDecodeStrings :: Assertion
  caseEncodeDecodeStrings = D.encode sample `shouldDecode` sample
  
  caseEncodeDecodeStringsPretty :: Assertion
  caseEncodeDecodeStringsPretty =
      Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample
  
  caseDecodeInvalid :: Assertion
  caseDecodeInvalid =
      D.decodeThrow "\tthis is 'not' valid :-)" `shouldBe`
      (Nothing :: Maybe D.Value)
  
  caseSimpleScalarAlias :: Assertion
  caseSimpleScalarAlias =
      "- &anch foo\n- baz\n- *anch" `shouldDecode`
      array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]
  
  caseSimpleSequenceAlias :: Assertion
  caseSimpleSequenceAlias =
      "seq: &anch\n  - foo\n  - baz\nseq2: *anch" `shouldDecode`
      object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]
  
  caseSimpleMappingAlias :: Assertion
  caseSimpleMappingAlias =
      "map: &anch\n  key1: foo\n  key2: baz\nmap2: *anch" `shouldDecode`
      object [(packStr "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (packStr "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]
    where
      packStr = fromText . T.pack
  
  caseMappingAliasBeforeAnchor :: Assertion
  caseMappingAliasBeforeAnchor =
      case D.decodeThrow "map: *anch\nmap2: &anch\n  key1: foo\n  key2: baz" of
        Nothing -> pure ()
        Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias"
  
  caseMappingAliasInsideAnchor :: Assertion
  caseMappingAliasInsideAnchor = do
      case D.decodeThrow "map: &anch\n  key1: foo\n  key2: *anch" of
        Nothing -> pure ()
        Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias"
  
  caseScalarAliasOverriding :: Assertion
  caseScalarAliasOverriding =
      "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch" `shouldDecode`
      array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]
  
  caseAllKeysShouldBeUnique :: Assertion
  caseAllKeysShouldBeUnique = do
      res <- D.decodeThrow "foo1: foo\nfoo2: baz\nfoo1: buz"
      mappingKey res "foo1" `shouldBe` mkScalar "buz"
  
  caseSimpleMappingMerge :: Assertion
  caseSimpleMappingMerge = do
      res <- D.decodeThrow "foo1: foo\nfoo2: baz\n<<:\n  foo1: buz\n  foo3: fuz"
      mappingKey res "foo1" `shouldBe` mkScalar "foo"
      mappingKey res "foo3" `shouldBe` mkScalar "fuz"
  
  caseMergeSequence :: Assertion
  caseMergeSequence = do
      res <- D.decodeThrow "m1: &m1\n  k1: !!str 1\n  k2: !!str 2\nm2: &m2\n  k1: !!str 3\n  k3: !!str 4\nfoo1: foo\n<<: [ *m1, *m2 ]"
      mappingKey res "foo1" @?= (mkScalar "foo")
      mappingKey res "k1" @?= (D.String "1")
      mappingKey res "k2" @?= (D.String "2")
      mappingKey res "k3" @?= (D.String "4")
  
  caseDataTypes :: Assertion
  caseDataTypes =
      D.encode val `shouldDecode` val
    where
      val = object
          [ ("string", D.String "foo")
          , ("int", D.Number 5)
          , ("float", D.Number 4.3)
          , ("true", D.Bool True)
          , ("false", D.Bool False)
          , ("null", D.Null)
          ]
  
  caseEncodeInvalidNumbers :: Assertion
  caseEncodeInvalidNumbers =
      D.encode (D.String ".") `shouldBe` ".\n"
  
  caseDataTypesPretty :: Assertion
  caseDataTypesPretty =
      Pretty.encodePretty Pretty.defConfig val `shouldDecode` val
    where
      val = object
          [ ("string", D.String "foo")
          , ("int", D.Number 5)
          , ("float", D.Number 4.3)
          , ("true", D.Bool True)
          , ("false", D.Bool False)
          , ("null", D.Null)
          ]
  caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion
  caseQuotedNumber = "foo: \"1234\"" `shouldDecode` object [("foo", D.String "1234")]
  caseUnquotedNumber = "foo: 1234" `shouldDecode` object [("foo", D.Number 1234)]
  caseAttribNumber = "foo: !!str 1234" `shouldDecode` object [("foo", D.String "1234")]
  caseIntegerDecimals = "1\n" `shouldDecode` (1 :: Int)
  
  obj :: D.Value
  obj = object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)]
  
  caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion
  caseLowercaseBool = "foo: off\nbar: y\nbaz: true" `shouldDecode` obj
  caseUppercaseBool = "foo: FALSE\nbar: Y\nbaz: ON" `shouldDecode` obj
  caseTitlecaseBool = "foo: No\nbar: Yes\nbaz: True" `shouldDecode` obj
  
  caseEmptyInput :: Assertion
  caseEmptyInput = B8.empty `shouldDecode` D.Null
  
  caseEmptyInputFile :: Assertion
  caseEmptyInputFile = do
      out <- D.decodeFileEither "test/resources/empty.yaml"
      either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
  
  caseCommentOnlyInput :: Assertion
  caseCommentOnlyInput = "# comment\n" `shouldDecode` D.Null
  
  caseCommentOnlyInputFile :: Assertion
  caseCommentOnlyInputFile = do
      out <- D.decodeFileEither "test/resources/empty2.yaml"
      either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
  
  checkNull :: T.Text -> Spec
  checkNull x =
      it ("null recognized: " ++ show x) $
        B8.pack ("foo: " ++ T.unpack x) `shouldDecode` object [("foo", D.Null)]
  
  caseStripAlias :: Assertion
  caseStripAlias =
      src `shouldDecode` object
          [ "Default" .= object
              [ "foo" .= (1 :: Int)
              , "bar" .= (2 :: Int)
              ]
          , "Obj" .= object
              [ "foo" .= (1 :: Int)
              , "bar" .= (2 :: Int)
              , "key" .= (3 :: Int)
              ]
          ]
    where
      src = "Default: &def\n  foo: 1\n  bar: 2\nObj:\n  <<: *def\n  key: 3\n"
  
  caseIssue49 :: Assertion
  caseIssue49 =
      src `shouldDecode` object
          [ "a" .= object [ "value" .= (1.0 :: Double) ]
          , "b" .= object [ "value" .= (1.2 :: Double) ]
          ]
    where
      src = "---\na:\n  &id5 value: 1.0\nb:\n  *id5: 1.2"
  
  -- | We cannot guarantee this before aeson started using 'Scientific'.
  casePreservesScientificPrecision :: Assertion
  casePreservesScientificPrecision = do
      "x: 1e-100000" `shouldDecode` object
          [ "x" .= D.Number (read "1e-100000") ]
      -- Note that this ought to work also without 'Scientific', given
      -- that @read (show "9.78159610558926e-5") == 9.78159610558926e-5@.
      -- However, it didn't work (and still doesn't work with aeson < 0.7)
      -- for two reasons:
      --
      -- - We use 'Data.Text.Read.double', which is not as accurate as it
      -- can be;
      -- - Even if we used 'Data.Text.Read.rational' we would not get good
      -- results, because of <https://github.com/bos/text/issues/34>.
      "x: 9.78159610558926e-5" `shouldDecode` object
          [ "x" .= D.Number (read "9.78159610558926e-5") ]
  
  caseTruncatesFiles :: Assertion
  caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do
      replicateM_ 500 $ B8.hPut h "HELLO WORLD!!!!!\n"
      hClose h
      let val = object ["hello" .= ("world" :: String)]
      D.encodeFile fp val
      res <- D.decodeFileEither fp
      either (Left . show) Right res `shouldBe` Right val
  
  caseSpecialKeys :: (KeyMap () -> B8.ByteString) -> Assertion
  caseSpecialKeys encoder = do
        let keys = T.words "true false NO YES 1.2 1e5 null"
            bs = encoder $ M.fromList $ map (, ()) $ fmap fromText keys
            text = decodeUtf8 bs
        forM_ keys $ \key -> do
          let quoted = T.concat ["'", key, "'"]
          unless (quoted `T.isInfixOf` text) $ error $ concat
            [ "Could not find quoted key: "
            , T.unpack quoted
            , "\n\n"
            , T.unpack text
            ] :: IO ()
  
  taggedSequence :: [Y.Event]
  taggedSequence =
    [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing
    , Y.EventSequenceEnd
    ]
  
  taggedMapping :: [Y.Event]
  taggedMapping =
    [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
    , Y.EventMappingEnd
    ]
  
  defaultTaggedSequence :: [Y.Event]
  defaultTaggedSequence =
    [Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
  
  defaultTaggedMapping :: [Y.Event]
  defaultTaggedMapping =
    [Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing, Y.EventMappingEnd]
  
  untaggedSequence :: [Y.Event]
  untaggedSequence =
    [Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
  
  untaggedMapping :: [Y.Event]
  untaggedMapping =
    [Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing, Y.EventMappingEnd]
  
  mixedTagSampleA :: [Y.Event]
  mixedTagSampleA =
    [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing
    , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
    , Y.EventMappingEnd
    , Y.EventSequenceEnd
    ]
  
  mixedTagSampleB :: [Y.Event]
  mixedTagSampleB =
    [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a")
    , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b")
    , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c")
    , Y.EventScalar "" Y.NullTag Y.Plain (Just "d")
    , Y.EventSequenceEnd
    , Y.EventMappingEnd
    ]
  