{-# LANGUAGE FlexibleInstances, RankNTypes #-}

module Text.Grampa.Internal (BinTree(..), FailureInfo(..), ResultList(..), ResultsOfLength(..),
                             AmbiguousAlternative(..),
                             fromResultList, noFailure) where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Foldable (toList)
import Data.Functor.Classes (Show1(..))
import Data.List.NonEmpty (NonEmpty)
import Data.List (nub)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Semigroup (Semigroup((<>)))

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)

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
s (ResultList [] (FailureInfo pos :: Int
pos msgs :: [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
+ 1) ([Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub [Expected s]
msgs))
fromResultList _ (ResultList rl :: [ResultsOfLength g s r]
rl _failure :: 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 _ ((s :: a
s, _):_) r :: 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 _ [] r :: 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 pos1 :: Int
pos1 exp1 :: [Expected s]
exp1 <> :: FailureInfo s -> FailureInfo s -> FailureInfo s
<> FailureInfo pos2 :: Int
pos2 exp2 :: [Expected s]
exp2 = Int -> [Expected s] -> FailureInfo s
forall s. Int -> [Expected s] -> FailureInfo s
FailureInfo Int
pos' [Expected s]
exp'
      where (pos' :: Int
pos', exp' :: [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 l :: [ResultsOfLength g s r]
l f :: FailureInfo s
f) = "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 -> ShowS
forall a. [a] -> [a] -> [a]
++ FailureInfo s -> ShowS
forall a. Show a => a -> ShowS
shows FailureInfo s
f ")")

instance Show s => Show1 (ResultList g s) where
   liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ResultList g s a -> ShowS
liftShowsPrec _sp :: Int -> a -> ShowS
_sp showList :: [a] -> ShowS
showList _prec :: Int
_prec (ResultList rol :: [ResultsOfLength g s a]
rol f :: FailureInfo s
f) rest :: String
rest = 
      "ResultList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> ShowS
forall a. Show a => a -> ShowS
shows (ResultsOfLength g s a -> String
forall (g :: (* -> *) -> *) s. 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 l :: Int
l _ r :: NonEmpty a
r) = "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 -> 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) ""

instance Show r => Show (ResultsOfLength g s r) where
   show :: ResultsOfLength g s r -> String
show (ResultsOfLength l :: Int
l _ r :: NonEmpty r
r) = "(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 -> ShowS
forall a. [a] -> [a] -> [a]
++ NonEmpty r -> ShowS
forall a. Show a => a -> ShowS
shows NonEmpty r
r ")"

instance Functor (ResultsOfLength g s) where
   fmap :: (a -> b) -> ResultsOfLength g s a -> ResultsOfLength g s b
fmap f :: a -> b
f (ResultsOfLength l :: Int
l t :: [(s, g (ResultList g s))]
t r :: 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 f :: a -> b
f (ResultList l :: [ResultsOfLength g s a]
l failure :: 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 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 l1 :: Int
l1 _ fs :: NonEmpty (a -> b)
fs <*> :: ResultsOfLength g s (a -> b)
-> ResultsOfLength g s a -> ResultsOfLength g s b
<*> ResultsOfLength l2 :: Int
l2 t2 :: [(s, g (ResultList g s))]
t2 xs :: 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
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 rl1 :: [ResultsOfLength g s (a -> b)]
rl1 f1 :: FailureInfo s
f1 <*> :: ResultList g s (a -> b) -> ResultList g s a -> ResultList g s b
<*> ResultList rl2 :: [ResultsOfLength g s a]
rl2 f2 :: 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 Semigroup (ResultList g s r) where
   ResultList rl1 :: [ResultsOfLength g s r]
rl1 f1 :: FailureInfo s
f1 <> :: ResultList g s r -> ResultList g s r -> ResultList g s r
<> ResultList rl2 :: [ResultsOfLength g s r]
rl2 f2 :: 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 [] rl :: [ResultsOfLength g s r]
rl = [ResultsOfLength g s r]
rl
            merge rl :: [ResultsOfLength g s r]
rl [] = [ResultsOfLength g s r]
rl
            merge rl1' :: [ResultsOfLength g s r]
rl1'@(rol1 :: ResultsOfLength g s r
rol1@(ResultsOfLength l1 :: Int
l1 s1 :: [(s, g (ResultList g s))]
s1 r1 :: NonEmpty r
r1) : rest1 :: [ResultsOfLength g s r]
rest1) rl2' :: [ResultsOfLength g s r]
rl2'@(rol2 :: ResultsOfLength g s r
rol2@(ResultsOfLength l2 :: Int
l2 _ r2 :: NonEmpty r
r2) : rest2 :: [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 rl1 :: [ResultsOfLength g s (Ambiguous a)]
rl1 f1 :: FailureInfo s
f1) (ResultList rl2 :: [ResultsOfLength g s (Ambiguous a)]
rl2 f2 :: 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 [] rl :: [ResultsOfLength g s (Ambiguous a)]
rl = [ResultsOfLength g s (Ambiguous a)]
rl
            merge rl :: [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 l1 :: Int
l1 s1 :: [(s, g (ResultList g s))]
s1 r1 :: NonEmpty (Ambiguous a)
r1) : rest1 :: [ResultsOfLength g s (Ambiguous a)]
rest1) rl2' :: [ResultsOfLength g s (Ambiguous a)]
rl2'@(rol2 :: ResultsOfLength g s (Ambiguous a)
rol2@(ResultsOfLength l2 :: Int
l2 _ r2 :: NonEmpty (Ambiguous a)
r2) : rest2 :: [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 xs :: NonEmpty a
xs) (Ambiguous ys :: 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 f :: a -> b
f (Fork left :: BinTree a
left right :: 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 f :: a -> b
f (Leaf a :: a
a) = b -> BinTree b
forall a. a -> BinTree a
Leaf (a -> b
f a
a)
   fmap _ EmptyTree = BinTree b
forall a. BinTree a
EmptyTree

instance Foldable BinTree where
   foldMap :: (a -> m) -> BinTree a -> m
foldMap f :: a -> m
f (Fork left :: BinTree a
left right :: 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 f :: a -> m
f (Leaf a :: a
a) = a -> m
f a
a
   foldMap _ EmptyTree = m
forall a. Monoid a => a
mempty

instance Semigroup (BinTree a) where
   EmptyTree <> :: BinTree a -> BinTree a -> BinTree a
<> t :: BinTree a
t = BinTree a
t
   t :: BinTree a
t <> EmptyTree = BinTree a
t
   l :: BinTree a
l <> r :: 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
(<>)