comparse 0.1.0.0 → 0.2.0.0

raw patch · 13 files changed

+275/−142 lines, 13 filesdep +textdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: text, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−5
• Control/Monad/Parser.hs +22/−2
• Control/Monad/Parser/Class.hs +40/−28
• Control/Monad/Trans/Parser.hs +4/−1
• Data/Stream.hs +0/−7
• Data/Stream/StringLines.hs +0/−14
• Data/Stream/TextLines.hs +58/−0
• README.md +50/−15
• comparse.cabal +8/−2
• test/Json.hs +44/−30
• test/Stream.hs +2/−1
• test/Stream/Generic.hs +10/−37
• test/Stream/TextLines.hs +22/−0

@@ -1,8 +1,18 @@ # Changelog for comparse -## Unreleased changes+## Unreleased -- `ParserT` monad transformer-- Basic combinators-- `Data.Stream.StringLines` to parse multi-line `String` input-- `Parser` and `StringParser` type aliases+## v0.2.0.0++- Added `Data.Stream.TextLines` to parse lines of `Text`+- Added Generic `ParserOf a p` constraint representing parsers over `Stream`s of+  `a`s+- Added `CharParser p` constraint alias for `ParserOf Char p`+- Removed unused functions from the `Stream` class++## v0.1.0.0++- Added `ParserT` monad transformer+- Added basic combinators+- Added `Data.Stream.StringLines` to parse multi-line `String` input+- Added `Parser` and `StringParser` type aliases

@@ -1,3 +1,7 @@+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+
 module Control.Monad.Parser
   ( module Control.Monad.Parser.Class,
     ParserT (..),
@@ -6,17 +10,28 @@     ErrorDesc (..),
     Parser,
     StringParser,
+    ParserOf,
+    CharParser,
     runParser,
     runStringParser,
+    runTextParser,
   )
 where
 
 import Control.Monad.Identity
 import Control.Monad.Parser.Class
 import Control.Monad.Trans.Parser
+import Data.Stream (Stream (Item))
 import Data.Stream.StringLines (StringLines)
-import qualified Data.Stream.StringLines as StringLines
+import qualified Data.Stream.StringLines as SL
+import Data.Stream.TextLines
+import qualified Data.Stream.TextLines as TL
+import Data.Text (Text)
 
+type ParserOf i p = (MonadParser p, Item (Input p) ~ i)
+
+type CharParser p = ParserOf Char p
+
 type Parser s a = ParserT s Identity a
 
 runParser :: Parser s a -> s -> ParseResult a s
@@ -25,4 +40,9 @@ type StringParser a = Parser StringLines a
 
 runStringParser :: StringParser a -> String -> ParseResult a StringLines
-runStringParser p s = runIdentity $ runParserT p $ StringLines.fromString s
+runStringParser p s = runIdentity $ runParserT p $ SL.fromString s
+
+type TextParser a = Parser TextLines a
+
+runTextParser :: TextParser a -> Text -> ParseResult a TextLines
+runTextParser p s = runIdentity $ runParserT p $ TL.fromText s

