{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}

module Common (module Common, module X) where

import           Control.Applicative   as X
import           Control.DeepSeq       as X (NFData (rnf))
import           Control.Exception     as X (ArithException (Overflow, Underflow), throw)
import           Control.Monad         as X
import           Control.Newtype       as X (Newtype (..))
import           Data.Bits             as X
import           Data.ByteString       as X (ByteString)
import           Data.ByteString.Short as X (ShortByteString)
import           Data.Foldable         as X (asum)
import           Data.Functor.Identity as X
import           Data.Int              as X
import           Data.IntCast          as X
import           Data.List.NonEmpty    as X (NonEmpty (..), (<|))
import           Data.Maybe            as X
import           Data.Proxy            as X (Proxy (Proxy))
import           Data.Semigroup        as X
import           Data.Text             as X (Text)
import           Data.Text.Short       as X (ShortText)
import           Data.Word             as X
import           GHC.Generics          as X (Generic)
import           GHC.TypeLits          as X hiding (Text)
import           Numeric.Natural       as X (Natural)

import qualified Text.Parsec           as P

{-# INLINE rwhnf #-}
rwhnf :: a -> ()
rwhnf :: a -> ()
rwhnf x :: a
x = a -> () -> ()
forall a b. a -> b -> b
seq a
x ()

{-# INLINE inside #-}
inside :: Ord a => a -> (a, a) -> Bool
x :: a
x inside :: a -> (a, a) -> Bool
`inside` (lb :: a
lb,ub :: a
ub)
  | a
lb a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
ub = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error "inside: unsatifiable range"
  | Bool
otherwise = a
lb a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
ub

impossible :: a
impossible :: a
impossible = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "The impossible just happened!"

sepBy1' :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m sep -> P.ParsecT s u m (NonEmpty a)
sepBy1' :: ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m (NonEmpty a)
sepBy1' p :: ParsecT s u m a
p set :: ParsecT s u m sep
set = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
f ([a] -> NonEmpty a)
-> ParsecT s u m [a] -> ParsecT s u m (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy1 ParsecT s u m a
p ParsecT s u m sep
set
  where
    f :: [a] -> NonEmpty a
f []     = NonEmpty a
forall a. a
impossible
    f (x :: a
x:xs :: [a]
xs) = a
xa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[a]
xs