{-# LANGUAGE FlexibleInstances, GADTs, RankNTypes, TypeOperators #-} module Text.Grampa.Internal (BinTree(..), FailureInfo(..), ResultList(..), ResultsOfLength(..), AmbiguousAlternative(..), AmbiguityDecidable(..), AmbiguityWitness(..), fromResultList, noFailure) where import Control.Applicative (Applicative(..), Alternative(..)) import Data.Foldable (toList) import Data.Functor.Classes (Show1(..)) import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.List (nub) import Data.Monoid (Monoid(mappend, mempty)) import Data.Semigroup (Semigroup((<>))) import Data.Type.Equality ((:~:)(Refl)) import Data.Witherable.Class (Filterable(mapMaybe)) import Data.Monoid.Factorial (FactorialMonoid, length) import Text.Grampa.Class (Ambiguous(..), Expected(..), ParseFailure(..), ParseResults) import Prelude hiding (length, showList) data FailureInfo s = FailureInfo Int [Expected s] deriving (FailureInfo s -> FailureInfo s -> Bool (FailureInfo s -> FailureInfo s -> Bool) -> (FailureInfo s -> FailureInfo s -> Bool) -> Eq (FailureInfo s) forall s. Eq s => FailureInfo s -> FailureInfo s -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: FailureInfo s -> FailureInfo s -> Bool $c/= :: forall s. Eq s => FailureInfo s -> FailureInfo s -> Bool == :: FailureInfo s -> FailureInfo s -> Bool $c== :: forall s. Eq s => FailureInfo s -> FailureInfo s -> Bool Eq, Int -> FailureInfo s -> ShowS [FailureInfo s] -> ShowS FailureInfo s -> String (Int -> FailureInfo s -> ShowS) -> (FailureInfo s -> String) -> ([FailureInfo s] -> ShowS) -> Show (FailureInfo s) forall s. Show s => Int -> FailureInfo s -> ShowS forall s. Show s => [FailureInfo s] -> ShowS forall s. Show s => FailureInfo s -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [FailureInfo s] -> ShowS $cshowList :: forall s. Show s => [FailureInfo s] -> ShowS show :: FailureInfo s -> String $cshow :: forall s. Show s => FailureInfo s -> String showsPrec :: Int -> FailureInfo s -> ShowS $cshowsPrec :: forall s. Show s => Int -> FailureInfo s -> ShowS Show) data ResultsOfLength g s r = ResultsOfLength !Int ![(s, g (ResultList g s))] !(NonEmpty r) data ResultList g s r = ResultList ![ResultsOfLength g s r] !(FailureInfo 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) fromResultList :: (Eq s, FactorialMonoid s) => s -> ResultList g s r -> ParseResults s [(s, r)] fromResultList :: s -> ResultList g s r -> ParseResults s [(s, r)] fromResultList s s (ResultList [] (FailureInfo Int pos [Expected s] msgs)) = ParseFailure s -> ParseResults s [(s, r)] forall a b. a -> Either a b Left (Int -> [Expected s] -> ParseFailure s forall s. Int -> [Expected s] -> ParseFailure s ParseFailure (s -> Int forall m. Factorial m => m -> Int length s s Int -> Int -> Int forall a. Num a => a -> a -> a - Int pos Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) ([Expected s] -> [Expected s] forall a. Eq a => [a] -> [a] nub [Expected s] msgs)) fromResultList s _ (ResultList [ResultsOfLength g s r] rl FailureInfo s _failure) = [(s, r)] -> ParseResults s [(s, r)] forall a b. b -> Either a b Right ((ResultsOfLength g s r -> [(s, r)]) -> [ResultsOfLength g s r] -> [(s, r)] forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap ResultsOfLength g s r -> [(s, r)] forall a (g :: (* -> *) -> *) b. Monoid a => ResultsOfLength g a b -> [(a, b)] f [ResultsOfLength g s r] rl) where f :: ResultsOfLength g a b -> [(a, b)] f (ResultsOfLength Int _ ((a s, g (ResultList g a) _):[(a, g (ResultList g a))] _) NonEmpty b r) = (,) a s (b -> (a, b)) -> [b] -> [(a, b)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NonEmpty b -> [b] forall (t :: * -> *) a. Foldable t => t a -> [a] toList NonEmpty b r f (ResultsOfLength Int _ [] NonEmpty b r) = (,) a forall a. Monoid a => a mempty (b -> (a, b)) -> [b] -> [(a, b)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NonEmpty b -> [b] forall (t :: * -> *) a. Foldable t => t a -> [a] toList NonEmpty b r {-# INLINABLE fromResultList #-} noFailure :: FailureInfo s noFailure :: FailureInfo s noFailure = Int -> [Expected s] -> FailureInfo s forall s. Int -> [Expected s] -> FailureInfo s FailureInfo Int forall a. Bounded a => a maxBound [] instance Semigroup (FailureInfo s) where FailureInfo Int pos1 [Expected s] exp1 <> :: FailureInfo s -> FailureInfo s -> FailureInfo s <> FailureInfo Int pos2 [Expected s] exp2 = Int -> [Expected s] -> FailureInfo s forall s. Int -> [Expected s] -> FailureInfo s FailureInfo Int pos' [Expected s] exp' where (Int pos', [Expected s] exp') | Int pos1 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int pos2 = (Int pos1, [Expected s] exp1) | Int pos1 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int pos2 = (Int pos2, [Expected s] exp2) | Bool otherwise = (Int pos1, [Expected s] exp1 [Expected s] -> [Expected s] -> [Expected s] forall a. Semigroup a => a -> a -> a <> [Expected s] exp2) instance Monoid (FailureInfo s) where mempty :: FailureInfo s mempty = Int -> [Expected s] -> FailureInfo s forall s. Int -> [Expected s] -> FailureInfo s FailureInfo Int forall a. Bounded a => a maxBound [] mappend :: FailureInfo s -> FailureInfo s -> FailureInfo s mappend = FailureInfo s -> FailureInfo s -> FailureInfo s forall a. Semigroup a => a -> a -> a (<>) instance (Show s, Show r) => Show (ResultList g s r) where show :: ResultList g s r -> String show (ResultList [ResultsOfLength g s r] l FailureInfo 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] ++ FailureInfo s -> ShowS forall a. Show a => a -> ShowS shows FailureInfo 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 FailureInfo 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) (FailureInfo s -> ShowS forall a. Show a => a -> ShowS shows FailureInfo 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 FailureInfo s failure) = [ResultsOfLength g s b] -> FailureInfo s -> ResultList g s b forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo 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) FailureInfo s failure {-# INLINE fmap #-} instance 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 Applicative (ResultList g s) where pure :: a -> ResultList g s a pure a a = [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r ResultList [a -> ResultsOfLength g s a forall (f :: * -> *) a. Applicative f => a -> f a pure a a] FailureInfo s forall a. Monoid a => a mempty ResultList [ResultsOfLength g s (a -> b)] rl1 FailureInfo s f1 <*> :: ResultList g s (a -> b) -> ResultList g s a -> ResultList g s b <*> ResultList [ResultsOfLength g s a] rl2 FailureInfo s f2 = [ResultsOfLength g s b] -> FailureInfo s -> ResultList g s b forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo 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) (FailureInfo s f1 FailureInfo s -> FailureInfo s -> FailureInfo s forall a. Semigroup a => a -> a -> a <> FailureInfo s f2) instance Alternative (ResultList g s) where empty :: ResultList g s a empty = [ResultsOfLength g s a] -> FailureInfo s -> ResultList g s a forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r ResultList [ResultsOfLength g s a] forall a. Monoid a => a mempty FailureInfo 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] l FailureInfo s failure) = [ResultsOfLength g s b] -> FailureInfo s -> ResultList g s b forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo 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] l) FailureInfo 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 Semigroup (ResultList g s r) where ResultList [ResultsOfLength g s r] rl1 FailureInfo s f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r <> ResultList [ResultsOfLength g s r] rl2 FailureInfo s f2 = [ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo 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) (FailureInfo s f1 FailureInfo s -> FailureInfo s -> FailureInfo s forall a. Semigroup a => a -> a -> a <> FailureInfo 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 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 FailureInfo s f1) (ResultList [ResultsOfLength g s (Ambiguous a)] rl2 FailureInfo s f2) = [ResultsOfLength g s (Ambiguous a)] -> FailureInfo s -> ResultList g s (Ambiguous a) forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo 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) (FailureInfo s f1 FailureInfo s -> FailureInfo s -> FailureInfo s forall a. Semigroup a => a -> a -> a <> FailureInfo 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 Monoid (ResultList g s r) where mempty :: ResultList g s r mempty = [ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r forall (g :: (* -> *) -> *) s r. [ResultsOfLength g s r] -> FailureInfo s -> ResultList g s r ResultList [ResultsOfLength g s r] forall a. Monoid a => a mempty FailureInfo 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 (<>)