@@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Control.Monad.Parser.Class
   ( module Control.Monad.Parser.Class,
@@ -7,6 +7,7 @@ where
 
 import Control.Applicative ((<**>))
+import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Stream
@@ -16,18 +17,20 @@ infixl 1 <?>
 
 -- | A monad with parsing capabilities.
-class Monad m => MonadParser s m | m -> s where
+class (Monad m, Stream (Input m)) => MonadParser m where
+  type Input m :: Type
+
   -- | The current input stream.
-  parseStream :: m s
+  parseStream :: m (Input m)
 
   -- | Replace the input stream.
-  setParseStream :: s -> m ()
+  setParseStream :: Input m -> m ()
 
   -- | A parser that always fails.
   noParse :: m a
 
   -- | A parser that returns the next item.
-  item :: m (Item s)
+  item :: m (Item (Input m))
 
   -- | @followedBy p@ is a parser that succeeds if @p@ succeeds, but it does not
   -- consume any input.
@@ -50,15 +53,15 @@   (<?>) :: m a -> String -> m a
 
 -- | Parser that succeeds if the stream is empty. Does not consume any items.
-eof :: MonadParser s m => m ()
+eof :: MonadParser m => m ()
 eof = notFollowedBy item <?> "end of input"
 
 -- | Fail with an "expected" message.
-expected :: MonadParser s m => String -> m a
+expected :: MonadParser m => String -> m a
 expected s = noParse <?> s
 
 -- | Succeeds only if the value parsed by the parser satisfies the predicate.
-satisfy :: MonadParser s m => m a -> (a -> Bool) -> m a
+satisfy :: MonadParser m => m a -> (a -> Bool) -> m a
 satisfy p f = try $ do
   i <- p
   if f i
@@ -66,65 +69,74 @@     else noParse
 
 -- | Parse a single item satisfying the given predicate.
-match :: MonadParser s m => (Item s -> Bool) -> m (Item s)
+match :: MonadParser m => (Item (Input m) -> Bool) -> m (Item (Input m))
 match = satisfy item
 
 -- | Make a parser optional.
-optional :: MonadParser s m => m a -> m (Maybe a)
+optional :: MonadParser m => m a -> m (Maybe a)
 optional p = Just <$> p <|> pure Nothing
 
 -- | Try a series of parsers in order, returning the first one that succeeds.
-choice :: MonadParser s m => [m a] -> m a
+choice :: MonadParser m => [m a] -> m a
 choice = foldr (<|>) noParse
 
 -- | Try to run the given parser as many times as possible.
-many :: MonadParser s m => m a -> m [a]
+many :: MonadParser m => m a -> m [a]
 many p = ((:) <$> p <*> many p) <|> pure []
 
 -- | Try to run the given parser as many times as possible, but at least once.
 -- The result is returned as a regular list, but is guaranteed to be non-empty.
-many1 :: MonadParser s m => m a -> m [a]
+many1 :: MonadParser m => m a -> m [a]
 many1 p = (:) <$> p <*> many p
 
 -- | Try to run the given parser as many times as possible, but at least once.
-some :: MonadParser s m => m a -> m (NonEmpty a)
+some :: MonadParser m => m a -> m (NonEmpty a)
 some p = (:|) <$> p <*> many p
 
 -- | Parse a non-empty series of @a@ separated by @b@s (without a trailing @b@).
-sepBy1 :: MonadParser s m => m a -> m b -> m (NonEmpty a)
+sepBy1 :: MonadParser m => m a -> m b -> m (NonEmpty a)
 sepBy1 a b = (:|) <$> a <*> many (b *> a)
 
 -- | Parse a potentially empty series of @a@ separated by @b@s (without a
 -- trailing @b@).
-sepBy :: MonadParser s m => m a -> m b -> m [a]
+sepBy :: MonadParser m => m a -> m b -> m [a]
 sepBy a b = NonEmpty.toList <$> sepBy1 a b <|> pure []
 
 -- | Parse any value equal to @a@.
-like :: (MonadParser s m, Eq (Item s), Show (Item s)) => Item s -> m (Item s)
+like ::
+  (MonadParser m, Eq (Item (Input m)), Show (Item (Input m))) =>
+  Item (Input m) ->
+  m (Item (Input m))
 like a = item `satisfy` (== a) <?> show a
 
 -- | Parse any value not equal to @a@.
-unlike :: (MonadParser s m, Eq (Item s), Show (Item s)) => Item s -> m (Item s)
+unlike ::
+  (MonadParser m, Eq (Item (Input m)), Show (Item (Input m))) =>
+  Item (Input m) ->
+  m (Item (Input m))
 unlike a = item `satisfy` (/= a) <?> "anything but " ++ show a
 
 -- | Parse a continuous sequence of items equal to the given one.
 string ::
-  (MonadParser s m, Eq (Item s), Show (Item s)) =>
-  [Item s] ->
-  m [Item s]
+  (MonadParser m, Eq (Item (Input m)), Show (Item (Input m))) =>
+  [Item (Input m)] ->
+  m [Item (Input m)]
 string [] = return []
 string (x : xs) = like x >> string xs >> return (x : xs)
 
 -- | Parse any value equal to at least one element of the given list.
-oneOf :: (MonadParser s m, Eq (Item s), Show (Item s)) => [Item s] -> m (Item s)
+oneOf ::
+  (MonadParser m, Eq (Item (Input m)), Show (Item (Input m))) =>
+  [Item (Input m)] ->
+  m (Item (Input m))
 oneOf l = item `satisfy` (`elem` l) <?> "one of " ++ show l
 
 -- | Parse any value not equivalent to any element of the given list.
 -- For a version that accepts non-Show items, see @noneOf'@.
 noneOf ::
-  (MonadParser s m, Eq (Item s), Show (Item s)) =>
-  [Item s] ->
-  m (Item s)
+  (MonadParser m, Eq (Item (Input m)), Show (Item (Input m))) =>
+  [Item (Input m)] ->
+  m (Item (Input m))
 noneOf l = item `satisfy` (`notElem` l) <?> "none of " ++ show l
 
 -- | @chainl1 p op@ Parse a chain of *one* or more occurrences of @p@,
@@ -132,7 +144,7 @@ -- of all functions returned by @op@ to the values returned by @p@.
 --
 -- This is particularly useful for parsing left associative infix operators.
-chainl1 :: MonadParser s m => m a -> m (a -> a -> a) -> m a
+chainl1 :: MonadParser m => m a -> m (a -> a -> a) -> m a
 chainl1 p op = scan
   where
     scan = p <**> rst
@@ -143,14 +155,14 @@ -- of all functions returned by @op@ to the values returned by @p@.
 --
 -- This is particularly useful for parsing right associative infix operators.
-chainr1 :: MonadParser s m => m a -> m (a -> a -> a) -> m a
+chainr1 :: MonadParser m => m a -> m (a -> a -> a) -> m a
 chainr1 p op = scan
   where
     scan = p <**> rst
     rst = (flip <$> op <*> scan) <|> pure id
 
 -- | Run a parser on a different stream of items.
-withInput :: MonadParser s m => s -> m a -> m (a, s)
+withInput :: MonadParser m => Input m -> m a -> m (a, Input m)
 withInput s' p = do
   s <- parseStream
   setParseStream s'

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Control.Monad.Trans.Parser
@@ -90,7 +91,9 @@ instance (Applicative m, Monad m, Stream s) => MonadFail (ParserT s m) where
   fail msg = ParserT $ \s -> pure $ NoParse $ ParseError (getPos s) [Note msg]
 
-instance (Monad m, Stream s) => MonadParser s (ParserT s m) where
+instance (Monad m, Stream s) => MonadParser (ParserT s m) where
+  type Input (ParserT s m) = s
+
   parseStream = ParserT $ \s -> pure $ Parsed s s $ emptyError s
 
   setParseStream s = ParserT $ \_ -> pure $ Parsed () s $ emptyError s

@@ -6,19 +6,12 @@   )
 where
 
