Z-YAML 0.3.0.0 → 0.3.2.0

raw patch · 5 files changed

+197/−155 lines, 5 filesdep +Z-YAMLdep +hspecdep ~Z-Datadep ~Z-IOdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: Z-YAML, hspec

Dependency ranges changed: Z-Data, Z-IO, base

API changes (from Hackage documentation)

Files

• Z-YAML.cabal +83/−83
• Z/Data/YAML.hs +1/−1
• Z/Data/YAML/FFI.hsc +78/−71
• test/Spec.hs +31/−0
• test/datas/smoke.yaml +4/−0

@@ -1,87 +1,87 @@-cabal-version:              >=1.10-name:                       Z-YAML-version:                    0.3.0.0-synopsis:                   YAML tools-description:                YAML reading & writing tools for Z project.-license:                    BSD3-license-file:               LICENSE-author:                     Dong Han-maintainer:                 winterland1989@gmail.com-copyright:                  (c) Dong Han, 2020-category:                   Data-build-type:                 Simple-homepage:                   https://github.com/haskell-Z/z-yaml-bug-reports:                https://github.com/haskell-Z/z-yaml/issues+cabal-version:      2.2+name:               Z-YAML+version:            0.3.2.0+synopsis:           YAML tools+description:        YAML reading & writing tools for Z project.+license:            BSD-3-Clause+license-file:       LICENSE+copyright:          (c) Dong Han, 2020+author:             Dong Han+maintainer:         winterland1989@gmail.com+category:           Data+homepage:           https://github.com/ZHaskell/z-yaml+bug-reports:        https://github.com/ZHaskell/z-yaml/issues+build-type:         Simple+extra-source-files: CHANGELOG.md+                    third_party/libyaml/src/yaml_private.h+                    third_party/libyaml/include/yaml.h+                    test/datas/smoke.yaml -extra-source-files:         CHANGELOG.md-                            third_party/libyaml/src/yaml_private.h-                            third_party/libyaml/include/yaml.h+source-repository head+  type:     git+  location: git://github.com/ZHaskell/z-yaml.git  library-    exposed-modules:        Z.Data.YAML-                            Z.Data.YAML.FFI--    -- other-modules:-    -- other-extensions:-    build-depends:            base                  == 4.*-                            , unordered-containers  == 0.2.*-                            , scientific            == 0.3.*-                            , transformers          == 0.5.*-                            , primitive             >= 0.5 && < 0.8-                            , Z-Data                == 0.4.*-                            , Z-IO                  == 0.4.*---    include-dirs:           third_party/libyaml/src-                            third_party/libyaml/include-        -    c-sources:              cbits/hs_yaml.c-                            third_party/libyaml/src/api.c-                            third_party/libyaml/src/dumper.c-                            third_party/libyaml/src/emitter.c-                            third_party/libyaml/src/loader.c-                            third_party/libyaml/src/parser.c-                            third_party/libyaml/src/reader.c-                            third_party/libyaml/src/scanner.c-                            third_party/libyaml/src/writer.c+  exposed-modules:    Z.Data.YAML+                      Z.Data.YAML.FFI+  build-depends:      base                 == 4.*+                    , Z-Data               >= 0.5 && < 1+                    , Z-IO                 >= 0.5 && < 1+                    , primitive            >= 0.5 && < 0.8+                    , scientific           == 0.3.*+                    , transformers         == 0.5.*+                    , unordered-containers == 0.2.*+  default-language:   Haskell2010+  default-extensions: MultiParamTypeClasses+                      RankNTypes+                      ExistentialQuantification+                      ScopedTypeVariables+                      FlexibleContexts+                      FlexibleInstances+                      CPP+                      KindSignatures+                      BangPatterns+                      TemplateHaskell+                      GeneralizedNewtypeDeriving+                      MagicHash+                      TypeFamilies+                      StandaloneDeriving+                      UnliftedFFITypes+                      CApiFFI+                      TypeOperators+                      RecordWildCards+                      OverloadedStrings+                      UnboxedTuples+                      DeriveGeneric+                      DefaultSignatures+                      QuasiQuotes+                      ViewPatterns+                      TupleSections+                      MultiWayIf+                      ConstraintKinds+                      PolyKinds+                      DataKinds+                      BinaryLiterals+                      PatternSynonyms+                      PartialTypeSignatures+                      DeriveAnyClass+                      TypeApplications+                      TypeFamilyDependencies+                      DerivingStrategies+                      QuantifiedConstraints+  cc-options:         -DYAML_VERSION_STRING="0.2.5" -DYAML_VERSION_MAJOR=0+                      -DYAML_VERSION_MINOR=2 -DYAML_VERSION_PATCH=5+  c-sources:          cbits/hs_yaml.c, third_party/libyaml/src/api.c,+                      third_party/libyaml/src/dumper.c, third_party/libyaml/src/emitter.c,+                      third_party/libyaml/src/loader.c, third_party/libyaml/src/parser.c,+                      third_party/libyaml/src/reader.c, third_party/libyaml/src/scanner.c,+                      third_party/libyaml/src/writer.c+  include-dirs:       third_party/libyaml/src, third_party/libyaml/include -    cc-options:             -DYAML_VERSION_STRING="0.2.5" -DYAML_VERSION_MAJOR=0 -DYAML_VERSION_MINOR=2 -DYAML_VERSION_PATCH=5-    -- hs-source-dirs:-    default-language:    Haskell2010-    default-extensions:     BangPatterns-                            BinaryLiterals-                            CApiFFI-                            ConstraintKinds-                            CPP -                            DerivingStrategies-                            DeriveGeneric-                            DeriveAnyClass-                            DefaultSignatures-                            DataKinds-                            ExistentialQuantification-                            FlexibleContexts-                            FlexibleInstances-                            GeneralizedNewtypeDeriving -                            KindSignatures-                            MagicHash-                            MultiParamTypeClasses-                            MultiWayIf-                            PartialTypeSignatures-                            PatternSynonyms -                            PolyKinds-                            QuantifiedConstraints-                            QuasiQuotes-                            OverloadedStrings-                            RankNTypes-                            RecordWildCards-                            ScopedTypeVariables -                            StandaloneDeriving-                            TemplateHaskell-                            TypeApplications-                            TypeFamilyDependencies-                            TypeFamilies-                            TypeOperators-                            TupleSections-                            UnboxedTuples -                            UnliftedFFITypes -                            ViewPatterns+test-suite Z-YAML-Test+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  build-depends:    base, Z-Data, Z-YAML, hspec ^>= 2.7+  default-language: Haskell2010+  ghc-options:      -threaded

