{-# LANGUAGE ConstrainedClassMethods, FlexibleContexts, FlexibleInstances, GADTs,
             RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}

module Text.Grampa.Internal (BinTree(..), ResultList(..), ResultsOfLength(..), FallibleResults(..),
                             AmbiguousAlternative(..), AmbiguityDecidable(..), AmbiguityWitness(..),
                             ParserFlags (ParserFlags, nullable, dependsOn),
                             Dependencies (DynamicDependencies, StaticDependencies),
                             TraceableParsing(..),
                             emptyFailure, erroneous, expected, expectedInput, replaceExpected, noFailure) where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.Functor.Const (Const)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Ord (Down(Down))
import Data.Semigroup (Semigroup((<>)))
import Data.Type.Equality ((:~:)(Refl))
import Witherable (Filterable(mapMaybe))

import Text.Grampa.Class (Ambiguous(..), FailureDescription(..), ParseFailure(..), InputParsing(..), Pos)

import Prelude hiding (length, showList)

data ResultsOfLength g s r = ResultsOfLength !Int ![(s, g (ResultList g s))] {-# UNPACK #-} !(NonEmpty r)

data ResultList g s r = ResultList ![ResultsOfLength g s r] (ParseFailure Pos s)

data BinTree a = Fork !(BinTree a) !(BinTree a)
               | Leaf !a
               | EmptyTree
               deriving (Int -> BinTree a -> ShowS
forall a. Show a => Int -> BinTree a -> ShowS
forall a. Show a => [BinTree a] -> ShowS
forall a. Show a => BinTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinTree a] -> ShowS
$cshowList :: forall a. Show a => [BinTree a] -> ShowS
show :: BinTree a -> String
$cshow :: forall a. Show a => BinTree a -> String
showsPrec :: Int -> BinTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BinTree a -> ShowS
Show)

data ParserFlags g = ParserFlags {
   forall (g :: (* -> *) -> *). ParserFlags g -> Bool
nullable :: Bool,
   forall (g :: (* -> *) -> *). ParserFlags g -> Dependencies g
dependsOn :: Dependencies g}

data Dependencies g = DynamicDependencies
                    | StaticDependencies (g (Const Bool))

deriving instance Show (g (Const Bool)) => Show (Dependencies g)

data AmbiguityWitness a where
   AmbiguityWitness :: (a :~: Ambiguous b) -> AmbiguityWitness a

class AmbiguityDecidable a where
   ambiguityWitness :: Maybe (AmbiguityWitness a)

instance {-# overlappable #-} AmbiguityDecidable a where
   ambiguityWitness :: Maybe (AmbiguityWitness a)
ambiguityWitness = forall a. Maybe a
Nothing

instance AmbiguityDecidable (Ambiguous a) where
   ambiguityWitness :: Maybe (AmbiguityWitness (Ambiguous a))
ambiguityWitness = forall a. a -> Maybe a
Just (forall a b. (a :~: Ambiguous b) -> AmbiguityWitness a
AmbiguityWitness forall {k} (a :: k). a :~: a
Refl)

noFailure :: ParseFailure Pos s
noFailure :: forall s. ParseFailure Pos s
noFailure = forall s. Pos -> ParseFailure Pos s
emptyFailure (forall a. a -> Down a
Down forall a. Bounded a => a
maxBound)

emptyFailure :: Pos -> ParseFailure Pos s
emptyFailure :: forall s. Pos -> ParseFailure Pos s
emptyFailure Pos
pos = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [] []) []

expected :: Pos -> String -> ParseFailure Pos s
expected :: forall s. Pos -> String -> ParseFailure Pos s
expected Pos
pos String
msg = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String
msg] []) []

expectedInput :: Pos -> s -> ParseFailure Pos s
expectedInput :: forall s. Pos -> s -> ParseFailure Pos s
expectedInput Pos
pos s
s = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [] [s
s]) []

erroneous :: Pos -> String -> ParseFailure Pos s
erroneous :: forall s. Pos -> String -> ParseFailure Pos s
erroneous Pos
pos String
msg = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos (forall s. [String] -> [s] -> FailureDescription s
FailureDescription [] []) [String
msg]

