{-# LANGUAGE ConstrainedClassMethods, FlexibleContexts, FlexibleInstances, GADTs, RankNTypes, TypeOperators #-} module Text.Grampa.Internal (BinTree(..), ResultList(..), ResultsOfLength(..), FallibleResults(..), AmbiguousAlternative(..), AmbiguityDecidable(..), AmbiguityWitness(..), TraceableParsing(..), noFailure, expected, erroneous) where import Control.Applicative (Applicative(..), Alternative(..)) import Data.Foldable (toList) import Data.Functor.Classes (Show1(..)) 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))] !(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 [BinTree a] -> ShowS BinTree a -> String (Int -> BinTree a -> ShowS) -> (BinTree a -> String) -> ([BinTree a] -> ShowS) -> Show (BinTree a) 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 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 = Maybe (AmbiguityWitness a) forall a. Maybe a Nothing instance AmbiguityDecidable (Ambiguous a) where ambiguityWitness :: Maybe (AmbiguityWitness (Ambiguous a)) ambiguityWitness = AmbiguityWitness (Ambiguous a) -> Maybe (AmbiguityWitness (Ambiguous a)) forall a. a -> Maybe a Just ((Ambiguous a :~: Ambiguous a) -> AmbiguityWitness (Ambiguous a) forall a b. (a :~: Ambiguous b) -> AmbiguityWitness a AmbiguityWitness Ambiguous a :~: Ambiguous a forall k (a :: k). a :~: a Refl) noFailure :: ParseFailure Pos s noFailure :: ParseFailure Pos s noFailure = Pos -> [FailureDescription s] -> [FailureDescription s] -> ParseFailure Pos s forall pos s. pos -> [FailureDescription s] -> [FailureDescription s] -> ParseFailure pos s ParseFailure (Int -> Pos forall a. a -> Down a Down Int forall a. Bounded a => a maxBound) [] [] expected :: Pos -> String -> ParseFailure Pos s expected :: Pos -> String -> ParseFailure Pos s expected Pos pos String msg = Pos -> [FailureDescription s] -> [FailureDescription s] -> ParseFailure Pos s forall pos s. pos -> [FailureDescription s] -> [FailureDescription s] -> ParseFailure pos s ParseFailure Pos pos [String -> FailureDescription s forall s. String -> FailureDescription s StaticDescription String msg] [] erroneous :: Pos -> String -> ParseFailure Pos s erroneous :: Pos -> String -> ParseFailure Pos s erroneous Pos pos String msg = Pos -> [FailureDescription s] -> [FailureDescription s] -> ParseFailure Pos s forall pos s. pos -> [FailureDescription s] -> [FailureDescription s] -> ParseFailure pos s ParseFailure Pos pos [] [String -> FailureDescription s forall s. String -> FailureDescription s StaticDescription String msg] 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 (" String -> ShowS forall a. [a] -> [a] -> [a] ++ [ResultsOfLength g s r] -> ShowS forall a. Show a => a -> ShowS shows [ResultsOfLength g s r] l (String ") (" String -> ShowS forall a. [a] -> [a] -> [a] ++ ParseFailure Pos s -> ShowS forall a. Show a => a -> ShowS shows ParseFailure Pos s f String ")") instance Show s => Show1 (ResultList g s) where liftShowsPrec :: (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 " String -> ShowS forall a. [a] -> [a] -> [a] ++ [String] -> ShowS forall a. Show a => a -> ShowS shows (ResultsOfLength g s a -> String simplify (ResultsOfLength g s a -> String) -> [ResultsOfLength g s a] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ResultsOfLength g s a] -> [ResultsOfLength g s a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList [ResultsOfLength g s a] rol) (ParseFailure Pos s -> ShowS 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 " String -> ShowS forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int l String -> ShowS forall a. Semigroup a => a -> a -> a <> String " _ " String -> ShowS forall a. Semigroup a => a -> a -> a <> [a] -> ShowS showList (NonEmpty a -> [a] 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 @" String -> ShowS forall a. [a] -> [a] -> [a] ++ Int -> String forall a. Show a => a -> String show Int l String -> ShowS forall a. [a] -> [a] -> [a] ++ String " " String -> ShowS forall a. [a] -> [a] -> [a] ++ NonEmpty r -> ShowS forall a. Show a => a -> ShowS shows NonEmpty r r String ")" instance Functor (ResultsOfLength g s) where fmap :: (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) = Int -> [(s, g (ResultList g s))] -> NonEmpty b -> ResultsOfLength g s b 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 (a -> b) -> NonEmpty a -> NonEmpty b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NonEmpty a r) {-# INLINE fmap #-} instance Functor (ResultList g s) where fmap :: (a -> b) -> ResultList g s a -> ResultList g s b fmap a -> b f (ResultList [ResultsOfLength g s a] l ParseFailure Pos s failure) = [ResultsOfLength g s b] -> ParseFailure Pos s -> ResultList g s b forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList ((a -> b f (a -> b) -> ResultsOfLength g s a -> ResultsOfLength g s b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) (ResultsOfLength g s a -> ResultsOfLength g s b) -> [ResultsOfLength g s a] -> [ResultsOfLength g s 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 :: a -> ResultsOfLength g s a pure = Int -> [(s, g (ResultList g s))] -> NonEmpty a -> ResultsOfLength g s a forall (g :: (* -> *) -> *) s r. Int -> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r ResultsOfLength Int 0 [(s, g (ResultList g s))] forall a. Monoid a => a mempty (NonEmpty a -> ResultsOfLength g s a) -> (a -> NonEmpty a) -> a -> ResultsOfLength g s a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> NonEmpty a forall (f :: * -> *) a. Applicative f => a -> f a pure ResultsOfLength Int l1 [(s, g (ResultList g s))] _ NonEmpty (a -> b) fs <*> :: 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 = Int -> [(s, g (ResultList g s))] -> NonEmpty b -> ResultsOfLength g s b forall (g :: (* -> *) -> *) s r. Int -> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r ResultsOfLength (Int l1 Int -> Int -> Int forall a. Num a => a -> a -> a + Int l2) [(s, g (ResultList g s))] t2 (NonEmpty (a -> b) fs NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b 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 :: a -> ResultList g s a pure a a = [ResultsOfLength g s a] -> ParseFailure Pos s -> ResultList g s a forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList [a -> ResultsOfLength g s a forall (f :: * -> *) a. Applicative f => a -> f a pure a a] ParseFailure Pos s forall a. Monoid a => a mempty ResultList [ResultsOfLength g s (a -> b)] rl1 ParseFailure Pos s f1 <*> :: ResultList g s (a -> b) -> ResultList g s a -> ResultList g s b <*> ResultList [ResultsOfLength g s a] rl2 ParseFailure Pos s f2 = [ResultsOfLength g s b] -> ParseFailure Pos s -> ResultList g s b forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList (ResultsOfLength g s (a -> b) -> ResultsOfLength g s a -> ResultsOfLength g s b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b (<*>) (ResultsOfLength g s (a -> b) -> ResultsOfLength g s a -> ResultsOfLength g s b) -> [ResultsOfLength g s (a -> b)] -> [ResultsOfLength g s a -> ResultsOfLength g s b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ResultsOfLength g s (a -> b)] rl1 [ResultsOfLength g s a -> ResultsOfLength g s b] -> [ResultsOfLength g s a] -> [ResultsOfLength g s b] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [ResultsOfLength g s a] rl2) (ParseFailure Pos s f1 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s forall a. Semigroup a => a -> a -> a <> ParseFailure Pos s f2) instance Ord s => Alternative (ResultList g s) where empty :: ResultList g s a empty = [ResultsOfLength g s a] -> ParseFailure Pos s -> ResultList g s a forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList [ResultsOfLength g s a] forall a. Monoid a => a mempty ParseFailure Pos s forall a. Monoid a => a mempty <|> :: ResultList g s a -> ResultList g s a -> ResultList g s 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 :: (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) = [ResultsOfLength g s b] -> ParseFailure Pos s -> ResultList g s b forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList ((ResultsOfLength g s a -> Maybe (ResultsOfLength g s b)) -> [ResultsOfLength g s a] -> [ResultsOfLength g s b] 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) = Int -> [(s, g (ResultList g s))] -> NonEmpty b -> ResultsOfLength g s b 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 (NonEmpty b -> ResultsOfLength g s b) -> Maybe (NonEmpty b) -> Maybe (ResultsOfLength g s b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [b] -> Maybe (NonEmpty b) forall a. [a] -> Maybe (NonEmpty a) nonEmpty ((a -> Maybe b) -> [a] -> [b] forall (f :: * -> *) a b. Filterable f => (a -> Maybe b) -> f a -> f b mapMaybe a -> Maybe b f ([a] -> [b]) -> [a] -> [b] forall a b. (a -> b) -> a -> b $ NonEmpty a -> [a] 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 = [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList ([ResultsOfLength g s r] -> [ResultsOfLength g s r] -> [ResultsOfLength g s r] 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 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s 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 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int l2 = ResultsOfLength g s r rol1 ResultsOfLength g s r -> [ResultsOfLength g s r] -> [ResultsOfLength g s r] 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 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int l2 = ResultsOfLength g s r rol2 ResultsOfLength g s r -> [ResultsOfLength g s r] -> [ResultsOfLength g s r] 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 = Int -> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r 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 NonEmpty r -> NonEmpty r -> NonEmpty r forall a. Semigroup a => a -> a -> a <> NonEmpty r r2) ResultsOfLength g s r -> [ResultsOfLength g s r] -> [ResultsOfLength g s r] 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 :: 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) = [ResultsOfLength g s (Ambiguous a)] -> ParseFailure Pos s -> ResultList g s (Ambiguous a) forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList ([ResultsOfLength g s (Ambiguous a)] -> [ResultsOfLength g s (Ambiguous a)] -> [ResultsOfLength g s (Ambiguous a)] 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 ParseFailure Pos s -> ParseFailure Pos s -> ParseFailure Pos s 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 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int l2 = ResultsOfLength g s (Ambiguous a) rol1 ResultsOfLength g s (Ambiguous a) -> [ResultsOfLength g s (Ambiguous a)] -> [ResultsOfLength g s (Ambiguous a)] 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 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int l2 = ResultsOfLength g s (Ambiguous a) rol2 ResultsOfLength g s (Ambiguous a) -> [ResultsOfLength g s (Ambiguous a)] -> [ResultsOfLength g s (Ambiguous a)] 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 = Int -> [(s, g (ResultList g s))] -> NonEmpty (Ambiguous a) -> ResultsOfLength g s (Ambiguous a) 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 ((Ambiguous a -> Ambiguous a -> Ambiguous a) -> NonEmpty (Ambiguous a) -> NonEmpty (Ambiguous a) -> NonEmpty (Ambiguous a) forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 Ambiguous a -> Ambiguous a -> Ambiguous a forall a. Ambiguous a -> Ambiguous a -> Ambiguous a collect NonEmpty (Ambiguous a) r1 NonEmpty (Ambiguous a) r2) ResultsOfLength g s (Ambiguous a) -> [ResultsOfLength g s (Ambiguous a)] -> [ResultsOfLength g s (Ambiguous a)] 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) = NonEmpty a -> Ambiguous a forall a. NonEmpty a -> Ambiguous a Ambiguous (NonEmpty a xs NonEmpty a -> NonEmpty a -> NonEmpty a 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 = [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r ResultList [ResultsOfLength g s r] forall a. Monoid a => a mempty ParseFailure Pos s forall a. Monoid a => a mempty mappend :: ResultList g s r -> ResultList g s r -> ResultList g s r mappend = ResultList g s r -> ResultList g s r -> ResultList g s r forall a. Semigroup a => a -> a -> a (<>) instance Functor BinTree where fmap :: (a -> b) -> BinTree a -> BinTree b fmap a -> b f (Fork BinTree a left BinTree a right) = BinTree b -> BinTree b -> BinTree b forall a. BinTree a -> BinTree a -> BinTree a Fork ((a -> b) -> BinTree a -> BinTree b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f BinTree a left) ((a -> b) -> BinTree a -> BinTree b 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) = b -> BinTree b forall a. a -> BinTree a Leaf (a -> b f a a) fmap a -> b _ BinTree a EmptyTree = BinTree b forall a. BinTree a EmptyTree instance Foldable BinTree where foldMap :: (a -> m) -> BinTree a -> m foldMap a -> m f (Fork BinTree a left BinTree a right) = (a -> m) -> BinTree a -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap a -> m f BinTree a left m -> m -> m forall a. Monoid a => a -> a -> a `mappend` (a -> m) -> BinTree a -> m 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 = m forall a. Monoid a => a mempty instance Traversable BinTree where traverse :: (a -> f b) -> BinTree a -> f (BinTree b) traverse a -> f b f (Fork BinTree a left BinTree a right) = BinTree b -> BinTree b -> BinTree b forall a. BinTree a -> BinTree a -> BinTree a Fork (BinTree b -> BinTree b -> BinTree b) -> f (BinTree b) -> f (BinTree b -> BinTree b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (a -> f b) -> BinTree a -> f (BinTree 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 f (BinTree b -> BinTree b) -> f (BinTree b) -> f (BinTree b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (a -> f b) -> BinTree a -> f (BinTree 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) = b -> BinTree b forall a. a -> BinTree a Leaf (b -> BinTree b) -> f b -> f (BinTree b) 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 = BinTree b -> f (BinTree b) forall (f :: * -> *) a. Applicative f => a -> f a pure BinTree b forall a. BinTree a EmptyTree instance Filterable BinTree where mapMaybe :: (a -> Maybe b) -> BinTree a -> BinTree b mapMaybe a -> Maybe b f (Fork BinTree a left BinTree a right) = (a -> Maybe b) -> BinTree a -> BinTree b forall (f :: * -> *) a b. Filterable f => (a -> Maybe b) -> f a -> f b mapMaybe a -> Maybe b f BinTree a left BinTree b -> BinTree b -> BinTree b forall a. Semigroup a => a -> a -> a <> (a -> Maybe b) -> BinTree a -> BinTree b 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) = BinTree b -> (b -> BinTree b) -> Maybe b -> BinTree b forall b a. b -> (a -> b) -> Maybe a -> b maybe BinTree b forall a. BinTree a EmptyTree b -> BinTree b forall a. a -> BinTree a Leaf (a -> Maybe b f a a) mapMaybe a -> Maybe b _ BinTree a EmptyTree = BinTree b 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 = BinTree a -> BinTree a -> BinTree a forall a. BinTree a -> BinTree a -> BinTree a Fork BinTree a l BinTree a r instance Monoid (BinTree a) where mempty :: BinTree a mempty = BinTree a forall a. BinTree a EmptyTree mappend :: BinTree a -> BinTree a -> BinTree a mappend = BinTree a -> BinTree a -> BinTree a 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 :: ResultList g s a -> Bool hasSuccess (ResultList [] ParseFailure Pos s _) = Bool False hasSuccess ResultList g s a _ = Bool True failureOf :: ResultList g s a -> ParseFailure Pos s failureOf (ResultList [ResultsOfLength g s a] _ ParseFailure Pos s failure) = ParseFailure Pos s failure failWith :: ParseFailure Pos s -> ResultList g s a failWith = [ResultsOfLength g s a] -> ParseFailure Pos s -> ResultList g s a 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 = (ParserInput m -> String) -> m a -> m a forall (m :: * -> *) a. TraceableParsing m => (ParserInput m -> String) -> m a -> m a traceInput (\ParserInput m input-> String description String -> ShowS forall a. Semigroup a => a -> a -> a <> String " @ " String -> ShowS forall a. Semigroup a => a -> a -> a <> ParserInput m -> String forall a. Show a => a -> String show ParserInput m input)