diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for z-yaml +## 0.3.3.0 -- 2021-04-25 + +* Remove `BIO` stuff from API. + ## 0.1.0.0 -- 2020-12-23 * First version. Released on an unsuspecting world. diff --git a/Z-YAML.cabal b/Z-YAML.cabal --- a/Z-YAML.cabal +++ b/Z-YAML.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: Z-YAML -version: 0.3.2.0 +version: 0.3.3.0 synopsis: YAML tools description: YAML reading & writing tools for Z project. license: BSD-3-Clause @@ -25,8 +25,8 @@ exposed-modules: Z.Data.YAML Z.Data.YAML.FFI build-depends: base == 4.* - , Z-Data >= 0.5 && < 1 - , Z-IO >= 0.5 && < 1 + , Z-Data >= 0.8 && < 0.9 + , Z-IO >= 0.8 && < 0.9 , primitive >= 0.5 && < 0.8 , scientific == 0.3.* , transformers == 0.5.* diff --git a/Z/Data/YAML.hs b/Z/Data/YAML.hs --- a/Z/Data/YAML.hs +++ b/Z/Data/YAML.hs @@ -14,11 +14,14 @@ * Does not support multiple doucments in one file. @ -{-# LANGUAGE DeriveGeneric, DeriveAnyClass, DerivingStrategies, TypeApplication #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE TypeApplications #-} import GHC.Generics -import qualified Z.Data.YAML as YAML -import qualified Z.Data.Text as T +import qualified Z.Data.Text as T +import qualified Z.Data.YAML as YAML data Person = Person { name :: T.Text @@ -42,8 +45,10 @@ , readYAMLFile , writeYAMLFile -- * Streaming parser and builder + , initParser, initFileParser , parseSingleDoucment , parseAllDocuments + , initEmitter, initFileEmitter , buildSingleDocument , buildValue -- * Errors @@ -115,7 +120,7 @@ -------------------------------------------------------------------------------- -- | Parse a single YAML document, throw 'OtherYAMLError' if multiple documents are met. -parseSingleDoucment :: HasCallStack => Source MarkedEvent -> IO Value +parseSingleDoucment :: HasCallStack => IO (Maybe MarkedEvent) -> IO Value parseSingleDoucment src = do docs <- parseAllDocuments src case docs of @@ -124,9 +129,9 @@ _ -> throwIO (OtherYAMLError "multiple YAML documents") -- | Parse all YAML documents. -parseAllDocuments :: HasCallStack => Source MarkedEvent -> IO [Value] +parseAllDocuments :: HasCallStack => IO (Maybe MarkedEvent) -> IO [Value] parseAllDocuments src = do - me <- pull src + me <- src case me of Just (MarkedEvent EventStreamStart _ _) -> do as <- newIORef HM.empty @@ -149,13 +154,13 @@ me'' -> throwParserIO (UnexpectedEvent me'') -type ParserIO = ReaderT (Source MarkedEvent, IORef (HM.HashMap T.Text Value)) IO +type ParserIO = ReaderT (IO (Maybe MarkedEvent), IORef (HM.HashMap T.Text Value)) IO pullEvent :: ParserIO MarkedEvent pullEvent = do (src, _) <- ask liftIO $ do - me <- pull src + me <- src case me of Just e -> return e _ -> throwIO UnexpectedEventEnd @@ -271,30 +276,30 @@ -- | Write a value as a YAML document stream. -- -buildSingleDocument :: HasCallStack => Sink Event -> Value -> IO () +buildSingleDocument :: HasCallStack => (Event -> IO ()) -> Value -> IO () buildSingleDocument sink v = do - push sink EventStreamStart - push sink EventDocumentStart + sink EventStreamStart + sink EventDocumentStart buildValue sink v - push sink EventDocumentEnd - void $ push sink EventStreamEnd + sink EventDocumentEnd + void $ sink EventStreamEnd -- | Write a value as a stream of 'Event's(without document start\/end, stream start\/end). -- -buildValue :: HasCallStack => Sink Event -> Value -> IO () +buildValue :: HasCallStack => (Event -> IO ()) -> Value -> IO () buildValue sink (Array vs) = do - push sink (EventSequenceStart "" NoTag AnySequence) + sink (EventSequenceStart "" NoTag AnySequence) mapM_ (buildValue sink) (V.unpack vs) - void $ push sink EventSequenceEnd + void $ sink EventSequenceEnd buildValue sink (Object o) = do - push sink (EventMappingStart "" NoTag AnyMapping) + sink (EventMappingStart "" NoTag AnyMapping) mapM_ encodeKV (V.unpack o) - void $ push sink EventMappingEnd + void $ sink EventMappingEnd where encodeKV (k, v) = buildValue sink (String k) >> buildValue sink v -buildValue sink (String s) = void $ push sink (EventScalar "" s NoTag (stringStyle s)) +buildValue sink (String s) = void $ sink (EventScalar "" s NoTag (stringStyle s)) where stringStyle s | (_, Just _) <- (== '\n') `T.find` s = Literal @@ -306,13 +311,13 @@ "y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~ *" isNumeric = either (const False) (const True) . textToScientific -buildValue sink Null = void $ push sink (EventScalar "" "null" NullTag PlainNoTag) -buildValue sink (Bool True) = void $ push sink (EventScalar "" "true" BoolTag PlainNoTag) -buildValue sink (Bool False) = void $ push sink (EventScalar "" "false" BoolTag PlainNoTag) +buildValue sink Null = void $ sink (EventScalar "" "null" NullTag PlainNoTag) +buildValue sink (Bool True) = void $ sink (EventScalar "" "true" BoolTag PlainNoTag) +buildValue sink (Bool False) = void $ sink (EventScalar "" "false" BoolTag PlainNoTag) buildValue sink (Number s) = do let builder -- Special case the 0 exponent to remove the trailing .0 | Sci.base10Exponent s == 0 = B.integer $ Sci.coefficient s | otherwise = B.scientific s t = B.unsafeBuildText builder - void $ push sink (EventScalar "" t IntTag PlainNoTag) + void $ sink (EventScalar "" t IntTag PlainNoTag) diff --git a/Z/Data/YAML/FFI.hsc b/Z/Data/YAML/FFI.hsc --- a/Z/Data/YAML/FFI.hsc +++ b/Z/Data/YAML/FFI.hsc @@ -222,16 +222,16 @@ -- | Create a source that yields marked events from a piece of YAML bytes. -- -initParser :: V.Bytes -> Resource (Source MarkedEvent) +initParser :: V.Bytes -> Resource (IO (Maybe MarkedEvent)) initParser bs - | V.null bs = return BIO{ pull = return Nothing } + | V.null bs = return (return Nothing) | otherwise = do (pparser, bs', bio) <- initResource (do pparser <- throwOOMIfNull hs_init_yaml_parser bs' <- pinPrimVector bs withPrimVectorSafe bs' $ \ bptr blen -> do yaml_parser_set_input_string pparser bptr (fromIntegral blen) - return (pparser, bs', BIO{ pull = peekParserEvent pparser })) + return (pparser, bs', peekParserEvent pparser)) (\ (pparser, bs', _) -> do hs_free_yaml_parser pparser touch bs') @@ -239,7 +239,7 @@ -- | Create a source that yields marked events from a piece of YAML bytes. -- -initFileParser :: HasCallStack => CB.CBytes -> Resource (Source MarkedEvent) +initFileParser :: HasCallStack => CB.CBytes -> Resource (IO (Maybe MarkedEvent)) initFileParser p = do (pparser, file, bio) <- initResource (do pparser <- throwOOMIfNull hs_init_yaml_parser @@ -247,7 +247,7 @@ fd <- FS.getFileFD f file <- CB.withCBytesUnsafe "r" (fdopen fd) yaml_parser_set_input_file pparser file - return (pparser, file, BIO{ pull = peekParserEvent pparser })) + return (pparser, file, peekParserEvent pparser)) (\ (pparser, file, _) -> do hs_free_yaml_parser pparser fclose file) @@ -408,23 +408,20 @@ -- | 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, (Event -> IO ())) initEmitter fopts@YAMLFormatOpts{..} = do p <- initResource (do let canonical = if yamlFormatCanonical then 1 else 0 throwOOMIfNull (hs_init_yaml_emitter canonical (fromIntegral yamlFormatIndent) (fromIntegral yamlFormatWidth))) hs_free_yaml_emitter - return (p, BIO { - push = \ e -> emitEvent p fopts e >> return Nothing - , pull = return Nothing - }) + return (p, \ e -> emitEvent p fopts e) -- | Make a new YAML event sink, whose result are written to a file. -- -- 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 (Event -> IO ()) 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_FILE_MODE @@ -437,10 +434,7 @@ (\ (pemitter, file) -> do hs_free_yaml_emitter_file pemitter fclose file) - return BIO { - push = \ e -> emitEvent pemitter fopts e >> return Nothing - , pull = return Nothing - } + return (\ e -> emitEvent pemitter fopts e) -- | Fetch YAML emitter's building buffer. --