replaceExpected :: Pos -> String -> ParseFailure Pos s -> ParseFailure Pos s
replaceExpected :: forall s. Pos -> String -> ParseFailure Pos s -> ParseFailure Pos s
replaceExpected Pos
pos String
msg (ParseFailure Pos
pos' FailureDescription s
msgs [String]
errs) = forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure Pos
pos' FailureDescription s
msgs' [String]
errs
   where msgs' :: FailureDescription s
msgs' | Pos
pos forall a. Eq a => a -> a -> Bool
== Pos
pos' = forall s. [String] -> [s] -> FailureDescription s
FailureDescription [String
msg] []
               | Bool
otherwise = FailureDescription s
msgs

instance (Show s, Show r) => Show (ResultList g s r) where
   show :: ResultList g s r -> String
show (ResultList [ResultsOfLength g s r]
l ParseFailure Pos s
f) = String
"ResultList (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows [ResultsOfLength g s r]
l (String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows ParseFailure Pos s
f String
")")

instance Show s => Show1 (ResultList g s) where
   liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList g s a -> ShowS
liftShowsPrec Int -> a -> ShowS
_sp [a] -> ShowS
showList Int
_prec (ResultList [ResultsOfLength g s a]
rol ParseFailure Pos s
f) String
rest = 
      String
"ResultList " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows (ResultsOfLength g s a -> String
simplify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [ResultsOfLength g s a]
rol) (forall a. Show a => a -> ShowS
shows ParseFailure Pos s
f String
rest)
      where simplify :: ResultsOfLength g s a -> String
simplify (ResultsOfLength Int
l [(s, g (ResultList g s))]
_ NonEmpty a
r) = String
"ResultsOfLength " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
l forall a. Semigroup a => a -> a -> a
<> String
" _ " forall a. Semigroup a => a -> a -> a
<> [a] -> ShowS
showList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
r) String
""

instance Show r => Show (ResultsOfLength g s r) where
   show :: ResultsOfLength g s r -> String
show (ResultsOfLength Int
l [(s, g (ResultList g s))]
_ NonEmpty r
r) = String
"(ResultsOfLength @" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ShowS
shows NonEmpty r
r String
")"

instance Functor (ResultsOfLength g s) where
   fmap :: forall a b.
(a -> b) -> ResultsOfLength g s a -> ResultsOfLength g s b
fmap a -> b
f (ResultsOfLength Int
l [(s, g (ResultList g s))]
t NonEmpty a
r) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
t (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
r)
   {-# INLINE fmap #-}

instance Functor (ResultList g s) where
   fmap :: forall a b. (a -> b) -> ResultList g s a -> ResultList g s b
fmap a -> b
f (ResultList [ResultsOfLength g s a]
l ParseFailure Pos s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList ((a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s a]
l) ParseFailure Pos s
failure
   {-# INLINE fmap #-}

instance Ord s => Applicative (ResultsOfLength g s) where
   pure :: forall a. a -> ResultsOfLength g s a
pure = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
0 forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   ResultsOfLength Int
l1 [(s, g (ResultList g s))]
_ NonEmpty (a -> b)
fs <*> :: forall a b.
ResultsOfLength g s (a -> b)
-> ResultsOfLength g s a -> ResultsOfLength g s b
<*> ResultsOfLength Int
l2 [(s, g (ResultList g s))]
t2 NonEmpty a
xs = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength (Int
l1 forall a. Num a => a -> a -> a
+ Int
l2) [(s, g (ResultList g s))]
t2 (NonEmpty (a -> b)
fs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty a
xs)

instance Ord s => Applicative (ResultList g s) where
   pure :: forall a. a -> ResultList g s a
pure a
a = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList [forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a] forall a. Monoid a => a
mempty
   ResultList [ResultsOfLength g s (a -> b)]
rl1 ParseFailure Pos s
f1 <*> :: forall a b.
ResultList g s (a -> b) -> ResultList g s a -> ResultList g s b
<*> ResultList [ResultsOfLength g s a]
rl2 ParseFailure Pos s
f2 = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResultsOfLength g s (a -> b)]
rl1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ResultsOfLength g s a]
rl2) (ParseFailure Pos s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)

