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