{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      :  Test.Hspec.Megaparsec.AdHoc
-- Copyright   :  © 2019–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Ad-hoc helpers used in Megaparsec's test suite.
module Test.Hspec.Megaparsec.AdHoc
  ( -- * Types
    Parser,

    -- * Helpers to run parsers
    prs,
    prs',
    prs_,
    grs,
    grs',

    -- * Other
    nes,
    abcRow,
    rightOrder,
    scaleDown,
    getTabWidth,
    setTabWidth,
    strSourcePos,

    -- * Char and byte conversion
    toChar,
    fromChar,

    -- * Proxies
    sproxy,
    bproxy,
    blproxy,
    tproxy,
    tlproxy,
  )
where

import qualified Control.Monad.RWS.Lazy as L
import qualified Control.Monad.RWS.Strict as S
import Control.Monad.Reader
import qualified Control.Monad.State.Lazy as L
import qualified Control.Monad.State.Strict as S
import Control.Monad.Trans.Identity
import qualified Control.Monad.Writer.Lazy as L
import qualified Control.Monad.Writer.Strict as S
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (chr, ord)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Proxy
import qualified Data.Set as E
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Void
import Data.Word (Word8)
import Test.Hspec
import Test.Hspec.Megaparsec
import Test.QuickCheck
import Text.Megaparsec

----------------------------------------------------------------------------
-- Types

-- | The type of parser that consumes a 'String'.
type Parser = Parsec Void String

----------------------------------------------------------------------------
-- Helpers to run parsers

-- | Apply parser to given input. This is a specialized version of 'parse'
-- that assumes empty file name.
prs ::
  -- | Parser to run
  Parser a ->
  -- | Input for the parser
  String ->
  -- | Result of parsing
  Either (ParseErrorBundle String Void) a
prs :: Parser a -> String -> Either (ParseErrorBundle String Void) a
prs Parser a
p = Parser a
-> String -> String -> Either (ParseErrorBundle String Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser a
p String
""

-- | Just like 'prs', but allows to inspect the final state of the parser.
prs' ::
  -- | Parser to run
  Parser a ->
  -- | Input for the parser
  String ->
  -- | Result of parsing
  (State String Void, Either (ParseErrorBundle String Void) a)
prs' :: Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' Parser a
p String
s = Parser a
-> State String Void
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' Parser a
p (String -> State String Void
forall s e. s -> State s e
initialState String
s)

-- | Just like 'prs', but forces the parser to consume all input by adding
-- 'eof':
--
-- > prs_ p = parse (p <* eof) ""
prs_ ::
  -- | Parser to run
  Parser a ->
  -- | Input for the parser
  String ->
  -- | Result of parsing
  Either (ParseErrorBundle String Void) a
prs_ :: Parser a -> String -> Either (ParseErrorBundle String Void) a
prs_ Parser a
p = Parser a
-> String -> String -> Either (ParseErrorBundle String Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser a
p Parser a -> ParsecT Void String Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
""

-- | Just like 'prs', but interprets given parser as various monads (tries
-- all supported monads transformers in turn).
grs ::
  -- | Parser to run
  (forall m. MonadParsec Void String m => m a) ->
  -- | Input for the parser
  String ->
  -- | How to check result of parsing
  (Either (ParseErrorBundle String Void) a -> Expectation) ->
  Expectation
grs :: (forall (m :: * -> *). MonadParsec Void String m => m a)
-> String
-> (Either (ParseErrorBundle String Void) a -> Expectation)
-> Expectation
grs forall (m :: * -> *). MonadParsec Void String m => m a
p String
s Either (ParseErrorBundle String Void) a -> Expectation
r = do
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs Parser a
forall (m :: * -> *). MonadParsec Void String m => m a
p String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (IdentityT (ParsecT Void String Identity) a -> Parser a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (ReaderT () (ParsecT Void String Identity) a -> () -> Parser a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p ()) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (StateT () (ParsecT Void String Identity) a -> () -> Parser a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
L.evalStateT StateT () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p ()) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (StateT () (ParsecT Void String Identity) a -> () -> Parser a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT StateT () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p ()) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (WriterT [Int] (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTL WriterT [Int] (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (WriterT [Int] (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTS WriterT [Int] (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (RWST () [Int] () (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTL RWST () [Int] () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (Parser a -> String -> Either (ParseErrorBundle String Void) a
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (RWST () [Int] () (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTS RWST () [Int] () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)

-- | 'grs'' to 'grs' is as 'prs'' to 'prs'.
grs' ::
  -- | Parser to run
  (forall m. MonadParsec Void String m => m a) ->
  -- | Input for the parser
  String ->
  -- | How to check result of parsing
  ((State String Void, Either (ParseErrorBundle String Void) a) -> Expectation) ->
  Expectation
grs' :: (forall (m :: * -> *). MonadParsec Void String m => m a)
-> String
-> ((State String Void, Either (ParseErrorBundle String Void) a)
    -> Expectation)
-> Expectation
grs' forall (m :: * -> *). MonadParsec Void String m => m a
p String
s (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r = do
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' Parser a
forall (m :: * -> *). MonadParsec Void String m => m a
p String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (IdentityT (ParsecT Void String Identity) a -> Parser a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (ReaderT () (ParsecT Void String Identity) a -> () -> Parser a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p ()) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (StateT () (ParsecT Void String Identity) a -> () -> Parser a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
L.evalStateT StateT () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p ()) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (StateT () (ParsecT Void String Identity) a -> () -> Parser a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT StateT () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p ()) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (WriterT [Int] (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTL WriterT [Int] (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (WriterT [Int] (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTS WriterT [Int] (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (RWST () [Int] () (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTL RWST () [Int] () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (RWST () [Int] () (ParsecT Void String Identity) a -> Parser a
forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTS RWST () [Int] () (ParsecT Void String Identity) a
forall (m :: * -> *). MonadParsec Void String m => m a
p) String
s)

evalWriterTL :: Monad m => L.WriterT [Int] m a -> m a
evalWriterTL :: WriterT [Int] m a -> m a
evalWriterTL = ((a, [Int]) -> a) -> m (a, [Int]) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [Int]) -> a
forall a b. (a, b) -> a
fst (m (a, [Int]) -> m a)
-> (WriterT [Int] m a -> m (a, [Int])) -> WriterT [Int] m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Int] m a -> m (a, [Int])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT

evalWriterTS :: Monad m => S.WriterT [Int] m a -> m a
evalWriterTS :: WriterT [Int] m a -> m a
evalWriterTS = ((a, [Int]) -> a) -> m (a, [Int]) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [Int]) -> a
forall a b. (a, b) -> a
fst (m (a, [Int]) -> m a)
-> (WriterT [Int] m a -> m (a, [Int])) -> WriterT [Int] m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Int] m a -> m (a, [Int])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
S.runWriterT

evalRWSTL :: Monad m => L.RWST () [Int] () m a -> m a
evalRWSTL :: RWST () [Int] () m a -> m a
evalRWSTL RWST () [Int] () m a
m = do
  (a
a, ()
_, [Int]
_) <- RWST () [Int] () m a -> () -> () -> m (a, (), [Int])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST RWST () [Int] () m a
m () ()
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

evalRWSTS :: Monad m => S.RWST () [Int] () m a -> m a
evalRWSTS :: RWST () [Int] () m a -> m a
evalRWSTS RWST () [Int] () m a
m = do
  (a
a, ()
_, [Int]
_) <- RWST () [Int] () m a -> () -> () -> m (a, (), [Int])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST RWST () [Int] () m a
m () ()
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

----------------------------------------------------------------------------
-- Other

-- | Make a singleton non-empty list from a value.
nes :: a -> NonEmpty a
nes :: a -> NonEmpty a
nes a
x = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []

-- | @abcRow a b c@ generates string consisting of character “a” repeated
-- @a@ times, character “b” repeated @b@ times, and character “c” repeated
-- @c@ times.
abcRow :: Int -> Int -> Int -> String
abcRow :: Int -> Int -> Int -> String
abcRow Int
a Int
b Int
c = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
a Char
'a' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
b Char
'b' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
c Char
'c'

-- | Check that the given parser returns the list in the right order.
rightOrder ::
  -- | The parser to test
  Parser String ->
  -- | Input for the parser
  String ->
  -- | Expected result
  String ->
  Spec
rightOrder :: Parser String -> String -> String -> Spec
rightOrder Parser String
p String
s String
s' =
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"produces the list in the right order" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
    Parser String
-> String -> Either (ParseErrorBundle String Void) String
forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs_ Parser String
p String
s Either (ParseErrorBundle String Void) String
-> String -> Expectation
forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a, Eq a) =>
Either (ParseErrorBundle s e) a -> a -> Expectation
`shouldParse` String
s'

-- | Get tab width from 'PosState'. Use with care only for testing.
getTabWidth :: MonadParsec e s m => m Pos
getTabWidth :: m Pos
getTabWidth = PosState s -> Pos
forall s. PosState s -> Pos
pstateTabWidth (PosState s -> Pos)
-> (State s e -> PosState s) -> State s e -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s e -> PosState s
forall s e. State s e -> PosState s
statePosState (State s e -> Pos) -> m (State s e) -> m Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (State s e)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState

-- | Set tab width in 'PosState'. Use with care only for testing.
setTabWidth :: MonadParsec e s m => Pos -> m ()
setTabWidth :: Pos -> m ()
setTabWidth Pos
w = (State s e -> State s e) -> m ()
forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState ((State s e -> State s e) -> m ())
-> (State s e -> State s e) -> m ()
forall a b. (a -> b) -> a -> b
$ \State s e
st ->
  let pst :: PosState s
pst = State s e -> PosState s
forall s e. State s e -> PosState s
statePosState State s e
st
   in State s e
st {statePosState :: PosState s
statePosState = PosState s
pst {pstateTabWidth :: Pos
pstateTabWidth = Pos
w}}

-- | Scale down.
scaleDown :: Gen a -> Gen a
scaleDown :: Gen a -> Gen a
scaleDown = (Int -> Int) -> Gen a -> Gen a
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)

-- | A helper function that is used to advance 'SourcePos' given a 'String'.
strSourcePos :: Pos -> SourcePos -> String -> SourcePos
strSourcePos :: Pos -> SourcePos -> String -> SourcePos
strSourcePos Pos
tabWidth SourcePos
ipos String
input =
  let (Maybe String
_, PosState String
pst') = Int -> PosState String -> (Maybe String, PosState String)
forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset Int
forall a. Bounded a => a
maxBound PosState String
pstate in PosState String -> SourcePos
forall s. PosState s -> SourcePos
pstateSourcePos PosState String
pst'
  where
    pstate :: PosState String
pstate =
      PosState :: forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
        { pstateInput :: String
pstateInput = String
input,
          pstateOffset :: Int
pstateOffset = Int
0,
          pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
ipos,
          pstateTabWidth :: Pos
pstateTabWidth = Pos
tabWidth,
          pstateLinePrefix :: String
pstateLinePrefix = String
""
        }

----------------------------------------------------------------------------
-- Char and byte conversion

-- | Convert a byte to char.
toChar :: Word8 -> Char
toChar :: Word8 -> Char
toChar = Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Covert a char to byte.
fromChar :: Char -> Maybe Word8
fromChar :: Char -> Maybe Word8
fromChar Char
x =
  let p :: Int
p = Char -> Int
ord Char
x
   in if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xff
        then Maybe Word8
forall a. Maybe a
Nothing
        else Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)

----------------------------------------------------------------------------
-- Proxies

sproxy :: Proxy String
sproxy :: Proxy String
sproxy = Proxy String
forall k (t :: k). Proxy t
Proxy

bproxy :: Proxy B.ByteString
bproxy :: Proxy ByteString
bproxy = Proxy ByteString
forall k (t :: k). Proxy t
Proxy

blproxy :: Proxy BL.ByteString
blproxy :: Proxy ByteString
blproxy = Proxy ByteString
forall k (t :: k). Proxy t
Proxy

tproxy :: Proxy T.Text
tproxy :: Proxy Text
tproxy = Proxy Text
forall k (t :: k). Proxy t
Proxy

tlproxy :: Proxy TL.Text
tlproxy :: Proxy Text
tlproxy = Proxy Text
forall k (t :: k). Proxy t
Proxy

----------------------------------------------------------------------------
-- Arbitrary instances

instance Arbitrary Void where
  arbitrary :: Gen Void
arbitrary = String -> Gen Void
forall a. HasCallStack => String -> a
error String
"Arbitrary Void"

instance Arbitrary Pos where
  arbitrary :: Gen Pos
arbitrary = Int -> Pos
mkPos (Int -> Pos) -> Gen Int -> Gen Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Small Int -> Int
forall a. Small a -> a
getSmall (Small Int -> Int)
-> (Positive (Small Int) -> Small Int)
-> Positive (Small Int)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive (Small Int) -> Small Int
forall a. Positive a -> a
getPositive (Positive (Small Int) -> Int)
-> Gen (Positive (Small Int)) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive (Small Int))
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary SourcePos where
  arbitrary :: Gen SourcePos
arbitrary =
    String -> Pos -> Pos -> SourcePos
SourcePos
      (String -> Pos -> Pos -> SourcePos)
-> Gen String -> Gen (Pos -> Pos -> SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String -> Gen String
forall a. Gen a -> Gen a
scaleDown Gen String
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Pos -> Pos -> SourcePos) -> Gen Pos -> Gen (Pos -> SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Pos
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Pos -> SourcePos) -> Gen Pos -> Gen SourcePos
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Pos
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary t => Arbitrary (ErrorItem t) where
  arbitrary :: Gen (ErrorItem t)
arbitrary =
    [Gen (ErrorItem t)] -> Gen (ErrorItem t)
forall a. [Gen a] -> Gen a
oneof
      [ NonEmpty t -> ErrorItem t
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty t -> ErrorItem t)
-> Gen (NonEmpty t) -> Gen (ErrorItem t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([t] -> NonEmpty t
forall a. [a] -> NonEmpty a
NE.fromList ([t] -> NonEmpty t)
-> (NonEmptyList t -> [t]) -> NonEmptyList t -> NonEmpty t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList t -> [t]
forall a. NonEmptyList a -> [a]
getNonEmpty (NonEmptyList t -> NonEmpty t)
-> Gen (NonEmptyList t) -> Gen (NonEmpty t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmptyList t)
forall a. Arbitrary a => Gen a
arbitrary),
        NonEmpty Char -> ErrorItem t
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem t)
-> Gen (NonEmpty Char) -> Gen (ErrorItem t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> NonEmpty Char)
-> (NonEmptyList Char -> String)
-> NonEmptyList Char
-> NonEmpty Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList Char -> String
forall a. NonEmptyList a -> [a]
getNonEmpty (NonEmptyList Char -> NonEmpty Char)
-> Gen (NonEmptyList Char) -> Gen (NonEmpty Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmptyList Char)
forall a. Arbitrary a => Gen a
arbitrary),
        ErrorItem t -> Gen (ErrorItem t)
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorItem t
forall t. ErrorItem t
EndOfInput
      ]

instance Arbitrary (ErrorFancy a) where
  arbitrary :: Gen (ErrorFancy a)
arbitrary =
    [Gen (ErrorFancy a)] -> Gen (ErrorFancy a)
forall a. [Gen a] -> Gen a
oneof
      [ String -> ErrorFancy a
forall e. String -> ErrorFancy e
ErrorFail (String -> ErrorFancy a) -> Gen String -> Gen (ErrorFancy a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String -> Gen String
forall a. Gen a -> Gen a
scaleDown Gen String
forall a. Arbitrary a => Gen a
arbitrary,
        Ordering -> Pos -> Pos -> ErrorFancy a
forall e. Ordering -> Pos -> Pos -> ErrorFancy e
ErrorIndentation (Ordering -> Pos -> Pos -> ErrorFancy a)
-> Gen Ordering -> Gen (Pos -> Pos -> ErrorFancy a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Ordering
forall a. Arbitrary a => Gen a
arbitrary Gen (Pos -> Pos -> ErrorFancy a)
-> Gen Pos -> Gen (Pos -> ErrorFancy a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Pos
forall a. Arbitrary a => Gen a
arbitrary Gen (Pos -> ErrorFancy a) -> Gen Pos -> Gen (ErrorFancy a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Pos
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance
  (Arbitrary (Token s), Ord (Token s), Arbitrary e, Ord e) =>
  Arbitrary (ParseError s e)
  where
  arbitrary :: Gen (ParseError s e)
arbitrary =
    [Gen (ParseError s e)] -> Gen (ParseError s e)
forall a. [Gen a] -> Gen a
oneof
      [ Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError
          (Int
 -> Maybe (ErrorItem (Token s))
 -> Set (ErrorItem (Token s))
 -> ParseError s e)
-> Gen Int
-> Gen
     (Maybe (ErrorItem (Token s))
      -> Set (ErrorItem (Token s)) -> ParseError s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Int) -> Gen (NonNegative Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary)
          Gen
  (Maybe (ErrorItem (Token s))
   -> Set (ErrorItem (Token s)) -> ParseError s e)
-> Gen (Maybe (ErrorItem (Token s)))
-> Gen (Set (ErrorItem (Token s)) -> ParseError s e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (ErrorItem (Token s)))
forall a. Arbitrary a => Gen a
arbitrary
          Gen (Set (ErrorItem (Token s)) -> ParseError s e)
-> Gen (Set (ErrorItem (Token s))) -> Gen (ParseError s e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ErrorItem (Token s)] -> Set (ErrorItem (Token s))
forall a. Ord a => [a] -> Set a
E.fromList ([ErrorItem (Token s)] -> Set (ErrorItem (Token s)))
-> Gen [ErrorItem (Token s)] -> Gen (Set (ErrorItem (Token s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [ErrorItem (Token s)] -> Gen [ErrorItem (Token s)]
forall a. Gen a -> Gen a
scaleDown Gen [ErrorItem (Token s)]
forall a. Arbitrary a => Gen a
arbitrary),
        Int -> Set (ErrorFancy e) -> ParseError s e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError
          (Int -> Set (ErrorFancy e) -> ParseError s e)
-> Gen Int -> Gen (Set (ErrorFancy e) -> ParseError s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Int) -> Gen (NonNegative Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary)
          Gen (Set (ErrorFancy e) -> ParseError s e)
-> Gen (Set (ErrorFancy e)) -> Gen (ParseError s e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ErrorFancy e] -> Set (ErrorFancy e)
forall a. Ord a => [a] -> Set a
E.fromList ([ErrorFancy e] -> Set (ErrorFancy e))
-> Gen [ErrorFancy e] -> Gen (Set (ErrorFancy e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [ErrorFancy e] -> Gen [ErrorFancy e]
forall a. Gen a -> Gen a
scaleDown Gen [ErrorFancy e]
forall a. Arbitrary a => Gen a
arbitrary)
      ]

instance Arbitrary s => Arbitrary (State s e) where
  arbitrary :: Gen (State s e)
arbitrary = do
    s
input <- Gen s -> Gen s
forall a. Gen a -> Gen a
scaleDown Gen s
forall a. Arbitrary a => Gen a
arbitrary
    Int
offset <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
10000)
    PosState s
pstate :: PosState s <- Gen (PosState s)
forall a. Arbitrary a => Gen a
arbitrary
    State s e -> Gen (State s e)
forall (m :: * -> *) a. Monad m => a -> m a
return
      State :: forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
State
        { stateInput :: s
stateInput = s
input,
          stateOffset :: Int
stateOffset = Int
offset,
          statePosState :: PosState s
statePosState =
            PosState s
pstate
              { pstateInput :: s
pstateInput = s
input,
                pstateOffset :: Int
pstateOffset = Int
offset
              },
          stateParseErrors :: [ParseError s e]
stateParseErrors = []
        }

instance Arbitrary s => Arbitrary (PosState s) where
  arbitrary :: Gen (PosState s)
arbitrary =
    s -> Int -> SourcePos -> Pos -> String -> PosState s
forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
      (s -> Int -> SourcePos -> Pos -> String -> PosState s)
-> Gen s -> Gen (Int -> SourcePos -> Pos -> String -> PosState s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen s
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Int -> SourcePos -> Pos -> String -> PosState s)
-> Gen Int -> Gen (SourcePos -> Pos -> String -> PosState s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
10000)
      Gen (SourcePos -> Pos -> String -> PosState s)
-> Gen SourcePos -> Gen (Pos -> String -> PosState s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SourcePos
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Pos -> String -> PosState s)
-> Gen Pos -> Gen (String -> PosState s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Pos
mkPos (Int -> Pos) -> Gen Int -> Gen Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
20))
      Gen (String -> PosState s) -> Gen String -> Gen (PosState s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen String -> Gen String
forall a. Gen a -> Gen a
scaleDown Gen String
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary T.Text where
  arbitrary :: Gen Text
arbitrary = String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary TL.Text where
  arbitrary :: Gen Text
arbitrary = String -> Text
TL.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary B.ByteString where
  arbitrary :: Gen ByteString
arbitrary = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary BL.ByteString where
  arbitrary :: Gen ByteString
arbitrary = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary a => Arbitrary (NonEmpty a) where
  arbitrary :: Gen (NonEmpty a)
arbitrary = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NE.fromList ([a] -> NonEmpty a) -> Gen [a] -> Gen (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen [a]
forall a. Arbitrary a => Gen a
arbitrary Gen [a] -> ([a] -> Bool) -> Gen [a]
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null))