instance Ord s => Alternative (ResultList g s) where
   empty :: forall a. ResultList g s a
empty = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
   <|> :: forall a. ResultList g s a -> ResultList g s a -> ResultList g s a
(<|>) = forall a. Semigroup a => a -> a -> a
(<>)

instance Filterable (ResultList g s) where
   mapMaybe :: forall a b. (a -> Maybe b) -> ResultList g s a -> ResultList g s b
mapMaybe a -> Maybe b
f (ResultList [ResultsOfLength g s a]
rols ParseFailure Pos s
failure) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ResultsOfLength g s a -> Maybe (ResultsOfLength g s b)
maybeROL [ResultsOfLength g s a]
rols) ParseFailure Pos s
failure
      where maybeROL :: ResultsOfLength g s a -> Maybe (ResultsOfLength g s b)
maybeROL (ResultsOfLength Int
l [(s, g (ResultList g s))]
t NonEmpty a
rs) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l [(s, g (ResultList g s))]
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
rs)
   {-# INLINE mapMaybe #-}

instance Ord s => Semigroup (ResultList g s r) where
   ResultList [ResultsOfLength g s r]
rl1 ParseFailure Pos s
f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r
<> ResultList [ResultsOfLength g s r]
rl2 ParseFailure Pos s
f2 = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {r}.
[ResultsOfLength g s r]
-> [ResultsOfLength g s r] -> [ResultsOfLength g s r]
merge [ResultsOfLength g s r]
rl1 [ResultsOfLength g s r]
rl2) (ParseFailure Pos s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)
      where merge :: [ResultsOfLength g s r]
-> [ResultsOfLength g s r] -> [ResultsOfLength g s r]
merge [] [ResultsOfLength g s r]
rl = [ResultsOfLength g s r]
rl
            merge [ResultsOfLength g s r]
rl [] = [ResultsOfLength g s r]
rl
            merge rl1' :: [ResultsOfLength g s r]
rl1'@(rol1 :: ResultsOfLength g s r
rol1@(ResultsOfLength Int
l1 [(s, g (ResultList g s))]
s1 NonEmpty r
r1) : [ResultsOfLength g s r]
rest1) rl2' :: [ResultsOfLength g s r]
rl2'@(rol2 :: ResultsOfLength g s r
rol2@(ResultsOfLength Int
l2 [(s, g (ResultList g s))]
_ NonEmpty r
r2) : [ResultsOfLength g s r]
rest2)
               | Int
l1 forall a. Ord a => a -> a -> Bool
< Int
l2 = ResultsOfLength g s r
rol1 forall a. a -> [a] -> [a]
: [ResultsOfLength g s r]
-> [ResultsOfLength g s r] -> [ResultsOfLength g s r]
merge [ResultsOfLength g s r]
rest1 [ResultsOfLength g s r]
rl2'
               | Int
l1 forall a. Ord a => a -> a -> Bool
> Int
l2 = ResultsOfLength g s r
rol2 forall a. a -> [a] -> [a]
: [ResultsOfLength g s r]
-> [ResultsOfLength g s r] -> [ResultsOfLength g s r]
merge [ResultsOfLength g s r]
rl1' [ResultsOfLength g s r]
rest2
               | Bool
otherwise = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l1 [(s, g (ResultList g s))]
s1 (NonEmpty r
r1 forall a. Semigroup a => a -> a -> a
<> NonEmpty r
r2) forall a. a -> [a] -> [a]
: [ResultsOfLength g s r]
-> [ResultsOfLength g s r] -> [ResultsOfLength g s r]
merge [ResultsOfLength g s r]
rest1 [ResultsOfLength g s r]
rest2

instance Ord s => AmbiguousAlternative (ResultList g s) where
   ambiguousOr :: forall a.
