{-# 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
import Text.Megaparsec.Debug (MonadParsecDbg)

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

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

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

-- | Apply the parser to the 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 :: forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs Parser a
p = 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 us 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' :: forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' Parser a
p String
s = forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' Parser a
p (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_ :: forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs_ Parser a
p = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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. (MonadParsecDbg 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 a.
(forall (m :: * -> *). MonadParsecDbg Void String m => m a)
-> String
-> (Either (ParseErrorBundle String Void) a -> Expectation)
-> Expectation
grs forall (m :: * -> *). MonadParsecDbg Void String m => m a
p String
s Either (ParseErrorBundle String Void) a -> Expectation
r = do
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs forall (m :: * -> *). MonadParsecDbg Void String m => m a
p String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p ()) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
L.evalStateT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p ()) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p ()) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTL forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTS forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTL forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  Either (ParseErrorBundle String Void) a -> Expectation
r (forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs (forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTS forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)

-- | 'grs'' to 'grs' is as 'prs'' to 'prs'.
grs' ::
  -- | Parser to run
  (forall m. (MonadParsecDbg 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 a.
(forall (m :: * -> *). MonadParsecDbg Void String m => m a)
-> String
-> ((State String Void, Either (ParseErrorBundle String Void) a)
    -> Expectation)
-> Expectation
grs' forall (m :: * -> *). MonadParsecDbg 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 (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' forall (m :: * -> *). MonadParsecDbg Void String m => m a
p String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p ()) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
L.evalStateT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p ()) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT forall (m :: * -> *). MonadParsecDbg Void String m => m a
p ()) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTL forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall (m :: * -> *) a. Monad m => WriterT [Int] m a -> m a
evalWriterTS forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTL forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)
  (State String Void, Either (ParseErrorBundle String Void) a)
-> Expectation
r (forall a.
Parser a
-> String
-> (State String Void, Either (ParseErrorBundle String Void) a)
prs' (forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTS forall (m :: * -> *). MonadParsecDbg Void String m => m a
p) String
s)

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

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

evalRWSTL :: (Monad m) => L.RWST () [Int] () m a -> m a
evalRWSTL :: forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTL RWST () [Int] () m a
m = do
  (a
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 () ()
  forall (m :: * -> *) a. Monad m => a -> m a
return a
a

evalRWSTS :: (Monad m) => S.RWST () [Int] () m a -> m a
evalRWSTS :: forall (m :: * -> *) a. Monad m => RWST () [Int] () m a -> m a
evalRWSTS RWST () [Int] () m a
m = do
  (a
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 () ()
  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 :: forall a. a -> NonEmpty a
nes a
x = a
x 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 = forall a. Int -> a -> [a]
replicate Int
a Char
'a' forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
b Char
'b' forall a. [a] -> [a] -> [a]
++ 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' =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"produces the list in the right order" forall a b. (a -> b) -> a -> b
$
    forall a.
Parser a -> String -> Either (ParseErrorBundle String Void) a
prs_ Parser String
p String
s 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 :: forall e s (m :: * -> *). MonadParsec e s m => m Pos
getTabWidth = forall s. PosState s -> Pos
pstateTabWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. State s e -> PosState s
statePosState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall e s (m :: * -> *). MonadParsec e s m => Pos -> m ()
setTabWidth Pos
w = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState forall a b. (a -> b) -> a -> b
$ \State s e
st ->
  let pst :: PosState s
pst = 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 :: forall a. Gen a -> Gen a
scaleDown = forall a. (Int -> Int) -> Gen a -> Gen a
scale (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') = forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset forall a. Bounded a => a
maxBound PosState String
pstate in forall s. PosState s -> SourcePos
pstateSourcePos PosState String
pst'
  where
    pstate :: PosState String
pstate =
      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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
> Int
0xff
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)

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

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

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

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

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

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

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

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

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

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

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

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

instance (Arbitrary s) => Arbitrary (State s e) where
  arbitrary :: Gen (State s e)
arbitrary = do
    s
input <- forall a. Gen a -> Gen a
scaleDown forall a. Arbitrary a => Gen a
arbitrary
    Int
offset <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
10000)
    PosState s
pstate :: PosState s <- forall a. Arbitrary a => Gen a
arbitrary
    forall (m :: * -> *) a. Monad m => a -> m a
return
      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 =
    forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
10000)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Pos
mkPos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
20))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen a
scaleDown forall a. Arbitrary a => Gen a
arbitrary

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

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

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

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

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