diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,15 +1,22 @@ -### 0.1.1.3 +See also http://pvp.haskell.org/faq +### 0.1.2.0 + +* Add convenience functions `decode1` and `decode1Strict` expecting exactly one YAML document ([#5](https://github.com/haskell-hvr/HsYAML/pull/5)) +* Fix a couple corner-cases in the YAML tokenization ([#10](https://github.com/haskell-hvr/HsYAML/pull/10)) + +#### 0.1.1.3 + * Fix bug in float regexp being too lax in the JSON and Core schema ([#7](https://github.com/hvr/HsYAML/issues/7)) * Remove dependency on `dlist` -### 0.1.1.2 +#### 0.1.1.2 * Tolerate BOM at *each* `l-document-prefix` (rather than only at the first one encountered in a YAML stream) * Workaround broken `mtl-2.2.2` bundled in GHC 8.4.1 ([#1](https://github.com/hvr/HsYAML/issues/1)) * Relax to GPL-2.0-or-later -### 0.1.1.1 +#### 0.1.1.1 * Reject (illegal) non-scalar code-points in UTF-32 streams * Tolerate BOM at start of stream diff --git a/HsYAML.cabal b/HsYAML.cabal --- a/HsYAML.cabal +++ b/HsYAML.cabal @@ -1,6 +1,7 @@ cabal-version: 1.14 +build-type: Simple name: HsYAML -version: 0.1.1.3 +version: 0.1.2.0 synopsis: Pure Haskell YAML 1.2 parser homepage: https://github.com/hvr/HsYAML @@ -13,8 +14,7 @@ copyright: 2015-2018 Herbert Valerio Riedel , 2007-2008 Oren Ben-Kiki category: Text -build-type: Simple -tested-with: GHC==8.6.1, GHC==8.4.3, GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 +tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 description: @HsYAML@ is a [YAML 1.2](http://yaml.org/spec/1.2/spec.html) parser implementation for Haskell. diff --git a/src/Data/YAML.hs b/src/Data/YAML.hs --- a/src/Data/YAML.hs +++ b/src/Data/YAML.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} -- | -- Copyright: © Herbert Valerio Riedel 2015-2018 @@ -54,7 +55,9 @@ ( -- * Typeclass-based resolving/decoding decode + , decode1 , decodeStrict + , decode1Strict , FromYAML(..) , Parser , parseEither @@ -97,6 +100,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BS.L import qualified Data.Map as Map +import Data.Maybe (listToMaybe) import qualified Data.Text as T import Data.YAML.Event (Tag, isUntagged, tagToText) @@ -211,7 +215,9 @@ return = pure P m >>= k = P (m >>= unP . k) (>>) = (*>) +#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail +#endif -- | @since 0.1.1.0 instance Fail.MonadFail Parser where @@ -448,8 +454,36 @@ decode :: FromYAML v => BS.L.ByteString -> Either String [v] decode bs0 = decodeNode bs0 >>= mapM (parseEither . parseYAML . (\(Doc x) -> x)) +-- | Convenience wrapper over 'decode' expecting exactly one YAML document +-- +-- >>> decode1 "---\nBar\n..." :: Either String Text +-- Right "Bar" +-- +-- >>> decode1 "Foo\n---\nBar" :: Either String Text +-- Left "unexpected multiple YAML documents" +-- +-- >>> decode1 "# Just a comment" :: Either String Text +-- Left "empty YAML stream" +-- +-- @since 0.1.2.0 +decode1 :: FromYAML v => BS.L.ByteString -> Either String v +decode1 text = do + vs <- decode text + case vs of + [] -> Left "empty YAML stream" + [v] -> Right v + _ -> Left "unexpected multiple YAML documents" + -- | Like 'decode' but takes a strict 'BS.ByteString' -- -- @since 0.1.1.0 decodeStrict :: FromYAML v => BS.ByteString -> Either String [v] decodeStrict = decode . BS.L.fromChunks . (:[]) + +-- | Like 'decode1' but takes a strict 'BS.ByteString' +-- +-- @since 0.1.2.0 +decode1Strict :: FromYAML v => BS.ByteString -> Either String v +decode1Strict text = do + vs <- decodeStrict text + maybe (Left "expected unique") Right $ listToMaybe vs diff --git a/src/Data/YAML/Schema.hs b/src/Data/YAML/Schema.hs --- a/src/Data/YAML/Schema.hs +++ b/src/Data/YAML/Schema.hs @@ -133,7 +133,7 @@ | isUntagged t = Right tagSeq | otherwise = Right t --- | Core JSON schema resolver as specified +-- | Core schema resolver as specified -- in [YAML 1.2 / 10.3.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2805071) coreSchemaResolver :: SchemaResolver coreSchemaResolver = SchemaResolver{..} diff --git a/src/Data/YAML/Token.hs b/src/Data/YAML/Token.hs --- a/src/Data/YAML/Token.hs +++ b/src/Data/YAML/Token.hs @@ -442,8 +442,9 @@ (>>) = (*>) - -- @fail message@ does just that - fails with a /message/. - fail message = Parser $ \state -> failReply state message +-- | @fail message@ does just that - fails with a /message/. +pfail :: String -> Parser a +pfail message = Parser $ \state -> failReply state message -- ** Parsing operators -- @@ -491,7 +492,7 @@ -- | @parser <% n@ matches fewer than /n/ occurrences of /parser/. (<%) :: (Match match result) => match -> Int -> Pattern parser <% n - | n < 1 = fail "Fewer than 0 repetitions" + | n < 1 = pfail "Fewer than 0 repetitions" | n == 1 = reject parser Nothing | n > 1 = DeLess ^ ( ((parser ! DeLess) *> (parser <% n .- 1)) <|> empty ) @@ -577,7 +578,7 @@ -- | @first <|> second@ tries to parse /first/, and failing that parses -- /second/, unless /first/ has committed in which case is fails immediately. instance Alternative Parser where - empty = fail "empty" + empty = pfail "empty" left <|> right = Parser $ \state -> decideParser state D.empty left right state where @@ -897,7 +898,7 @@ in case reply^.rResult of Result _ -> reply More more -> reply { rResult = More $ prefixErrorWith more prefix } - Failed message -> reply { rResult = More $ prefix & (fail message :: Parser result) } + Failed message -> reply { rResult = More $ prefix & (pfail message :: Parser result) } -- * Production parameters @@ -1406,18 +1407,19 @@ -- 7.3.3 Plain Style ns_plain_first _c {- 126 -} = ns_char - c_indicator - / ( ':' / '?' / '-' ) & ( ns_char >?) + / ( ':' / '?' / '-' ) & ( (ns_plain_safe _c) >?) ns_plain_safe c {- 127 -} = case c of FlowOut -> ns_plain_safe_out FlowIn -> ns_plain_safe_in BlockKey -> ns_plain_safe_out FlowKey -> ns_plain_safe_in -ns_plain_safe_out {- 128 -} = ns_char - c_mapping_value - c_comment -ns_plain_safe_in {- 129 -} = ns_plain_safe_out - c_flow_indicator -ns_plain_char c {- 130 -} = ns_plain_safe c + +ns_plain_safe_out {- 128 -} = ns_char +ns_plain_safe_in {- 129 -} = ns_char - c_flow_indicator +ns_plain_char c {- 130 -} = ns_plain_safe c - ':' - '#' / ( ns_char ?) + / ':' & ( (ns_plain_safe c) >?) ns_plain n c {- 131 -} = wrapTokens BeginScalar EndScalar $ text (case c of @@ -1481,7 +1483,7 @@ c_ns_flow_map_empty_key_entry n c {- 146 -} = e_node & c_ns_flow_map_separate_value n c -c_ns_flow_map_separate_value n c {- 147 -} = c_mapping_value & ( ns_char >!) ! DePair +c_ns_flow_map_separate_value n c {- 147 -} = c_mapping_value & ( (ns_plain_safe c) >!) ! DePair & ( ( s_separate n c & ns_flow_node n c ) / e_node ) @@ -1667,8 +1669,8 @@ / ns_l_block_map_implicit_entry n c_l_block_map_explicit_entry n {- 189 -} = c_l_block_map_explicit_key n & ( l_block_map_explicit_value n - / e_node ) -c_l_block_map_explicit_key n {- 190 -} = c_mapping_key ! DeNode & s_l__block_indented n BlockOut + / e_node ) +c_l_block_map_explicit_key n {- 190 -} = c_mapping_key & ( ns_char >!) ! DeNode & s_l__block_indented n BlockOut l_block_map_explicit_value n {- 191 -} = s_indent n & c_mapping_value & s_l__block_indented n BlockOut ns_l_block_map_implicit_entry n {- 192 -} = ( ns_s_block_map_implicit_key