ResultList g s (Ambiguous a)
-> ResultList g s (Ambiguous a) -> ResultList g s (Ambiguous a)
ambiguousOr (ResultList [ResultsOfLength g s (Ambiguous a)]
rl1 ParseFailure Pos s
f1) (ResultList [ResultsOfLength g s (Ambiguous a)]
rl2 ParseFailure Pos s
f2) = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList (forall {g :: (* -> *) -> *} {s} {a}.
[ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
merge [ResultsOfLength g s (Ambiguous a)]
rl1 [ResultsOfLength g s (Ambiguous a)]
rl2) (ParseFailure Pos s
f1 forall a. Semigroup a => a -> a -> a
<> ParseFailure Pos s
f2)
      where merge :: [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
merge [] [ResultsOfLength g s (Ambiguous a)]
rl = [ResultsOfLength g s (Ambiguous a)]
rl
            merge [ResultsOfLength g s (Ambiguous a)]
rl [] = [ResultsOfLength g s (Ambiguous a)]
rl
            merge rl1' :: [ResultsOfLength g s (Ambiguous a)]
rl1'@(rol1 :: ResultsOfLength g s (Ambiguous a)
rol1@(ResultsOfLength Int
l1 [(s, g (ResultList g s))]
s1 NonEmpty (Ambiguous a)
r1) : [ResultsOfLength g s (Ambiguous a)]
rest1) rl2' :: [ResultsOfLength g s (Ambiguous a)]
rl2'@(rol2 :: ResultsOfLength g s (Ambiguous a)
rol2@(ResultsOfLength Int
l2 [(s, g (ResultList g s))]
_ NonEmpty (Ambiguous a)
r2) : [ResultsOfLength g s (Ambiguous a)]
rest2)
               | Int
