module Text.Trifecta.Parser.Result ( Result(..) ) where import Control.Applicative import Data.Semigroup import Data.Foldable import Data.Functor.Apply import Data.Functor.Plus import Data.Traversable import Data.Bifunctor import Data.Sequence as Seq import Text.Trifecta.Diagnostic.Prim import Text.PrettyPrint.Free import System.Console.Terminfo.PrettyPrint data Result e a = Success !(Seq (Diagnostic e)) a | Failure !(Seq (Diagnostic e)) deriving Show instance (Pretty e, Show a) => Pretty (Result e a) where pretty (Success xs a) | Seq.null xs = pretty (show a) | otherwise = prettyList (toList xs) `above` pretty (show a) pretty (Failure xs) = prettyList $ toList xs instance (PrettyTerm e, Show a) => PrettyTerm (Result e a) where prettyTerm (Success xs a) | Seq.null xs = pretty (show a) | otherwise = prettyTermList (toList xs) `above` pretty (show a) prettyTerm (Failure xs) = prettyTermList $ toList xs instance Functor (Result e) where fmap f (Success xs a) = Success xs (f a) fmap _ (Failure xs) = Failure xs instance Bifunctor Result where bimap f g (Success xs a) = Success (fmap (fmap f) xs) (g a) bimap f _ (Failure xs) = Failure (fmap (fmap f) xs) instance Foldable (Result e) where foldMap f (Success _ a) = f a foldMap _ (Failure _) = mempty instance Traversable (Result e) where traverse f (Success xs a) = Success xs <$> f a traverse _ (Failure xs) = pure $ Failure xs instance Applicative (Result e) where pure = Success mempty Success xs f <*> Success ys a = Success (xs <> ys) (f a) Success xs _ <*> Failure ys = Failure (xs <> ys) Failure xs <*> Success ys _ = Failure (xs <> ys) Failure xs <*> Failure ys = Failure (xs <> ys) instance Apply (Result e) where (<.>) = (<*>) instance Alt (Result e) where Failure xs <!> Failure ys = Failure (xs <> ys) Success xs a <!> Success ys _ = Success (xs <> ys) a Success xs a <!> Failure ys = Success (xs <> ys) a Failure xs <!> Success ys a = Success (xs <> ys) a instance Plus (Result e) where zero = Failure mempty instance Alternative (Result e) where (<|>) = (<!>) empty = zero