@@ -83,7 +83,7 @@  -- | Decode a 'JSON' instance from a YAML file. readYAMLFile :: forall a. (HasCallStack, JSON a) => CBytes -> IO a-readYAMLFile p = unwrap =<< withResource (initFileParser p) (\ src -> do+readYAMLFile p = unwrap "EPARSE" =<< withResource (initFileParser p) (\ src -> do     r <- try (parseSingleDoucment src)     case r of         Left (e :: YAMLError) -> return (Left (Left e))

@@ -34,23 +34,23 @@     , renderUriTags     -- * Constants     , ScalarStyle-    , pattern Any          -    , pattern Plain        -    , pattern SingleQuoted -    , pattern DoubleQuoted -    , pattern Literal      -    , pattern Folded       -    , pattern PlainNoTag   +    , pattern Any+    , pattern Plain+    , pattern SingleQuoted+    , pattern DoubleQuoted+    , pattern Literal+    , pattern Folded+    , pattern PlainNoTag     , SequenceStyle-    , pattern AnySequence  +    , pattern AnySequence     , pattern BlockSequence-    , pattern FlowSequence +    , pattern FlowSequence     , MappingStyle     , pattern AnyMapping     , pattern BlockMapping-    , pattern FlowMapping +    , pattern FlowMapping     , TagRender-    , pattern Explicit +    , pattern Explicit     , pattern Implicit     -- * Exception type     , YAMLError(..)@@ -76,7 +76,7 @@ import qualified Z.IO.FileSystem    as FS import qualified Z.Data.Vector      as V import qualified Z.Data.Text.Base   as T-import           Z.Data.Text.Print  (Print)+import qualified Z.Data.Text        as T import           Z.Data.JSON        (JSON)  #include "yaml.h"@@ -84,61 +84,61 @@ type Anchor = T.Text  data Event =-      EventStreamStart   -    | EventStreamEnd     -    | EventDocumentStart -    | EventDocumentEnd   +      EventStreamStart+    | EventStreamEnd+    | EventDocumentStart+    | EventDocumentEnd     | EventAlias          !Anchor-    | EventScalar         !Anchor !T.Text !Tag !ScalarStyle -    | EventSequenceStart  !Anchor !Tag !SequenceStyle -    | EventSequenceEnd   -    | EventMappingStart   !Anchor !Tag !MappingStyle -    | EventMappingEnd    +    | EventScalar         !Anchor !T.Text !Tag !ScalarStyle+    | EventSequenceStart  !Anchor !Tag !SequenceStyle+    | EventSequenceEnd+    | EventMappingStart   !Anchor !Tag !MappingStyle+    | EventMappingEnd     deriving (Show, Ord, Eq, Generic)-    deriving anyclass (Print, JSON)+    deriving anyclass (T.Print, JSON) -data MarkedEvent = MarkedEvent +data MarkedEvent = MarkedEvent     { markedEvent :: !Event     , startMark :: !Mark     , endMark :: !Mark     }     deriving (Show, Ord, Eq, Generic)-    deriving anyclass (Print, JSON)+    deriving anyclass (T.Print, JSON)  -- | The pointer position-data Mark = Mark +data Mark = Mark     { yamlIndex  :: {-# UNPACK #-} !Int     , yamlLine   :: {-# UNPACK #-} !Int-    , yamlColumn :: {-# UNPACK #-} !Int +    , yamlColumn :: {-# UNPACK #-} !Int     }     deriving (Show, Ord, Eq, Generic)-    deriving anyclass (Print, JSON)+    deriving anyclass (T.Print, JSON)  -- | Style for scalars - e.g. quoted / folded--- +-- type ScalarStyle = CInt pattern Any, Plain, SingleQuoted, DoubleQuoted, Literal, Folded, PlainNoTag :: ScalarStyle pattern Any           = 0-pattern Plain         = 1 -pattern SingleQuoted  = 2 -pattern DoubleQuoted  = 3 -pattern Literal       = 4 -pattern Folded        = 5 -pattern PlainNoTag    = 6 +pattern Plain         = 1+pattern SingleQuoted  = 2+pattern DoubleQuoted  = 3+pattern Literal       = 4+pattern Folded        = 5+pattern PlainNoTag    = 6  -- | Style for sequences - e.g. block or flow--- +-- type SequenceStyle = CInt pattern AnySequence, BlockSequence, FlowSequence :: SequenceStyle pattern AnySequence   = 0-pattern BlockSequence = 1 +pattern BlockSequence = 1 pattern FlowSequence  = 2  -- | Style for mappings - e.g. block or flow--- -type MappingStyle = CInt +--+type MappingStyle = CInt pattern AnyMapping, BlockMapping, FlowMapping :: MappingStyle-pattern AnyMapping   = 0 +pattern AnyMapping   = 0 pattern BlockMapping = 1 pattern FlowMapping  = 2 @@ -153,7 +153,7 @@          | UriTag T.Text          | NoTag     deriving (Show, Ord, Eq, Generic)-    deriving anyclass (Print, JSON)+    deriving anyclass (T.Print, JSON)  tagToCBytes :: Tag -> CB.CBytes tagToCBytes StrTag = "tag:yaml.org,2002:str"@@ -181,24 +181,31 @@  data YAMLError     = ParseEventException CB.CBytes CB.CBytes Mark     -- ^ problem, context, mark-    | ParseAliasEventWithEmptyAnchor Mark Mark +    | ParseAliasEventWithEmptyAnchor Mark Mark     | ParseYAMLError YAMLParseError                    -- ^ custom parse error-    | EmitEventException Event CInt -    | EmitAliasEventWithEmptyAnchor +    | EmitEventException Event CInt+    | EmitAliasEventWithEmptyAnchor     | OtherYAMLError T.Text-    deriving Show+  deriving (Eq, Generic)+  deriving anyclass T.Print +instance Show YAMLError where show = T.toString+ data YAMLParseError     = UnknownAlias MarkedEvent     | UnexpectedEvent MarkedEvent     | NonStringKey MarkedEvent     | NonStringKeyAlias MarkedEvent     | UnexpectedEventEnd-  deriving Show+  deriving (Eq, Generic)+  deriving anyclass T.Print +instance Show YAMLParseError where show = T.toString+ instance Exception YAMLError instance Exception YAMLParseError + -- | Throw custom YAML error. throwYAMLError :: YAMLParseError -> IO a throwYAMLError desc = throwIO (ParseYAMLError desc)@@ -216,10 +223,10 @@ -- | Create a source that yields marked events from a piece of YAML bytes. -- initParser :: V.Bytes -> Resource (Source MarkedEvent)-initParser bs +initParser bs     | V.null bs = return BIO{ pull = return Nothing }     | otherwise = do-        (pparser, bs', bio) <- initResource +        (pparser, bs', bio) <- initResource             (do pparser <- throwOOMIfNull hs_init_yaml_parser                 bs' <- pinPrimVector bs                 withPrimVectorSafe bs' $ \ bptr blen -> do@@ -234,9 +241,9 @@ -- initFileParser :: HasCallStack => CB.CBytes -> Resource (Source MarkedEvent) initFileParser p = do-    (pparser, file, bio) <- initResource +    (pparser, file, bio) <- initResource         (do pparser <- throwOOMIfNull hs_init_yaml_parser-            (f, _) <- acquire $ FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE+            (f, _) <- acquire $ FS.initFile p FS.O_RDONLY FS.DEFAULT_FILE_MODE             fd <- FS.getFileFD f             file <-   CB.withCBytesUnsafe "r" (fdopen fd)             yaml_parser_set_input_file pparser file@@ -266,8 +273,8 @@   where     readAnchor :: Int -> MBA## EventStruct -> IO Anchor     readAnchor off pe = do-        p <- peekMBA pe off -        if p == nullPtr +        p <- peekMBA pe off+        if p == nullPtr         then return T.empty         else T.Text <$> fromNullTerminated p @@ -276,8 +283,8 @@      readTag :: Int -> MBA## EventStruct -> IO Tag     readTag off pe = do-        p <- peekMBA pe off -        if p == nullPtr +        p <- peekMBA pe off+        if p == nullPtr         then return NoTag         else bytesToTag <$!> fromNullTerminated p @@ -285,12 +292,12 @@     peekEvent pe = do         et <- peekMBA pe (#offset yaml_event_t, type) -        si :: CUInt <- peekMBA pe (#offset yaml_event_t, start_mark.index) -        sl :: CUInt <- peekMBA pe (#offset yaml_event_t, start_mark.line) -        sc :: CUInt <- peekMBA pe (#offset yaml_event_t, start_mark.column) -        ei :: CUInt <- peekMBA pe (#offset yaml_event_t, end_mark.index) -        el :: CUInt <- peekMBA pe (#offset yaml_event_t, end_mark.line) -        ec :: CUInt <- peekMBA pe (#offset yaml_event_t, end_mark.column) +        si :: CUInt <- peekMBA pe (#offset yaml_event_t, start_mark.index)+        sl :: CUInt <- peekMBA pe (#offset yaml_event_t, start_mark.line)+        sc :: CUInt <- peekMBA pe (#offset yaml_event_t, start_mark.column)+        ei :: CUInt <- peekMBA pe (#offset yaml_event_t, end_mark.index)+        el :: CUInt <- peekMBA pe (#offset yaml_event_t, end_mark.line)+        ec :: CUInt <- peekMBA pe (#offset yaml_event_t, end_mark.column)         let startMark = Mark (fromIntegral si) (fromIntegral sl) (fromIntegral sc)             endMark = Mark (fromIntegral ei) (fromIntegral el) (fromIntegral ec)             returnMarked e = return (Just (MarkedEvent e startMark endMark))@@ -401,9 +408,9 @@  -- | Make a new YAML event sink, whose result can be fetched via 'getEmitterResult'. ---initEmitter :: YAMLFormatOpts -> Resource (Ptr EmitterStruct, Sink Event) +initEmitter :: YAMLFormatOpts -> Resource (Ptr EmitterStruct, Sink Event) initEmitter fopts@YAMLFormatOpts{..} = do-    p <- initResource +    p <- initResource         (do let canonical = if yamlFormatCanonical then 1 else 0             throwOOMIfNull (hs_init_yaml_emitter canonical                 (fromIntegral yamlFormatIndent) (fromIntegral yamlFormatWidth)))@@ -417,10 +424,10 @@ -- -- Note the file will be opened in @'FS.O_APPEND' .|. 'FS.O_CREAT' .|. 'FS.O_WRONLY'@ mode, -- bytes will be written after the end of the original file if there'are old bytes.-initFileEmitter :: HasCallStack => YAMLFormatOpts -> CB.CBytes -> Resource (Sink Event) +initFileEmitter :: HasCallStack => YAMLFormatOpts -> CB.CBytes -> Resource (Sink Event) initFileEmitter fopts@YAMLFormatOpts{..} p = do     (pemitter, file) <- initResource-        (do (f, _) <- acquire $ FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_MODE+        (do (f, _) <- acquire $ FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_FILE_MODE             fd <- FS.getFileFD f             file <- CB.withCBytesUnsafe "w" (fdopen fd)             let canonical = if yamlFormatCanonical then 1 else 0@@ -437,7 +444,7 @@  -- | Fetch YAML emitter's building buffer. ---getEmitterResult :: Ptr EmitterStruct -> IO T.Text +getEmitterResult :: Ptr EmitterStruct -> IO T.Text getEmitterResult pemitter = do     l <- hs_get_yaml_emitter_length pemitter     (bs,_) <- allocBytesUnsafe (fromIntegral l) $ \ p -> hs_copy_yaml_emitter_result pemitter p l@@ -452,9 +459,9 @@         EventStreamEnd     -> yaml_stream_end_event_initialize pe         EventDocumentStart -> hs_yaml_document_start pe         EventDocumentEnd   -> yaml_document_end_event_initialize pe 1-        EventScalar anchor t tag style0 -> -            withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ pvalue off len -> -                withAnchor anchor $ \ panchor -> +        EventScalar anchor t tag style0 ->+            withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ pvalue off len ->+                withAnchor anchor $ \ panchor ->                     withTag tag $ \ ptag -> do                         let pi0 = tagsImplicit e                             (pi, style) = case style0 of@@ -472,7 +479,7 @@                             style   -- style          EventSequenceStart anchor tag style ->-            withAnchor anchor $ \ panchor -> +            withAnchor anchor $ \ panchor ->                 withTag tag $ \ ptag ->                     hs_yaml_sequence_start_event_initialize                         pe@@ -485,7 +492,7 @@          EventMappingStart anchor tag style ->             withAnchor anchor $ \ panchor ->-                withTag tag $ \ ptag -> +                withTag tag $ \ ptag ->                     hs_yaml_mapping_start_event_initialize pe panchor ptag (tagsImplicit e) style          EventMappingEnd -> yaml_mapping_end_event_initialize pe@@ -495,7 +502,7 @@             then throwIO EmitAliasEventWithEmptyAnchor             else withAnchor anchor (yaml_alias_event_initialize pe) -    if (ret /= 1) +    if (ret /= 1)     then throwIO (EmitEventException e ret)     else do         ret' <- yaml_emitter_emit pemitter pe@@ -511,7 +518,7 @@     tagSuppressed _ = False      withTag tag = CB.withCBytesUnsafe (tagToCBytes tag)-    withAnchor anchor = CB.withCBytesUnsafe (CB.fromText anchor) +    withAnchor anchor = CB.withCBytesUnsafe (CB.fromText anchor)  -- | Whether a tag should be rendered explicitly in the output or left -- implicit.

@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}++module Main where++import           GHC.Generics (Generic)+import           Test.Hspec+import qualified Z.Data.Text  as T+import qualified Z.Data.YAML  as YAML+++main :: IO ()+main = hspec $ smokeSpec++data Person = Person+  { name :: T.Text+  , age  :: Int+  } deriving (Show, Generic, YAML.JSON)++smokeSpec :: Spec+smokeSpec = context "SmokeTest" $ do+  it "Z.Data.YAML.readYAMLFile" $ do+    persons <- YAML.readYAMLFile @[Person] "test/datas/smoke.yaml"+    let first = persons !! 0+    name first `shouldBe` "Alice"+    age  first `shouldBe` 16+    let second = persons !! 1+    name second `shouldBe` "Bob"+    age  second `shouldBe` 14

@@ -0,0 +1,4 @@+- name: Alice+  age: 16+- name: Bob+  age: 14