l1 forall a. Ord a => a -> a -> Bool
< Int
l2 = ResultsOfLength g s (Ambiguous a)
rol1 forall a. a -> [a] -> [a]
: [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
merge [ResultsOfLength g s (Ambiguous a)]
rest1 [ResultsOfLength g s (Ambiguous a)]
rl2'
               | Int
l1 forall a. Ord a => a -> a -> Bool
> Int
l2 = ResultsOfLength g s (Ambiguous a)
rol2 forall a. a -> [a] -> [a]
: [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
merge [ResultsOfLength g s (Ambiguous a)]
rl1' [ResultsOfLength g s (Ambiguous a)]
rest2
               | Bool
otherwise = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength Int
l1 [(s, g (ResultList g s))]
s1 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {a}. Ambiguous a -> Ambiguous a -> Ambiguous a
collect NonEmpty (Ambiguous a)
r1 NonEmpty (Ambiguous a)
r2) forall a. a -> [a] -> [a]
: [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
-> [ResultsOfLength g s (Ambiguous a)]
merge [ResultsOfLength g s (Ambiguous a)]
rest1 [ResultsOfLength g s (Ambiguous a)]
rest2
            collect :: Ambiguous a -> Ambiguous a -> Ambiguous a
collect (Ambiguous NonEmpty a
xs) (Ambiguous NonEmpty a
ys) = forall a. NonEmpty a -> Ambiguous a
Ambiguous (NonEmpty a
xs forall a. Semigroup a => a -> a -> a
<> NonEmpty a
ys)

class Alternative f => AmbiguousAlternative f where
   ambiguousOr :: f (Ambiguous a) -> f (Ambiguous a) -> f (Ambiguous a)

instance Ord s => Monoid (ResultList g s r) where
   mempty :: ResultList g s r
mempty = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
   mappend :: ResultList g s r -> ResultList g s r -> ResultList g s r
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Functor BinTree where
   fmap :: forall a b. (a -> b) -> BinTree a -> BinTree b
fmap a -> b
f (Fork BinTree a
left BinTree a
right) = forall a. BinTree a -> BinTree a -> BinTree a
Fork (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinTree a
left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinTree a
right)
   fmap a -> b
f (Leaf a
a) = forall a. a -> BinTree a
Leaf (a -> b
f a
a)
   fmap a -> b
_ BinTree a
EmptyTree = forall a. BinTree a
EmptyTree

instance Applicative BinTree where
  pure :: forall a. a -> BinTree a
pure = forall a. a -> BinTree a
Leaf
  BinTree (a -> b)
EmptyTree <*> :: forall a b. BinTree (a -> b) -> BinTree a -> BinTree b
<*> BinTree a
_ = forall a. BinTree a
EmptyTree
  Leaf a -> b
f <*> BinTree a
t = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinTree a
t
  Fork BinTree (a -> b)
f1 BinTree (a -> b)
f2 <*> BinTree a
t = forall a. BinTree a -> BinTree a -> BinTree a
Fork (BinTree (a -> b)
f1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinTree a
t) (BinTree (a -> b)
f2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinTree a
t)

instance Foldable BinTree where
   foldMap :: forall m a. Monoid m => (a -> m) -> BinTree a -> m
foldMap a -> m
f (Fork BinTree a
left BinTree a
right) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f BinTree a
left forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f BinTree a
right
   foldMap a -> m
f (Leaf a
a) = a -> m
f a
a
   foldMap a -> m
_ BinTree a
EmptyTree = forall a. Monoid a => a
mempty

instance Traversable BinTree where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinTree a -> f (BinTree b)
traverse a -> f b
f (Fork BinTree a
left BinTree a
right) = forall a. BinTree a -> BinTree a -> BinTree a
Fork forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f BinTree a
left forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f BinTree a
right
   traverse a -> f b
f (Leaf a
a) = forall a. a -> BinTree a
Leaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
   traverse a -> f b
_ BinTree a
EmptyTree = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. BinTree a
EmptyTree

instance Filterable BinTree where
   mapMaybe :: forall a b. (a -> Maybe b) -> BinTree a -> BinTree b
mapMaybe a -> Maybe b
f (Fork BinTree a
left BinTree a
right) = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f BinTree a
left forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f BinTree a
right
   mapMaybe a -> Maybe b
f (Leaf a
a) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. BinTree a
EmptyTree forall a. a -> BinTree a
Leaf (a -> Maybe b
f a
a)
   mapMaybe a -> Maybe b
_ BinTree a
EmptyTree = forall a. BinTree a
EmptyTree

instance Semigroup (BinTree a) where
   BinTree a
EmptyTree <> :: BinTree a -> BinTree a -> BinTree a
<> BinTree a
t = BinTree a
t
   BinTree a
t <> BinTree a
EmptyTree = BinTree a
t
   BinTree a
l <> BinTree a
r = forall a. BinTree a -> BinTree a -> BinTree a
Fork BinTree a
l BinTree a
r

instance Monoid (BinTree a) where
   mempty :: BinTree a
mempty = forall a. BinTree a
EmptyTree
   mappend :: BinTree a -> BinTree a -> BinTree a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

class FallibleResults f where
   hasSuccess   :: f s a -> Bool
   failureOf    :: f s a -> ParseFailure Pos s
   failWith     :: ParseFailure Pos s -> f s a

instance FallibleResults (ResultList g) where
   hasSuccess :: forall s a. ResultList g s a -> Bool
hasSuccess (ResultList [] ParseFailure Pos s
_) = Bool
False
   hasSuccess ResultList g s a
_ = Bool
True
   failureOf :: forall s a. ResultList g s a -> ParseFailure Pos s
failureOf (ResultList [ResultsOfLength g s a]
_ ParseFailure Pos s
failure) = ParseFailure Pos s
failure
   failWith :: forall s a. ParseFailure Pos s -> ResultList g s a
failWith = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList []

class InputParsing m => TraceableParsing m where
   traceInput :: (ParserInput m -> String) -> m a -> m a
   traceAs :: Show (ParserInput m) => String -> m a -> m a
   traceAs String
description = forall (m :: * -> *) a.
TraceableParsing m =>
(ParserInput m -> String) -> m a -> m a
traceInput (\ParserInput m
input-> String
description forall a. Semigroup a => a -> a -> a
<> String
" @ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParserInput m
input)