megaparsec-6.0.0: tests/Text/Megaparsec/StreamSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Text.Megaparsec.StreamSpec (spec) where
import Data.Char (isLetter, chr)
import Data.Proxy
import Data.Semigroup ((<>))
import Test.Hspec
import Test.Hspec.Megaparsec.AdHoc
import Test.QuickCheck
import Text.Megaparsec
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
spec :: Spec
spec = do
describe "String instance of Stream" $ do
describe "tokenToChunk" $
it "produces the same result as singleton with tokensToChunk" $
property $ \ch ->
tokenToChunk sproxy ch === tokensToChunk sproxy [ch]
describe "tokensToChunk" $
it "list of tokens is isomorphic to chunk" $
property $ \ts ->
chunkToTokens sproxy (tokensToChunk sproxy ts) === ts
describe "chunkToTokens" $
it "chunk is isomorphic to list of tokens" $
property $ \chunk ->
tokensToChunk sproxy (chunkToTokens sproxy chunk) === chunk
describe "chunkLength" $
it "returns correct length of given chunk" $
property $ \chunk ->
chunkLength sproxy chunk === length chunk
describe "chunkEmpty" $
it "only true when chunkLength returns 0" $
property $ \chunk ->
chunkEmpty sproxy chunk === (chunkLength sproxy chunk <= 0)
describe "positionAt1" $
it "just returns the given position" $
property $ \pos t ->
positionAt1 sproxy pos t === pos
describe "positionAtN" $
it "just returns the given position" $
property $ \pos chunk ->
positionAtN sproxy pos chunk === pos
describe "advance1" $ do
context "when given newline" $
it "works correctly" $
property $ \w pos@(SourcePos n l _) ->
advance1 sproxy w pos '\n' === SourcePos n (l <> pos1) pos1
context "when given tab" $
it "works correctly" $
property $ \w pos@(SourcePos n l c) ->
advance1 sproxy w pos '\t' === SourcePos n l (toNextTab w c)
context "when given other character" $
it "works correctly" $
property $ \ch w pos@(SourcePos n l c) ->
(ch /= '\n' && ch /= '\t') ==>
advance1 sproxy w pos ch === SourcePos n l (c <> pos1)
describe "advanceN" $
it "works correctly" $
advanceN sproxy defaultTabWidth (initialPos "") "something\n\tfoo"
=== SourcePos "" (mkPos 2) (mkPos 12)
describe "take1_" $ do
context "when input in empty" $
it "returns Nothing" $
take1_ ("" :: String) === Nothing
context "when input is not empty" $
it "unconses a token" $
property $ \s -> not (null s) ==>
take1_ (s :: String) === Just (head s, tail s)
describe "takeN_" $ do
context "requested length is 0" $
it "returns Just empty chunk and original stream" $
property $ \s ->
takeN_ 0 (s :: String) === Just ("", s)
context "requested length is greater than 0" $ do
context "stream is empty" $
it "returns Nothing" $
property $ \(Positive n) ->
takeN_ n ("" :: String) === Nothing
context "stream is not empty" $
it "returns a chunk of correct length and rest of the stream" $
property $ \(Positive n) s -> not (null s) ==>
takeN_ n (s :: String) === Just (splitAt n s)
describe "takeWhile_" $
it "extracts a chunk that is a prefix consisting of matching tokens" $
property $ \s ->
takeWhile_ isLetter s === span isLetter s
describe "ByteString instance of Stream" $ do
describe "tokenToChunk" $
it "produces the same result as singleton with tokensToChunk" $
property $ \ch ->
tokenToChunk bproxy ch === tokensToChunk bproxy [ch]
describe "tokensToChunk" $
it "list of tokens is isomorphic to chunk" $
property $ \ts ->
chunkToTokens bproxy (tokensToChunk bproxy ts) === ts
describe "chunkToTokens" $
it "chunk is isomorphic to list of tokens" $
property $ \chunk ->
tokensToChunk bproxy (chunkToTokens bproxy chunk) === chunk
describe "chunkLength" $
it "returns correct length of given chunk" $
property $ \chunk ->
chunkLength bproxy chunk === B.length chunk
describe "chunkEmpty" $
it "only true when chunkLength returns 0" $
property $ \chunk ->
chunkEmpty bproxy chunk === (chunkLength bproxy chunk <= 0)
describe "positionAt1" $
it "just returns the given position" $
property $ \pos t ->
positionAt1 bproxy pos t === pos
describe "positionAtN" $
it "just returns the given position" $
property $ \pos chunk ->
positionAtN bproxy pos chunk === pos
describe "advance1" $ do
context "when given newline" $
it "works correctly" $
property $ \w pos@(SourcePos n l _) ->
advance1 bproxy w pos 10 === SourcePos n (l <> pos1) pos1
context "when given tab" $
it "works correctly" $
property $ \w pos@(SourcePos n l c) ->
advance1 bproxy w pos 9 === SourcePos n l (toNextTab w c)
context "when given other character" $
it "works correctly" $
property $ \ch w pos@(SourcePos n l c) ->
(ch /= 10 && ch /= 9) ==>
advance1 bproxy w pos ch === SourcePos n l (c <> pos1)
describe "advanceN" $
it "works correctly" $
advanceN bproxy defaultTabWidth (initialPos "") "something\n\tfoo"
=== SourcePos "" (mkPos 2) (mkPos 12)
describe "take1_" $ do
context "when input in empty" $
it "returns Nothing" $
take1_ ("" :: B.ByteString) === Nothing
context "when input is not empty" $
it "unconses a token" $
property $ \s -> not (B.null s) ==>
take1_ (s :: B.ByteString) === B.uncons s
describe "takeN_" $ do
context "requested length is 0" $
it "returns Just empty chunk and original stream" $
property $ \s ->
takeN_ 0 (s :: B.ByteString) === Just ("", s)
context "requested length is greater than 0" $ do
context "stream is empty" $
it "returns Nothing" $
property $ \(Positive n) ->
takeN_ n ("" :: B.ByteString) === Nothing
context "stream is not empty" $
it "returns a chunk of correct length and rest of the stream" $
property $ \(Positive n) s -> not (B.null s) ==>
takeN_ n (s :: B.ByteString) === Just (B.splitAt n s)
describe "takeWhile_" $
it "extracts a chunk that is a prefix consisting of matching tokens" $
property $ \s ->
let f = isLetter . chr . fromIntegral
in takeWhile_ f s === B.span f s
describe "Lazy ByteString instance of Stream" $ do
describe "tokenToChunk" $
it "produces the same result as singleton with tokensToChunk" $
property $ \ch ->
tokenToChunk blproxy ch === tokensToChunk blproxy [ch]
describe "tokensToChunk" $
it "list of tokens is isomorphic to chunk" $
property $ \ts ->
chunkToTokens blproxy (tokensToChunk blproxy ts) === ts
describe "chunkToTokens" $
it "chunk is isomorphic to list of tokens" $
property $ \chunk ->
tokensToChunk blproxy (chunkToTokens blproxy chunk) === chunk
describe "chunkLength" $
it "returns correct length of given chunk" $
property $ \chunk ->
chunkLength blproxy chunk === fromIntegral (BL.length chunk)
describe "chunkEmpty" $
it "only true when chunkLength returns 0" $
property $ \chunk ->
chunkEmpty blproxy chunk === (chunkLength blproxy chunk <= 0)
describe "positionAt1" $
it "just returns the given position" $
property $ \pos t ->
positionAt1 blproxy pos t === pos
describe "positionAtN" $
it "just returns the given position" $
property $ \pos chunk ->
positionAtN blproxy pos chunk === pos
describe "advance1" $ do
context "when given newline" $
it "works correctly" $
property $ \w pos@(SourcePos n l _) ->
advance1 blproxy w pos 10 === SourcePos n (l <> pos1) pos1
context "when given tab" $
it "works correctly" $
property $ \w pos@(SourcePos n l c) ->
advance1 blproxy w pos 9 === SourcePos n l (toNextTab w c)
context "when given other character" $
it "works correctly" $
property $ \ch w pos@(SourcePos n l c) ->
(ch /= 10 && ch /= 9) ==>
advance1 blproxy w pos ch === SourcePos n l (c <> pos1)
describe "advanceN" $
it "works correctly" $
advanceN blproxy defaultTabWidth (initialPos "") "something\n\tfoo"
=== SourcePos "" (mkPos 2) (mkPos 12)
describe "take1_" $ do
context "when input in empty" $
it "returns Nothing" $
take1_ ("" :: BL.ByteString) === Nothing
context "when input is not empty" $
it "unconses a token" $
property $ \s -> not (BL.null s) ==>
take1_ (s :: BL.ByteString) === BL.uncons s
describe "takeN_" $ do
context "requested length is 0" $
it "returns Just empty chunk and original stream" $
property $ \s ->
takeN_ 0 (s :: BL.ByteString) === Just ("", s)
context "requested length is greater than 0" $ do
context "stream is empty" $
it "returns Nothing" $
property $ \(Positive n) ->
takeN_ n ("" :: BL.ByteString) === Nothing
context "stream is not empty" $
it "returns a chunk of correct length and rest of the stream" $
property $ \(Positive n) s -> not (BL.null s) ==>
takeN_ n (s :: BL.ByteString) === Just (BL.splitAt (fromIntegral n) s)
describe "takeWhile_" $
it "extracts a chunk that is a prefix consisting of matching tokens" $
property $ \s ->
let f = isLetter . chr . fromIntegral
in takeWhile_ f s === BL.span f s
describe "Text instance of Stream" $ do
describe "tokenToChunk" $
it "produces the same result as singleton with tokensToChunk" $
property $ \ch ->
tokenToChunk tproxy ch === tokensToChunk tproxy [ch]
describe "tokensToChunk" $
it "list of tokens is isomorphic to chunk" $
property $ \ts ->
chunkToTokens tproxy (tokensToChunk tproxy ts) === ts
describe "chunkToTokens" $
it "chunk is isomorphic to list of tokens" $
property $ \chunk ->
tokensToChunk tproxy (chunkToTokens tproxy chunk) === chunk
describe "chunkLength" $
it "returns correct length of given chunk" $
property $ \chunk ->
chunkLength tproxy chunk === T.length chunk
describe "chunkEmpty" $
it "only true when chunkLength returns 0" $
property $ \chunk ->
chunkEmpty tproxy chunk === (chunkLength tproxy chunk <= 0)
describe "positionAt1" $
it "just returns the given position" $
property $ \pos t ->
positionAt1 tproxy pos t === pos
describe "positionAtN" $
it "just returns the given position" $
property $ \pos chunk ->
positionAtN tproxy pos chunk === pos
describe "advance1" $ do
context "when given newline" $
it "works correctly" $
property $ \w pos@(SourcePos n l _) ->
advance1 tproxy w pos '\n' === SourcePos n (l <> pos1) pos1
context "when given tab" $
it "works correctly" $
property $ \w pos@(SourcePos n l c) ->
advance1 tproxy w pos '\t' === SourcePos n l (toNextTab w c)
context "when given other character" $
it "works correctly" $
property $ \ch w pos@(SourcePos n l c) ->
(ch /= '\n' && ch /= '\t') ==>
advance1 tproxy w pos ch === SourcePos n l (c <> pos1)
describe "advanceN" $
it "works correctly" $
advanceN tproxy defaultTabWidth (initialPos "") "something\n\tfoo"
=== SourcePos "" (mkPos 2) (mkPos 12)
describe "take1_" $ do
context "when input in empty" $
it "returns Nothing" $
take1_ ("" :: T.Text) === Nothing
context "when input is not empty" $
it "unconses a token" $
property $ \s -> not (T.null s) ==>
take1_ (s :: T.Text) === T.uncons s
describe "takeN_" $ do
context "requested length is 0" $
it "returns Just empty chunk and original stream" $
property $ \s ->
takeN_ 0 (s :: T.Text) === Just ("", s)
context "requested length is greater than 0" $ do
context "stream is empty" $
it "returns Nothing" $
property $ \(Positive n) ->
takeN_ n ("" :: T.Text) === Nothing
context "stream is not empty" $
it "returns a chunk of correct length and rest of the stream" $
property $ \(Positive n) s -> not (T.null s) ==>
takeN_ n (s :: T.Text) === Just (T.splitAt n s)
describe "takeWhile_" $
it "extracts a chunk that is a prefix consisting of matching tokens" $
property $ \s ->
takeWhile_ isLetter s === T.span isLetter s
describe "Lazy Text instance of Stream" $ do
describe "tokenToChunk" $
it "produces the same result as singleton with tokensToChunk" $
property $ \ch ->
tokenToChunk tlproxy ch === tokensToChunk tlproxy [ch]
describe "tokensToChunk" $
it "list of tokens is isomorphic to chunk" $
property $ \ts ->
chunkToTokens tlproxy (tokensToChunk tlproxy ts) === ts
describe "chunkToTokens" $
it "chunk is isomorphic to list of tokens" $
property $ \chunk ->
tokensToChunk tlproxy (chunkToTokens tlproxy chunk) === chunk
describe "chunkLength" $
it "returns correct length of given chunk" $
property $ \chunk ->
chunkLength tlproxy chunk === fromIntegral (TL.length chunk)
describe "chunkEmpty" $
it "only true when chunkLength returns 0" $
property $ \chunk ->
chunkEmpty tlproxy chunk === (chunkLength tlproxy chunk <= 0)
describe "positionAt1" $
it "just returns the given position" $
property $ \pos t ->
positionAt1 tlproxy pos t === pos
describe "positionAtN" $
it "just returns the given position" $
property $ \pos chunk ->
positionAtN tlproxy pos chunk === pos
describe "advance1" $ do
context "when given newline" $
it "works correctly" $
property $ \w pos@(SourcePos n l _) ->
advance1 tlproxy w pos '\n' === SourcePos n (l <> pos1) pos1
context "when given tab" $
it "works correctly" $
property $ \w pos@(SourcePos n l c) ->
advance1 tlproxy w pos '\t' === SourcePos n l (toNextTab w c)
context "when given other character" $
it "works correctly" $
property $ \ch w pos@(SourcePos n l c) ->
(ch /= '\n' && ch /= '\t') ==>
advance1 tlproxy w pos ch === SourcePos n l (c <> pos1)
describe "advanceN" $
it "works correctly" $
advanceN tlproxy defaultTabWidth (initialPos "") "something\n\tfoo"
=== SourcePos "" (mkPos 2) (mkPos 12)
describe "take1_" $ do
context "when input in empty" $
it "returns Nothing" $
take1_ ("" :: TL.Text) === Nothing
context "when input is not empty" $
it "unconses a token" $
property $ \s -> not (TL.null s) ==>
take1_ (s :: TL.Text) === TL.uncons s
describe "takeN_" $ do
context "requested length is 0" $
it "returns Just empty chunk and original stream" $
property $ \s ->
takeN_ 0 (s :: TL.Text) === Just ("", s)
context "requested length is greater than 0" $ do
context "stream is empty" $
it "returns Nothing" $
property $ \(Positive n) ->
takeN_ n ("" :: TL.Text) === Nothing
context "stream is not empty" $
it "returns a chunk of correct length and rest of the stream" $
property $ \(Positive n) s -> not (TL.null s) ==>
takeN_ n (s :: TL.Text) === Just (TL.splitAt (fromIntegral n) s)
describe "takeWhile_" $
it "extracts a chunk that is a prefix consisting of matching tokens" $
property $ \s ->
takeWhile_ isLetter s === TL.span isLetter s
----------------------------------------------------------------------------
-- Helpers
toNextTab :: Pos -> Pos -> Pos
toNextTab w' c' = mkPos $ c + w - ((c - 1) `rem` w)
where
w = unPos w'
c = unPos c'
sproxy :: Proxy String
sproxy = Proxy
bproxy :: Proxy B.ByteString
bproxy = Proxy
blproxy :: Proxy BL.ByteString
blproxy = Proxy
tproxy :: Proxy T.Text
tproxy = Proxy
tlproxy :: Proxy TL.Text
tlproxy = Proxy