machines-attoparsec (empty) → 0
raw patch · 7 files changed
+302/−0 lines, 7 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, machines, machines-attoparsec, tasty, tasty-hunit, text
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- machines-attoparsec.cabal +45/−0
- src/Data/Machine/Attoparsec/ByteString.hs +59/−0
- src/Data/Machine/Attoparsec/Text.hs +59/−0
- tests/Tests.hs +102/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for machines-attoparsec++## 0 -- 2019-01-31++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, davean++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of davean nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ machines-attoparsec.cabal view
@@ -0,0 +1,45 @@+cabal-version: 2.2++name: machines-attoparsec+version: 0+synopsis: Parse machines streams with attoparsec parsers.+description: Cnvert streams of Text and ByteStrings to datatypes via attoparsec parsers.+homepage: https://oss.xkcd.com+license: BSD-3-Clause+license-file: LICENSE+author: davean+maintainer: oss@xkcd.com+copyright: Copyright (C) 2019 davean+category: Control, Enumerator, Data, Text, Parsing+extra-source-files: CHANGELOG.md++source-repository head+ type: git+ location: https://code.xkrd.net/haskell/machines-attoparsec.git++common deps+ build-depends:+ attoparsec ^>= 0.13+ , base ^>=4.12.0.0+ , bytestring ^>= 0.10+ , machines ^>= 0.6+ , text ^>= 1.2++library+ import: deps+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ Data.Machine.Attoparsec.ByteString+ Data.Machine.Attoparsec.Text++test-suite machines-attoparsec-tests+ import: deps+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: tests+ main-is: Tests.hs+ build-depends:+ machines-attoparsec+ , tasty+ , tasty-hunit
+ src/Data/Machine/Attoparsec/ByteString.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Machine.Attoparsec.ByteString+ ( parse+ , many+ ) where++import qualified Data.Attoparsec.ByteString as P+import qualified Data.Attoparsec.Internal.Types as PI+import qualified Data.ByteString as BS+import Data.Machine+import Data.Machine.Stack++{- | Parse one 'a' out of a ByteString stream, or an error when a parser fails.+ - The stack allows one to have a sequence of parsers that pick up where the last left off.+ -}+parse :: forall m a . Monad m => P.Parser a -> MachineT m (Stack BS.ByteString) (Either String a)+parse p = encased $ Await (\b -> if PI.nullChunk b+ then parse p+ else feed (P.parse p b)) Pop stopped+ where+ feed :: P.Result a -> MachineT m (Stack BS.ByteString) (Either String a)+ feed (P.Partial c) = encased $+ Await (\b -> if PI.nullChunk b+ then feed (P.Partial c)+ else feed (c b)) Pop (feed $ c mempty)+ feed (P.Done i r) = encased $+ Await (\() -> encased $ Yield (Right r) stopped) (Push i) stopped+ feed (P.Fail i _ e) = encased $+ Await (\() -> encased $ Yield (Left e) stopped) (Push i) stopped+ {-# INLINE feed #-}+{-# INLINE parse #-}++{- | Parse a continuous stream of 'a's out of a ByteStrings stream.+ -}+many :: forall m a. Monad m => P.Parser a -> MachineT m (Stack BS.ByteString) (Either String a)+many p = pp+ where+ pp = encased $ Await (\b -> if PI.nullChunk b+ then pp+ else (feed . P.parse p $ b)) Pop stopped+ {-# INLINE pp #-}+ feed :: P.Result a -> MachineT m (Stack BS.ByteString) (Either String a)+ feed (P.Partial c) = encased $+ Await (\b -> if PI.nullChunk b+ then feed (P.Partial c)+ else feed (c b)) Pop (finish $ c mempty)+ feed (P.Done i r) = encased $+ Await (\() -> encased $ Yield (Right r) pp) (Push i) stopped+ feed (P.Fail i _ e) = encased $+ Await (\() -> encased $ Yield (Left e) pp) (Push i) stopped+ {-# INLINE feed #-}+ finish (P.Partial _) = stopped+ finish (P.Done i r) = encased $+ Await (\() -> encased $ Yield (Right r) stopped) (Push i) stopped+ finish (P.Fail i _ e) = encased $+ Await (\() -> encased $ Yield (Left e) stopped) (Push i) stopped+ {-# INLINE finish #-}+{-# INLINE many #-}
+ src/Data/Machine/Attoparsec/Text.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Machine.Attoparsec.Text+ ( parse+ , many+ ) where++import qualified Data.Attoparsec.Text as P+import qualified Data.Attoparsec.Internal.Types as PI+import qualified Data.Text as T+import Data.Machine+import Data.Machine.Stack++{- | Parse one 'a' out of a stream of Text, or an error when a parser fails.+ - The stack allows one to have a sequence of parsers that pick up where the last left off.+ -}+parse :: forall m a . Monad m => P.Parser a -> MachineT m (Stack T.Text) (Either String a)+parse p = encased $ Await (\b -> if PI.nullChunk b+ then parse p+ else feed (P.parse p b)) Pop stopped+ where+ feed :: P.Result a -> MachineT m (Stack T.Text) (Either String a)+ feed (P.Partial c) = encased $+ Await (\b -> if PI.nullChunk b+ then feed (P.Partial c)+ else feed (c b)) Pop (feed $ c mempty)+ feed (P.Done i r) = encased $+ Await (\() -> encased $ Yield (Right r) stopped) (Push i) stopped+ feed (P.Fail i _ e) = encased $+ Await (\() -> encased $ Yield (Left e) stopped) (Push i) stopped+ {-# INLINE feed #-}+{-# INLINE parse #-}++{- | Parse a continuous stream of 'a's out of a Text stream.+ -}+many :: forall m a. Monad m => P.Parser a -> MachineT m (Stack T.Text) (Either String a)+many p = pp+ where+ pp = encased $ Await (\b -> if PI.nullChunk b+ then pp+ else (feed . P.parse p $ b)) Pop stopped+ {-# INLINE pp #-}+ feed :: P.Result a -> MachineT m (Stack T.Text) (Either String a)+ feed (P.Partial c) = encased $+ Await (\b -> if PI.nullChunk b+ then feed (P.Partial c)+ else feed (c b)) Pop (finish $ c mempty)+ feed (P.Done i r) = encased $+ Await (\() -> encased $ Yield (Right r) pp) (Push i) stopped+ feed (P.Fail i _ e) = encased $+ Await (\() -> encased $ Yield (Left e) pp) (Push i) stopped+ {-# INLINE feed #-}+ finish (P.Partial _) = stopped+ finish (P.Done i r) = encased $+ Await (\() -> encased $ Yield (Right r) stopped) (Push i) stopped+ finish (P.Fail i _ e) = encased $+ Await (\() -> encased $ Yield (Left e) stopped) (Push i) stopped+ {-# INLINE finish #-}+{-# INLINE many #-}
+ tests/Tests.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+import qualified Data.Attoparsec.ByteString as AB+import qualified Data.Attoparsec.Text as AT+import qualified Data.ByteString as BS+import Data.Char+import qualified Data.Machine.Attoparsec.ByteString as PB+import qualified Data.Machine.Attoparsec.Text as PT+import Data.Machine+import Data.Machine.Stack+import Test.Tasty+import Test.Tasty.HUnit+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Word++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [bsTests, tTests]++nl8 :: Word8+nl8 = fromIntegral (ord '\n')++parseLineT :: AT.Parser T.Text+parseLineT = AT.takeTill ((==) '\n') <* AT.char '\n'++parseLineBS :: AB.Parser BS.ByteString+parseLineBS = AB.takeTill ((==) nl8) <* AB.word8 nl8++testT :: T.Text+testT = "test"++testBS :: BS.ByteString+testBS = TE.encodeUtf8 testT++nlBS :: BS.ByteString+nlBS = TE.encodeUtf8 "\n"++bsTests :: TestTree+bsTests = testGroup "ByteString"+ [ testCase "parse nothing" $ do+ [] @=? (run $ source [] `stack` (PB.parse parseLineBS))+ , testCase "parse no nl" $ do+ [Left "not enough input"] @=? (run $ source [testBS] `stack` (PB.parse parseLineBS))+ , testCase "parse with nl" $ do+ [Right testBS] @=? (run $ source [testBS, nlBS] `stack` (PB.parse parseLineBS))+ , testCase "parse starting mempty" $ do+ [Right testBS] @=? (run $ source [mempty, testBS, nlBS] `stack` (PB.parse parseLineBS))+ , testCase "parse middle mempty" $ do+ [Right testBS] @=? (run $ source [testBS, mempty, nlBS] `stack` (PB.parse parseLineBS))+ , testCase "many nothing" $ do+ [] @=?+ (run $ source [] `stack` (PB.many parseLineBS))+ , testCase "many no nl" $ do+ [Left "not enough input"] @=?+ (run $ source [testBS] `stack` (PB.many parseLineBS))+ , testCase "many" $ do+ [Right testBS] @=?+ (run $ source [testBS, nlBS] `stack` (PB.many parseLineBS))+ , testCase "many multi-lines" $ do+ [Right testBS, Right testBS] @=?+ (run $ source [testBS, nlBS, testBS, nlBS] `stack` (PB.many parseLineBS))+ , testCase "many multi-lines start mempty" $ do+ [Right testBS, Right testBS] @=?+ (run $ source [mempty, testBS, nlBS, testBS, nlBS] `stack` (PB.many parseLineBS))+ , testCase "many multi-lines middle mempty" $ do+ [Right testBS, Right testBS] @=?+ (run $ source [testBS, mempty, nlBS, testBS, nlBS] `stack` (PB.many parseLineBS))+ ]++tTests :: TestTree+tTests = testGroup "Text"+ [ testCase "parse nothing" $ do+ [] @=? (run $ source [] `stack` (PT.parse parseLineT))+ , testCase "parse no nl" $ do+ [Left "not enough input"] @=? (run $ source [testT] `stack` (PT.parse parseLineT))+ , testCase "parse with nl" $ do+ [Right testT] @=? (run $ source [testT, "\n"] `stack` (PT.parse parseLineT))+ , testCase "parse starting mempty" $ do+ [Right testT] @=? (run $ source [mempty, testT, "\n"] `stack` (PT.parse parseLineT))+ , testCase "parse middle mempty" $ do+ [Right testT] @=? (run $ source [testT, mempty, "\n"] `stack` (PT.parse parseLineT))+ , testCase "many nothing" $ do+ [] @=?+ (run $ source [] `stack` (PT.many parseLineT))+ , testCase "many no nl" $ do+ [Left "not enough input"] @=?+ (run $ source [testT] `stack` (PT.many parseLineT))+ , testCase "many" $ do+ [Right testT] @=?+ (run $ source [testT, "\n"] `stack` (PT.many parseLineT))+ , testCase "many multi-lines" $ do+ [Right testT, Right testT] @=?+ (run $ source [testT, "\n", testT, "\n"] `stack` (PT.many parseLineT))+ , testCase "many multi-lines start mempty" $ do+ [Right testT, Right testT] @=?+ (run $ source [mempty, testT, "\n", testT, "\n"] `stack` (PT.many parseLineT))+ , testCase "many multi-lines middle mempty" $ do+ [Right testT, Right testT] @=?+ (run $ source [testT, mempty, "\n", testT, "\n"] `stack` (PT.many parseLineT))+ ]