-import Data.Data (Proxy (..))
 import Data.Kind (Type)
 
 class Ord (Pos s) => Stream s where
   type Item s :: Type
-  type Chunk s :: Type
   type Pos s :: Type
 
   next :: s -> Maybe (Item s, s)
-  nextWhile :: (Item s -> Bool) -> s -> (Chunk s, s)
-  nextN :: Int -> s -> (Chunk s, s)
-
-  makeChunk :: Proxy s -> [Item s] -> Chunk s
-  unmakeChunk :: Proxy s -> Chunk s -> [Item s]
 
   getPos :: s -> Pos s

@@ -44,25 +44,11 @@ 
 instance Stream StringLines where
   type Item StringLines = Char
-  type Chunk StringLines = String
   type Pos StringLines = StringPos
 
   next (StringLines [] _) = Nothing
   next (StringLines ('\n' : xs) p) = Just ('\n', StringLines xs (nextl p xs))
   next (StringLines (x : xs) p) = Just (x, StringLines xs (adv p))
-
-  nextWhile f s = case next s of
-    Nothing -> ([], s)
-    Just (x, s') | f x -> (x : xs, s'') where (xs, s'') = nextWhile f s'
-    _ -> ([], s)
-
-  nextN 0 s = ([], s)
-  nextN n s = case next s of
-    Nothing -> ([], s)
-    Just (x, s') -> (x : xs, s'') where (xs, s'') = nextN (n - 1) s'
-
-  makeChunk _ = id
-  unmakeChunk _ = id
 
   getPos (StringLines _ p) = p
 

@@ -0,0 +1,58 @@+{-# LANGUAGE TypeFamilies #-}
+
+module Data.Stream.TextLines
+  ( TextPos (..),
+    TextLines (..),
+    fromText,
+  )
+where
+
+import Data.Stream (Stream (..))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Vector (Vector, (!?))
+import qualified Data.Vector as V
+
+data TextPos = TextPos Int Int (Vector Text)
+
+instance Show TextPos where
+  show (TextPos l c ls) =
+    let (lnum, cnum) = (show (l + 1), show (c + 1))
+        gut = replicate (length lnum) ' ' ++ " | "
+        ngut = lnum ++ " | "
+        line = maybe "" T.unpack $ ls !? l
+        snippet = gut ++ "\n" ++ ngut ++ line ++ "\n" ++ gut ++ cursor
+        cursor = replicate c ' ' ++ "^"
+     in lnum ++ ":" ++ cnum ++ ":\n" ++ snippet
+
+instance Eq TextPos where
+  (TextPos l1 c1 _) == (TextPos l2 c2 _) = l1 == l2 && c1 == c2
+
+instance Ord TextPos where
+  compare (TextPos l1 c1 _) (TextPos l2 c2 _) =
+    case compare l1 l2 of
+      EQ -> compare c1 c2
+      x -> x
+
+start :: Text -> TextPos
+start s = TextPos 0 0 $ V.fromList $ T.lines s
+
+data TextLines = TextLines Text TextPos deriving (Eq, Show)
+
+instance Stream TextLines where
+  type Item TextLines = Char
+  type Pos TextLines = TextPos
+
+  next (TextLines t (TextPos l c ls)) =
+    do
+      (nextChar, t') <- T.uncons t
+      let (l', c') =
+            if nextChar == '\n'
+              then (l + 1, 0)
+              else (l, c + 1)
+      pure (nextChar, TextLines t' (TextPos l' c' ls))
+
+  getPos (TextLines _ p) = p
+
+fromText :: Text -> TextLines
+fromText s = TextLines s (start s)

@@ -11,16 +11,29 @@ meaningful error messages without sacrificing performances or the developer experience when writing parsers. +## How?++The main difference between `comparse` and other equivalent libraries is that+the parsers you write are generic over the exact type of the input stream. That+means you can write parsers that work with both `String`, `Text` or any other+source of `Char`s with no modification. The combinators in `comparse` also work+with anything that's an instance of `Stream`, even if it's not a `Stream` of+`Char`s (e.g. a `TokenStream`!).+ ## Example -The following example shows how to use the `comparse` library to parse a subset-of the [JSON](https://en.wikipedia.org/wiki/JSON) data format:+The following example shows how to use the `comparse` library to parse a+simplified subset of the [JSON](https://en.wikipedia.org/wiki/JSON) data format:  ```hs+-- TypeFamilies is required by the `CharParser` constraint+{-# LANGUAGE TypeFamilies #-}+ import Control.Monad (void) import Control.Monad.Parser import Data.Char (isAlpha, isDigit)-import Data.Stream.StringLines+import Data.Text (Text)+import qualified Data.Text as T  data JValue   = JString String@@ -32,23 +45,34 @@   deriving (Show)  main :: IO ()-main = interact $ show . parseJValue+main = do+  input <- getContents+  putStrLn "Parsing as String:"+  print (parseString input)+  putStrLn "Parsing as Text:"+  print (parseText $ T.pack input) -parseJValue :: String -> Maybe JValue-parseJValue s =+parseString :: String -> Maybe JValue+parseString s =   case runStringParser (json <* eof) s of-    Parsed v (StringLines "" _) _ -> Just v+    Parsed v _ _ -> Just v     _ -> Nothing -lexeme :: StringParser a -> StringParser a+parseText :: Text -> Maybe JValue+parseText t =+  case runTextParser (json <* eof) t of+    Parsed v _ _ -> Just v+    _ -> Nothing++lexeme :: CharParser p => p a -> p a lexeme p = spaces *> p <* spaces   where     spaces = void $ many $ oneOf " \n\r\t" -symbol :: String -> StringParser String+symbol :: CharParser p => String -> p String symbol = lexeme . string -json :: StringParser JValue+json :: CharParser p => p JValue json =   JString <$> stringLiteral     <|> JNumber <$> number@@ -57,10 +81,10 @@     <|> JObject <$> object     <|> JArray <$> array -stringLiteral :: StringParser String+stringLiteral :: CharParser p => p String stringLiteral = lexeme $ like '"' *> many (unlike '\"') <* like '"' -number :: StringParser Int+number :: CharParser p => p Int number =   lexeme     ( read <$> ((:) <$> like '-' <*> many1 digit)@@ -70,17 +94,28 @@   where     digit = match isDigit -bool :: StringParser Bool+bool :: CharParser p => p Bool bool = True <$ symbol "true" <|> False <$ symbol "false" -object :: StringParser [(String, JValue)]+object :: CharParser p => p [(String, JValue)] object =   symbol "{"     *> sepBy ((,) <$> (stringLiteral <* symbol ":") <*> json) (symbol ",")     <* symbol "}" -array :: StringParser [JValue]+array :: CharParser p => p [JValue] array = symbol "[" *> sepBy json (symbol ",") <* symbol "]" ```++The `CharParser p` constraint lets us easily write parsers specialised to+character input streams. It's actually defined as a `type` alias:++```hs+type ParserOf i p = (MonadParser p, Item (Input p) ~ i)++type CharParser p = ParserOf Char p+```++This design makes it very easy to write reusable parsers and combinators.  For more examples, please refer to the [tests](test/Parsing.hs).

@@ -5,8 +5,8 @@ -- see: https://github.com/sol/hpack  name:           comparse-version:        0.1.0.0-synopsis:       An unopiniated parser combinators library.+version:        0.2.0.0+synopsis:       A highly generic parser combinators library. description:    Please see the README on GitHub at <https://github.com/nasso/comparse#readme> category:       Parsing homepage:       https://github.com/nasso/comparse#readme@@ -33,6 +33,7 @@       Control.Monad.Trans.Parser       Data.Stream       Data.Stream.StringLines+      Data.Stream.TextLines   other-modules:       Paths_comparse   hs-source-dirs:@@ -41,7 +42,9 @@   build-depends:       base ==4.14.*     , mtl ==2.2.*+    , text ==2.0.*     , transformers ==0.5.*+    , vector ==0.12.*   default-language: Haskell2010  test-suite comparse-test@@ -53,6 +56,7 @@       Stream       Stream.Generic       Stream.StringLines+      Stream.TextLines       Paths_comparse   hs-source-dirs:       test@@ -63,5 +67,7 @@     , mtl ==2.2.*     , tasty ==1.4.*     , tasty-hunit ==0.10.*+    , text ==2.0.*     , transformers ==0.5.*+    , vector ==0.12.*   default-language: Haskell2010

@@ -1,9 +1,12 @@+{-# LANGUAGE TypeFamilies #-}+ module Json (jsonTests) where  import Control.Monad (void) import Control.Monad.Parser import Data.Char (isAlpha, isDigit)-import Data.Stream.StringLines+import Data.Text (Text)+import qualified Data.Text as T import Test.Tasty import Test.Tasty.HUnit @@ -18,30 +21,35 @@  jsonTests :: [TestTree] jsonTests =-  [ testCase "string" $ parseJValue "\"foo\"" @?= Just (JString "foo"),-    testCase "empty string" $ parseJValue "\"\"" @?= Just (JString ""),-    testCase "number" $ parseJValue "123" @?= Just (JNumber 123),-    testCase "negative number" $ parseJValue "-123" @?= Just (JNumber (-123)),-    testCase "positive number" $ parseJValue "+123" @?= Just (JNumber 123),-    testCase "bool true" $ parseJValue "true" @?= Just (JBool True),-    testCase "bool false" $ parseJValue "false" @?= Just (JBool False),-    testCase "null" $ parseJValue "null" @?= Just JNull,+  testsWith parseString+    ++ testsWith (parseText . T.pack)++testsWith :: (String -> Maybe JValue) -> [TestTree]+testsWith p =+  [ testCase "string" $ p "\"foo\"" @?= Just (JString "foo"),+    testCase "empty string" $ p "\"\"" @?= Just (JString ""),+    testCase "number" $ p "123" @?= Just (JNumber 123),+    testCase "negative number" $ p "-123" @?= Just (JNumber (-123)),+    testCase "positive number" $ p "+123" @?= Just (JNumber 123),+    testCase "bool true" $ p "true" @?= Just (JBool True),+    testCase "bool false" $ p "false" @?= Just (JBool False),+    testCase "null" $ p "null" @?= Just JNull,     testCase "object" $-      parseJValue "{\"foo\": \"bar\"}"+      p "{\"foo\": \"bar\"}"         @?= Just (JObject [("foo", JString "bar")]),-    testCase "empty object" $ parseJValue "{}" @?= Just (JObject []),+    testCase "empty object" $ p "{}" @?= Just (JObject []),     testCase "array" $-      parseJValue "[1, 2, 3]"+      p "[1, 2, 3]"         @?= Just (JArray [JNumber 1, JNumber 2, JNumber 3]),-    testCase "empty array" $ parseJValue "[]" @?= Just (JArray []),+    testCase "empty array" $ p "[]" @?= Just (JArray []),     testCase "nested array" $-      parseJValue "[1, [2, 3], 4]"+      p "[1, [2, 3], 4]"         @?= Just (JArray [JNumber 1, JArray [JNumber 2, JNumber 3], JNumber 4]),     testCase "nested object" $-      parseJValue "{\"foo\": {\"bar\": \"baz\"}}"+      p "{\"foo\": {\"bar\": \"baz\"}}"         @?= Just (JObject [("foo", JObject [("bar", JString "baz")])]),     testCase "nested object with array" $-      parseJValue "{\"foo\": {\"bar\": [1, 2, 3]}}"+      p "{\"foo\": {\"bar\": [1, 2, 3]}}"         @?= Just           ( JObject               [ ( "foo",@@ -51,28 +59,34 @@                 )               ]           ),-    testCase "invalid input" $ parseJValue "foo" @?= Nothing,+    testCase "invalid input" $ p "foo" @?= Nothing,     testCase "weird spacing" $-      parseJValue "   {\t  \n\"foo\"\r \t: \"bar\"\n }  \t"+      p "   {\t  \n\"foo\"\r \t: \"bar\"\n }  \t"         @?= Just (JObject [("foo", JString "bar")]),-    testCase "number followed by letter" $ parseJValue "123a" @?= Nothing+    testCase "number followed by letter" $ p "123a" @?= Nothing   ] -parseJValue :: String -> Maybe JValue-parseJValue s =+parseString :: String -> Maybe JValue+parseString s =   case runStringParser (json <* eof) s of-    Parsed v (StringLines "" _) _ -> Just v+    Parsed v _ _ -> Just v     _ -> Nothing -lexeme :: StringParser a -> StringParser a+parseText :: Text -> Maybe JValue+parseText t =+  case runTextParser (json <* eof) t of+    Parsed v _ _ -> Just v+    _ -> Nothing++lexeme :: CharParser p => p a -> p a lexeme p = spaces *> p <* spaces   where     spaces = void $ many $ oneOf " \n\r\t" -symbol :: String -> StringParser String+symbol :: CharParser p => String -> p String symbol = lexeme . string -json :: StringParser JValue+json :: CharParser p => p JValue json =   JString <$> stringLiteral     <|> JNumber <$> number@@ -81,10 +95,10 @@     <|> JObject <$> object     <|> JArray <$> array -stringLiteral :: StringParser String+stringLiteral :: CharParser p => p String stringLiteral = lexeme $ like '"' *> many (unlike '\"') <* like '"' -number :: StringParser Int+number :: CharParser p => p Int number =   lexeme     ( read <$> ((:) <$> like '-' <*> many1 digit)@@ -94,14 +108,14 @@   where     digit = match isDigit -bool :: StringParser Bool+bool :: CharParser p => p Bool bool = True <$ symbol "true" <|> False <$ symbol "false" -object :: StringParser [(String, JValue)]+object :: CharParser p => p [(String, JValue)] object =   symbol "{"     *> sepBy ((,) <$> (stringLiteral <* symbol ":") <*> json) (symbol ",")     <* symbol "}" -array :: StringParser [JValue]+array :: CharParser p => p [JValue] array = symbol "[" *> sepBy json (symbol ",") <* symbol "]"

@@ -1,7 +1,8 @@ module Stream (streamTests) where
 
 import Stream.StringLines (stringStreamTests)
+import Stream.TextLines (textStreamTests)
 import Test.Tasty
 
 streamTests :: [TestTree]
-streamTests = [stringStreamTests]
+streamTests = [stringStreamTests, textStreamTests]

@@ -3,50 +3,23 @@ 
 module Stream.Generic (genericStreamTests) where
 
-import Data.Stream
-import Data.String (IsString, fromString)
+import Data.Stream (Stream (Item, next))
 import Test.Tasty
 import Test.Tasty.HUnit
 
 genericStreamTests ::
-  ( Stream s
-  , Show s
-  , Eq s
-  , Item s ~ Char
-  , IsString (Chunk s)
-  , Eq (Chunk s)
-  , Show (Chunk s)
-  ) =>
+  (Stream s, Show s, Eq s, Item s ~ Char) =>
   (Int -> Int -> String -> s) ->
   [TestTree]
 genericStreamTests makeAt =
   [ testCase "next on same line gives next character" $
-      next (make "foo\nbar\nbaz") @?= Just ('f', makeAt 0 1 "oo\nbar\nbaz")
-  , testCase "next at end of line gives linefeed" $
-      next (make "\nbar\nbaz") @?= Just ('\n', makeAt 1 0 "bar\nbaz")
-  , testCase "next before end of line stops before linefeed" $
-      next (make "o\nbar\nbaz") @?= Just ('o', makeAt 0 1 "\nbar\nbaz")
-  , testCase "next at end of file gives Nothing" $
+      next (make "foo\nbar\nbaz") @?= Just ('f', makeAt 0 1 "oo\nbar\nbaz"),
+    testCase "next at end of line gives linefeed" $
+      next (make "\nbar\nbaz") @?= Just ('\n', makeAt 1 0 "bar\nbaz"),
+    testCase "next before end of line stops before linefeed" $
+      next (make "o\nbar\nbaz") @?= Just ('o', makeAt 0 1 "\nbar\nbaz"),
+    testCase "next at end of file gives Nothing" $
       next (make "") @?= Nothing
-  , testCase "nextWhile gives empty chunk when nothing matches" $
-      nextWhile (== 'x') (make "foo") @?= (fromString "", makeAt 0 0 "foo")
-  , testCase "nextWhile gives matching chunk" $
-      nextWhile (== 'o') (make "oof") @?= (fromString "oo", makeAt 0 2 "f")
-  , testCase "nextWhile can consume all stream" $
-      nextWhile (const True) (make "foo") @?= (fromString "foo", makeAt 0 3 "")
-  , testCase "nextWhile can consume multiple lines" $
-      nextWhile (const True) (make "foo\nbar\nbaz")
-        @?= (fromString "foo\nbar\nbaz", makeAt 2 3 "")
-  , testCase "nextN consume nothing when N=0" $
-      nextN 0 (make "foo") @?= (fromString "", makeAt 0 0 "foo")
-  , testCase "nextN consume one character when N=1" $
-      nextN 1 (make "foo") @?= (fromString "f", makeAt 0 1 "oo")
-  , testCase "nextN consume multiple characters when N>1" $
-      nextN 3 (make "foo") @?= (fromString "foo", makeAt 0 3 "")
-  , testCase "nextN stops at end of file" $
-      nextN 3 (make "") @?= (fromString "", makeAt 0 0 "")
-  , testCase "nextN counts linefeeds" $
-      nextN 2 (make "\nfoo\nbar") @?= (fromString "\nf", makeAt 1 1 "oo\nbar")
   ]
- where
-  make = makeAt 0 0
+  where
+    make = makeAt 0 0

@@ -0,0 +1,22 @@+module Stream.TextLines (textStreamTests) where
+
+import Data.Stream
+import Data.Stream.TextLines (TextLines (..), TextPos (TextPos))
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import Stream.Generic (genericStreamTests)
+import Test.Tasty
+import Test.Tasty.HUnit
+
+textStreamTests :: TestTree
+textStreamTests =
+  testGroup "Text" $
+    testCase
+      "getPos returns current position"
+      (getPos (makeAt 3 5 "foo\nbar") @?= makePosAt 3 5 "foo\nbar") :
+    genericStreamTests makeAt
+  where
+    makeAt l c s =
+      let t = T.pack s
+       in TextLines t $ TextPos l c $ V.fromList $ T.lines t
+    makePosAt l c s = TextPos l c $ V.fromList $ T.lines $ T.pack s