packages feed

trifecta 0.11 → 0.12

raw patch · 27 files changed

+1152/−824 lines, 27 files

Files

Text/Trifecta.hs view
@@ -1,33 +1,43 @@ module Text.Trifecta -  ( module Text.Trifecta.It+  ( module Text.Trifecta.Bytes+  , module Text.Trifecta.Delta+  , module Text.Trifecta.Diagnostic+  , module Text.Trifecta.Diagnostic.Level   , module Text.Trifecta.Hunk+  , module Text.Trifecta.It+  , module Text.Trifecta.Parser.Char+  , module Text.Trifecta.Parser.Class+  , module Text.Trifecta.Parser.Err+  , module Text.Trifecta.Parser.Err.State+  , module Text.Trifecta.Parser.Prim+  , module Text.Trifecta.Parser.Result+  , module Text.Trifecta.Parser.Step   , module Text.Trifecta.Path+  , module Text.Trifecta.Render.Caret+  , module Text.Trifecta.Render.Fixit+  , module Text.Trifecta.Render.Span   , module Text.Trifecta.Rope-  , module Text.Trifecta.Bytes-  , module Text.Trifecta.Caret-  , module Text.Trifecta.Span-  , module Text.Trifecta.Fixit-  , module Text.Trifecta.Delta-  , module Text.Trifecta.Slice   , module Text.Trifecta.Strand-  , module Text.Trifecta.Supply-  , module Text.Trifecta.Render-  , module Text.Trifecta.Rendered-  , module Text.Trifecta.Diagnostic+  , module Text.Trifecta.Util.MaybePair   ) where -import Text.Trifecta.It+import Text.Trifecta.Bytes+import Text.Trifecta.Delta+import Text.Trifecta.Diagnostic+import Text.Trifecta.Diagnostic.Level import Text.Trifecta.Hunk+import Text.Trifecta.It+import Text.Trifecta.Parser.Char+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Err+import Text.Trifecta.Parser.Err.State+import Text.Trifecta.Parser.Prim+import Text.Trifecta.Parser.Result+import Text.Trifecta.Parser.Step import Text.Trifecta.Path+import Text.Trifecta.Render.Caret+import Text.Trifecta.Render.Fixit+import Text.Trifecta.Render.Span import Text.Trifecta.Rope-import Text.Trifecta.Caret-import Text.Trifecta.Span-import Text.Trifecta.Fixit-import Text.Trifecta.Bytes-import Text.Trifecta.Delta-import Text.Trifecta.Slice import Text.Trifecta.Strand-import Text.Trifecta.Supply-import Text.Trifecta.Render-import Text.Trifecta.Rendered-import Text.Trifecta.Diagnostic+import Text.Trifecta.Util.MaybePair
− Text/Trifecta/Caret.hs 
@@ -1,105 +0,0 @@-module Text.Trifecta.Caret-  ( Caret(..)-  , HasCaret(..)-  , Careted(..)-  , careted-  -- * Internals-  , drawCaret-  , addCaret-  , caretEffects-  ) where--import Control.Applicative-import Data.Hashable-import Data.Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Foldable-import Data.Traversable-import Control.Comonad-import Data.Functor.Bind-import Data.ByteString (ByteString)-import Text.Trifecta.Delta-import Text.Trifecta.Render-import Text.Trifecta.Bytes-import Text.Trifecta.It-import Text.Parsec.Prim-import System.Console.Terminfo.Color-import System.Console.Terminfo.PrettyPrint-import Prelude hiding (span)---- |--- > In file included from baz.c:9--- > In file included from bar.c:4--- > foo.c:8:36: note--- > int main(int argc, char ** argv) { int; }--- >                                    ^-data Caret = Caret !Delta {-# UNPACK #-} !ByteString deriving (Eq,Ord,Show)--instance Hashable Caret where-  hash (Caret d bs) = hash d `hashWithSalt` bs--caretEffects :: [ScopedEffect]-caretEffects = [soft (Foreground Green), soft Bold]--drawCaret :: Delta -> Delta -> Lines -> Lines-drawCaret p = ifNear p $ draw caretEffects 1 (column p) "^"--addCaret :: Delta -> Render -> Render-addCaret p r = drawCaret p .# r--class HasCaret t where-  caret :: t -> Caret--instance HasCaret Caret where-  caret = id--instance HasBytes Caret where-  bytes = bytes . delta--instance HasDelta Caret where-  delta (Caret d _) = d--instance Renderable Caret where-  render (Caret d bs) = addCaret d $ surface d bs--instance Semigroup Caret where-  a <> _ = a--data Careted a = a :^ Caret deriving (Eq,Ord,Show)--instance Functor Careted where-  fmap f (a :^ s) = f a :^ s--instance Extend Careted where-  extend f as@(_ :^ s) = f as :^ s--instance Comonad Careted where-  extract (a :^ _) = a--instance Foldable Careted where-  foldMap f (a :^ _) = f a--instance Traversable Careted where-  traverse f (a :^ s) = (:^ s) <$> f a--instance Foldable1 Careted where-  foldMap1 f (a :^ _) = f a--instance Traversable1 Careted where-  traverse1 f (a :^ s) = (:^ s) <$> f a--instance Renderable (Careted a) where-  render = render . caret--instance HasCaret (Careted a) where-  caret (_ :^ c) = c--instance Hashable a => Hashable (Careted a) where-  -careted :: P u a -> P u (Careted a)-careted p = do-  m <- getInput-  l <- line m-  a <- p-  return $ a :^ Caret m l
Text/Trifecta/Delta.hs view
@@ -5,6 +5,7 @@   , rewind   , near   , column+  , columnByte   ) where  import Control.Applicative@@ -37,6 +38,15 @@               {-# UNPACK #-} !Int  -- number of bytes               {-# UNPACK #-} !Int  -- the number of bytes since the last newline   deriving (Eq, Ord, Show)++columnByte :: Delta -> Int+columnByte (Columns _ b) = b+columnByte (Tab _ _ b) = b+columnByte (Lines _ _ _ b) = b+columnByte (Directed _ _ _ _ b) = b++instance (HasDelta l, HasDelta r) => HasDelta (Either l r) where+  delta = either delta delta  instance Pretty Delta where   pretty p = prettyTerm p *> empty
Text/Trifecta/Diagnostic.hs view
@@ -1,115 +1,84 @@+{-# LANGUAGE FlexibleContexts #-} module Text.Trifecta.Diagnostic -  ( DiagnosticLevel(..)-  , Diagnostic(..)+  ( Diagnostic(..)+  , tellDiagnostic   ) where  import Control.Applicative import Control.Comonad-import Data.Bifunctor+import Control.Monad (guard)+import Control.Monad.Writer.Class import Data.Functor.Apply-import Data.Bifoldable-import Data.Bitraversable import Data.Foldable import Data.Traversable import Data.Monoid import Data.List.NonEmpty hiding (map) import Data.Semigroup+import Data.Semigroup.Reducer import Data.Semigroup.Foldable import Data.Semigroup.Traversable-import Data.Semigroup.Bifoldable-import Data.Semigroup.Bitraversable import Text.Trifecta.Bytes import Text.Trifecta.Delta-import Text.Trifecta.Render+import Text.Trifecta.Render.Prim+import Text.Trifecta.Diagnostic.Level import Text.PrettyPrint.Free import System.Console.Terminfo.PrettyPrint--data DiagnosticLevel = Note | Warning | Error | Fatal-  deriving (Eq,Ord,Show,Read)--instance Semigroup DiagnosticLevel where-  (<>) = max--instance Pretty DiagnosticLevel where-  pretty p = prettyTerm p *> empty+import Prelude hiding (log) -instance PrettyTerm DiagnosticLevel where-  prettyTerm Note    = text "note"-  prettyTerm Warning = magenta $ text "warning"-  prettyTerm Error   = red $ text "error"-  prettyTerm Fatal   = red $ text "fatal"+data Diagnostic m = Diagnostic !Render !DiagnosticLevel m [Diagnostic m] -data Diagnostic l m = Diagnostic !Render l m [Diagnostic l m]+tellDiagnostic :: (MonadWriter t m, Reducer (Diagnostic e) t) => Diagnostic e -> m ()+tellDiagnostic = tell . unit -instance Renderable (Diagnostic l m) where+instance Renderable (Diagnostic m) where   render (Diagnostic r _ _ _) = r -instance HasDelta (Diagnostic l m) where+instance HasDelta (Diagnostic m) where   delta (Diagnostic r _ _ _) = delta r -instance HasBytes (Diagnostic l m) where+instance HasBytes (Diagnostic m) where   bytes = bytes . delta -instance Extend (Diagnostic l) where+instance Extend Diagnostic where   extend f d@(Diagnostic r l _ xs) = Diagnostic r l (f d) (map (extend f) xs) -instance Comonad (Diagnostic l) where+instance Comonad Diagnostic where   extract (Diagnostic _ _ m _) = m -instance (Pretty l, Pretty m) => Pretty (Diagnostic l m) where+instance Pretty m => Pretty (Diagnostic m) where   pretty (Diagnostic r l m xs) = vsep $-    [ pretty (delta r) <> char ':' <+> pretty l <> char ':' <+> pretty m-    , pretty r-    ] ++ if Prelude.null xs then [] else [indent 2 (prettyList xs)]+     [ pretty (delta r) <> char ':' <+> pretty l <> char ':' <+> nest 4 (pretty m) ] +     <> (pretty r <$ guard (not (nullRender r)))+     <> (indent 2 (prettyList xs) <$ guard (not (null xs)))   prettyList = Prelude.foldr ((<>) . pretty) empty -instance (PrettyTerm l, PrettyTerm m) => PrettyTerm (Diagnostic l m) where+instance PrettyTerm m => PrettyTerm (Diagnostic m) where   prettyTerm (Diagnostic r l m xs) = vsep $ -    [ prettyTerm (delta r) <> char ':' <+> prettyTerm l <> char ':' <+> prettyTerm m-    , prettyTerm r-    ] ++ if Prelude.null xs then [] else [indent 2 (prettyTermList xs)]+     [ prettyTerm (delta r) <> char ':' <+> prettyTerm l <> char ':' <+> nest 4 (prettyTerm m) ]+     <> (prettyTerm r <$ guard (not (nullRender r)))+     <> (indent 2 (prettyTermList xs) <$ guard (not (null xs)))   prettyTermList = Prelude.foldr ((<>) . prettyTerm) empty --instance (Pretty l, Pretty m) => Show (Diagnostic l m) where+instance Pretty m => Show (Diagnostic m) where   showsPrec d = showsPrec d . pretty -instance Functor (Diagnostic l) where+instance Functor Diagnostic where   fmap f (Diagnostic r l m xs) = Diagnostic r l (f m) $ map (fmap f) xs -instance Bifunctor Diagnostic where-  bimap f g (Diagnostic r l m xs) = Diagnostic r (f l) (g m) $ map (bimap f g) xs--instance Foldable (Diagnostic l) where+instance Foldable Diagnostic where   foldMap f (Diagnostic _ _ m xs) = f m `mappend` foldMap (foldMap f) xs -instance Traversable (Diagnostic l) where+instance Traversable Diagnostic where   traverse f (Diagnostic r l m xs) = Diagnostic r l <$> f m <*> traverse (traverse f) xs -instance Foldable1 (Diagnostic l) where+instance Foldable1 Diagnostic where   foldMap1 f (Diagnostic _ _ m []) = f m   foldMap1 f (Diagnostic _ _ m (x:xs)) = f m <> foldMap1 (foldMap1 f) (x:|xs) -instance Traversable1 (Diagnostic l) where+instance Traversable1 Diagnostic where   traverse1 f (Diagnostic r l m [])     = fmap (\fm -> Diagnostic r l fm []) (f m)   traverse1 f (Diagnostic r l m (x:xs)) = (\fm (y:|ys) -> Diagnostic r l fm (y:ys))                                        <$> f m                                        <.> traverse1 (traverse1 f) (x:|xs) -instance Bifoldable Diagnostic where-  bifoldMap f g (Diagnostic _ l m xs) = f l `mappend` g m `mappend` foldMap (bifoldMap f g) xs--instance Bitraversable Diagnostic where-  bitraverse f g (Diagnostic r l m xs) = Diagnostic r <$> f l <*>  g m <*> traverse (bitraverse f g) xs-  -instance Bifoldable1 Diagnostic where-  bifoldMap1 f g (Diagnostic _ l m [])     = f l <> g m-  bifoldMap1 f g (Diagnostic _ l m (x:xs)) = f l <> g m <> foldMap1 (bifoldMap1 f g) (x:|xs)--instance Bitraversable1 Diagnostic where-  bitraverse1 f g (Diagnostic r l m [])     = (\fl gm -> Diagnostic r fl gm []) <$> f l <.> g m-  bitraverse1 f g (Diagnostic r l m (x:xs)) = (\fl gm (y:|ys) -> Diagnostic r fl gm (y:ys)) -                                      <$> f l-                                      <.> g m-                                      <.> traverse1 (bitraverse1 f g) (x:|xs)
+ Text/Trifecta/Diagnostic/Level.hs view
@@ -0,0 +1,40 @@+module Text.Trifecta.Diagnostic.Level +  ( DiagnosticLevel(..)+  ) where++import Control.Applicative+import Data.Semigroup+import Text.PrettyPrint.Free+import System.Console.Terminfo.PrettyPrint++data DiagnosticLevel = Verbose !Int | Note | Warning | Error | Fatal+  deriving (Eq,Show,Read)++instance Ord DiagnosticLevel where+  compare (Verbose n) (Verbose m) = compare m n+  compare (Verbose _) _ = LT+  compare Note (Verbose _) = GT+  compare Note Note = EQ+  compare Note _ = LT+  compare Warning (Verbose _) = GT+  compare Warning Note = GT+  compare Warning Warning = EQ+  compare Warning _ = LT+  compare Error Error = EQ+  compare Error Fatal = LT+  compare Error _     = GT+  compare Fatal Fatal = EQ+  compare Fatal _     = GT++instance Semigroup DiagnosticLevel where+  (<>) = max++instance Pretty DiagnosticLevel where+  pretty p = prettyTerm p *> empty++instance PrettyTerm DiagnosticLevel where+  prettyTerm (Verbose n) = blue $ text "verbose (" <> int n <> char ')'+  prettyTerm Note        = text "note"+  prettyTerm Warning     = magenta $ text "warning"+  prettyTerm Error       = red $ text "error"+  prettyTerm Fatal       = blink $ red $ text "fatal"
− Text/Trifecta/Fixit.hs 
@@ -1,57 +0,0 @@-module Text.Trifecta.Fixit-  ( Fixit(..)-  , drawFixit-  , addFixit-  , fixit-  ) where--import Data.Functor-import Data.Hashable-import Data.ByteString (ByteString)-import qualified Data.ByteString as Strict-import qualified Data.ByteString.UTF8 as UTF8-import Text.Trifecta.Bytes-import Text.Trifecta.Caret-import Text.Trifecta.Delta-import Text.Trifecta.Span-import Text.Trifecta.Render-import Text.Trifecta.Util-import Text.Trifecta.It-import System.Console.Terminfo.Color-import System.Console.Terminfo.PrettyPrint-import Prelude hiding (span)---- |--- > int main(int argc char ** argv) { int; }--- >                  ^--- >                  ,-drawFixit :: Delta -> Delta -> String -> Delta -> Lines -> Lines-drawFixit s e rpl d a = ifNear l (draw [soft (Foreground Blue)] 2 (column l) rpl) d -                      $ drawSpan s e d a-  where l = argmin bytes s e--addFixit :: Delta -> Delta -> String -> Render -> Render-addFixit s e rpl r = drawFixit s e rpl .# r--data Fixit = Fixit -  { fixitSpan        :: {-# UNPACK #-} !Span-  , fixitReplacement  :: {-# UNPACK #-} !ByteString -  } deriving (Eq,Ord,Show)--instance HasSpan Fixit where-  span (Fixit s _) = s--instance HasDelta Fixit where-  delta = delta . caret--instance HasCaret Fixit where-  caret = caret . span--instance Hashable Fixit where-  hash (Fixit s b) = hash s `hashWithSalt` b--instance Renderable Fixit where-  render (Fixit (Span s e bs) r) = addFixit s e (UTF8.toString r) $ surface s bs--fixit :: P u Strict.ByteString -> P u Fixit-fixit p = (\(rep :~ s) -> Fixit s rep) <$> spanned p
Text/Trifecta/It.hs view
@@ -1,102 +1,97 @@-{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}+{-# LANGUAGE MultiParamTypeClasses, BangPatterns, MagicHash, UnboxedTuples #-} module Text.Trifecta.It -  ( P-  , It(..)-  , input-  , line-  , peekIt+  ( It(Pure, It, result)+  , needIt+  , wantIt+  , fillIt+  , lineIt+  , sliceIt+  , stepIt   ) where  import Control.Applicative+import Control.Comonad import Control.Monad-import Control.Monad.Trans.Class-import Data.Semigroup import Data.Monoid-import Data.FingerTree as FingerTree import Data.ByteString as Strict import Data.ByteString.Lazy as Lazy-import Data.ByteString.Lazy.UTF8 as LazyUTF8 import Data.Functor.Bind import Data.Functor.Plus import Text.Trifecta.Rope as Rope import Text.Trifecta.Delta import Text.Trifecta.Bytes-import Text.Parsec.Prim hiding ((<|>))--type P u = ParsecT Delta u It---- grab the contents of the line that contains delta-line :: Delta -> P u Strict.ByteString-line d = lift $ Strict.concat-              . Lazy.toChunks-              . Lazy.takeWhile (/= 10)-              . snd <$> peekIt (rewind d)+import Text.Trifecta.Util.MaybePair+import Text.Trifecta.Parser.Step -data It a -  = Done !Rope !Bool a-  | Fail !Rope !Bool String-  | Cont (Rope -> Bool -> It a)-  -instance Show a => Show (It a) where-  showsPrec d (Done r b a) = showParen (d > 10) $ -    showString "Done " . showsPrec 11 r . showChar ' ' . showsPrec 11 b . showChar ' ' . showsPrec 11 a-  showsPrec d (Fail r b s) = showParen (d > 10) $-    showString "Fail " . showsPrec 11 r . showChar ' ' . showsPrec 11 b . showChar ' ' . showsPrec 11 s-  showsPrec d (Cont _) = showParen (d > 10) $ showString "Cont ..."+data It a+  = Pure { result :: a } +  | It { result :: a, _it :: Rope -> It a }  instance Functor It where-  fmap f (Done r b a) = Done r b (f a)-  fmap _ (Fail r b s) = Fail r b s-  fmap f (Cont k) = Cont (\r b -> fmap f (k r b))--instance Apply It where-  (<.>) = (<*>) +  fmap f (Pure a) = Pure (f a)+  fmap f (It a k) = It (f a) (fmap f . k)  instance Applicative It where-  pure = Done mempty False-  (<*>) = ap+  pure = Pure+  Pure f  <*> Pure a  = Pure (f a)+  Pure f  <*> It a ka = It (f a) (fmap f . ka)+  It f kf <*> Pure a  = It (f a) (fmap ($a) . kf)+  It f kf <*> It a ka = It (f a) (\r -> kf r <*> ka r) -instance Alt It where-  Fail r b _ <!> Cont k = k r b-  Fail r b _ <!> Done _ _ a = Done r b a-  Fail r b _ <!> Fail _ _ s = Fail r b s-  m <!> _ = m+instance Monad It where+  return = Pure+  Pure a >>= f = f a+  It a k >>= f = It (result (f a)) (k >=> f) -instance Alternative It where-  (<|>) = (<!>)-  empty = fail "empty"+instance Apply It where (<.>) = (<*>) +instance Bind It where (>>-) = (>>=)  -instance Bind It where-  (>>-) = (>>=)+instance Extend It where+  duplicate p@Pure{} = Pure p+  duplicate p@(It _ k) = It p (duplicate . k) -instance Monad It where-  return = Done mempty False-  Done (Rope _ t) False a >>= f | FingerTree.null t = f a-  Done h e a >>= f = case f a of-    Done _ _ b -> Done h e b-    Fail _ _ s -> Fail h e s-    Cont k     -> k h e-  Fail r b s >>= _ = Fail r b s-  Cont k >>= f     = Cont $ \h e -> k h e >>= f-  fail = Fail mempty False+  extend f p@Pure{} = Pure (f p)+  extend f p@(It _ k) = It (f p) (extend f . k) -instance MonadPlus It where-  mplus = (<!>) -  mzero = fail "mzero"+instance Comonad It where+  extract = result -input :: It Rope-input = Cont $ \r e -> Done r e r+needIt :: a -> (Rope -> Maybe a) -> It a+needIt z f = k where +  k = It z $ \r -> case f r of +    Just a -> Pure a+    Nothing -> k -instance Stream Delta It Char where-  uncons d = (k <$> peekIt d) <|> return Nothing where -    k (d', bs) = case LazyUTF8.uncons bs of-      Just (c, _) -> Just (c, d' <> delta c)-      Nothing     -> Nothing+wantIt :: a -> (Rope -> (# Bool, a #)) -> It a+wantIt z f = It z k where +  k r = case f r of+    (# False, a #) -> It a k+    (# True,  a #) -> Pure a -peekIt :: Delta -> It (Delta, Lazy.ByteString)-peekIt n = Cont go where-  go h eof -    | bytes n < bytes (lastNewline h eof) = grab n h (\c lbs -> Done h eof (c, lbs)) -                                            (Fail h eof "peek: failed to grab rope")-    | eof                   = Fail h True "Unexpected EOF"-    | otherwise             = Cont $ \h' -> go (h <> h') -- h' <> h+-- given a position, go there, and grab the text forward from that point+fillIt :: Delta -> It (MaybePair Delta Strict.ByteString)+fillIt n = wantIt NothingPair $ \r -> +  (# bytes n < bytes (rewind (delta r))+  ,  grabLine n r NothingPair JustPair #) +                                       +-- return the text of the line that contains a given position+lineIt :: Delta -> It (Maybe Strict.ByteString)+lineIt n = wantIt Nothing $ \r -> +  (# bytes n < bytes (rewind (delta r))+  ,  grabLine n r Nothing (const Just) #)++sliceIt :: Delta -> Delta -> It Strict.ByteString+sliceIt !i !j = wantIt mempty $ \r -> +  (# bytes j < bytes (rewind (delta r))+  ,  grabRest i r mempty $ const $ +     Strict.concat . +     Lazy.toChunks . +     Lazy.take (fromIntegral (bj - bi)) #)+  where+    bi = bytes i+    bj = bytes j++stepIt :: It a -> Step e a+stepIt = go mempty where+  go r (Pure a) = StepDone r mempty a+  go r (It a k) = StepCont r (pure a) (\s -> go s (k s))
+ Text/Trifecta/Parser/Char.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}+module Text.Trifecta.Parser.Char+  ( oneOf      -- :: MonadParser m => [Char] -> m Char+  , noneOf     -- :: MonadParser m => [Char] -> m Char+--  , spaces     -- :: MonadParser m => m ()+  , space      -- :: MonadParser m => m Char+  , newline    -- :: MonadParser m => m Char+  , tab        -- :: MonadParser m => m Char+  , upper      -- :: MonadParser m => m Char+  , lower      -- :: MonadParser m => m Char+  , alphaNum   -- :: MonadParser m => m Char+  , letter     -- :: MonadParser m => m Char+  , digit      -- :: MonadParser m => m Char+  , hexDigit   -- :: MonadParser m => m Char+  , octDigit   -- :: MonadParser m => m Char+  , char       -- :: MonadParser m => Char -> m Char+  , anyChar    -- :: MonadParser m => m Char+  , string     -- :: MonadParser m => String -> m String+  , byteString -- :: MonadParser m => ByteString -> m ByteString+  ) where++import Data.Char+import Control.Applicative+import Control.Monad (guard)+import Text.Trifecta.Parser.Class+import Data.ByteString as Strict hiding (empty, all, elem)+import Data.ByteString.UTF8 as UTF8++-- | @oneOf cs@ succeeds if the current character is in the supplied+-- list of characters @cs@. Returns the parsed character. See also+-- 'satisfy'.+-- +-- >   vowel  = oneOf "aeiou"+oneOf :: MonadParser m => [Char] -> m Char+oneOf cs | all ((< 0x80) . fromEnum) cs = satisfyAscii (\c -> elem c cs)+         | otherwise                    = satisfy (\c -> elem c cs)++-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- >  consonant = noneOf "aeiou"+noneOf :: MonadParser m => [Char] -> m Char+noneOf cs | all ((< 0x80) . fromEnum) cs = satisfyAscii (\c -> not (elem c cs))+          | otherwise                    = satisfy (\c -> not (elem c cs))++-- | Skips /zero/ or more white space characters. See also 'skipMany'.+-- spaces :: MonadParser m => m ()+-- spaces = skipMany space <?> "white space"++-- | Parses a white space character (any character which satisfies 'isSpace')+-- Returns the parsed character. +space :: MonadParser m => m Char+space = satisfy isSpace <?> "space"++-- | Parses a newline character (\'\\n\'). Returns a newline character. +newline :: MonadParser m => m Char+newline = char '\n' <?> "new-line"++-- | Parses a tab character (\'\\t\'). Returns a tab character. +tab :: MonadParser m => m Char+tab = char '\t' <?> "tab"++-- | Parses an upper case letter (a character between \'A\' and \'Z\').+-- Returns the parsed character. +upper :: MonadParser m => m Char+upper = satisfy isUpper <?> "uppercase letter"++-- | Parses a lower case character (a character between \'a\' and \'z\').+-- Returns the parsed character. +lower :: MonadParser m => m Char+lower = satisfy isLower <?> "lowercase letter"++-- | Parses a letter or digit (a character between \'0\' and \'9\').+-- Returns the parsed character. ++alphaNum :: MonadParser m => m Char+alphaNum = satisfy isAlphaNum <?> "letter or digit"++-- | Parses a letter (an upper case or lower case character). Returns the+-- parsed character. ++letter :: MonadParser m => m Char+letter = satisfy isAlpha <?> "letter"++-- | Parses a digit. Returns the parsed character. ++digit :: MonadParser m => m Char+digit = satisfy isDigit <?> "digit"++-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and+-- \'f\' or \'A\' and \'F\'). Returns the parsed character. +hexDigit :: MonadParser m => m Char+hexDigit = satisfy isHexDigit <?> "hexadecimal digit"++-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns+-- the parsed character. +octDigit :: MonadParser m => m Char+octDigit = satisfy isOctDigit    <?> "octal digit"++-- | @char c@ parses a single character @c@. Returns the parsed+-- character (i.e. @c@).+--+-- >  semiColon  = char ';'+char :: MonadParser m => Char -> m Char+char c | fromEnum c <= 0x7f = satisfyAscii (c ==) <?> show [c]+       | otherwise          = satisfy (c ==) <?> show [c]++-- | This parser succeeds for any character. Returns the parsed character. +anyChar :: MonadParser m => m Char+anyChar = satisfy (const True)++-- | @string s@ parses a sequence of characters given by @s@. Returns+-- the parsed string (i.e. @s@).+--+-- >  divOrMod    =   string "div" +-- >              <|> string "mod"+string :: MonadParser m => String -> m String+string s = s <$ byteString (UTF8.fromString s)++-- | @byteString s@ parses a sequence of bytes given by @s@. Returns+-- the parsed byteString (i.e. @s@).+--+-- >  divOrMod    =   string "div" +-- >              <|> string "mod"+byteString :: MonadParser m => ByteString -> m ByteString+byteString bs = do+   r <- rest+   let lr = Strict.length r+       lbs = Strict.length bs+   guard $ lr > 0+   case compare lbs lr of+     LT | bs `isPrefixOf` r -> bs <$ skipping bs+        | otherwise -> empty+     EQ | bs == r -> bs <$ skipping bs+        | otherwise -> empty+     GT | r `isPrefixOf` bs -> bs <$ skipping r *> byteString (Strict.drop lr bs)+        | otherwise -> empty+ <?> UTF8.toString bs
+ Text/Trifecta/Parser/Class.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}+module Text.Trifecta.Parser.Class +  ( MonadParser(..)+  , rest+  , (<?>)+  , sliced+  ) where++import Control.Applicative+import Control.Monad (MonadPlus(..))+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Lazy+import Text.Trifecta.It+import Text.Trifecta.Delta+import Data.Semigroup+import Data.ByteString as Strict+import Data.Set as Set++class ( Alternative m, MonadPlus m) => MonadParser m where+  satisfy :: (Char -> Bool) -> m Char+  commit :: m a -> m a+  labels :: m a -> Set String -> m a+  it :: It a -> m a+  mark :: m Delta+  release :: Delta -> m ()+  unexpected :: MonadParser m => String -> m a+  line :: m ByteString++  satisfyAscii :: (Char -> Bool) -> m Char+  satisfyAscii f = toEnum . fromEnum <$> satisfy (f . toEnum . fromEnum)++  skipping :: HasDelta d => d -> m d+  skipping d = do+    m <- mark+    d <$ release (m <> delta d)++instance MonadParser m => MonadParser (StateT s m) where+  satisfy = lift . satisfy+  commit (StateT m) = StateT $ commit . m+  labels (StateT m) ss = StateT $ \s -> labels (m s) ss+  line = lift line+  it = lift . it+  mark = lift mark +  release = lift . release+  unexpected = lift . unexpected+  satisfyAscii = lift . satisfyAscii++rest :: MonadParser m => m ByteString+rest = do+  m <- mark+  Strict.drop (columnByte m) <$> line++(<?>) :: MonadParser m => m a -> String -> m a+p <?> msg = labels p (Set.singleton msg)++sliced :: MonadParser m => (a -> Strict.ByteString -> r) -> m a -> m r+sliced f pa = do+  m <- mark+  a <- pa+  r <- mark+  it $ f a <$> sliceIt m r
+ Text/Trifecta/Parser/Err.hs view
@@ -0,0 +1,74 @@+module Text.Trifecta.Parser.Err+  ( Err(..)+  , diagnose+  , knownErr+  ) where++import Control.Applicative+import Data.Semigroup+import Data.Monoid+import Data.Functor.Plus+import Text.Trifecta.Render.Prim+import Text.Trifecta.Diagnostic+import Text.Trifecta.Diagnostic.Level+import Text.PrettyPrint.Free+import System.Console.Terminfo.PrettyPrint++-- | unlocated error messages+data Err e+  = EmptyErr+  | FailErr String +  | UnexpectedErr String+  | EndOfFileErr+  | RichErr (Render -> Diagnostic e)++knownErr :: Err e -> Bool+knownErr EmptyErr = False+knownErr _ = True++diagnose :: (t -> Doc e) -> Render -> Err t -> Diagnostic (Doc e)+diagnose _ r EmptyErr          = Diagnostic r Error (text "unexpected") []+diagnose _ r (FailErr m)       = Diagnostic r Error (fillSep $ text <$> words m) []+diagnose _ r (UnexpectedErr s) = Diagnostic r Error (fillSep $ fmap text $ "unexpected" : words s) []+diagnose _ r EndOfFileErr      = Diagnostic r Error (text "unexpected EOF") []+diagnose k r (RichErr f)       = fmap k (f r)++diagnose0 :: Pretty t => Err t -> Diagnostic (Doc e)+diagnose0 = diagnose pretty emptyRender++diagnoseTerm0 :: PrettyTerm t => Err t -> Diagnostic TermDoc+diagnoseTerm0 = diagnose prettyTerm emptyRender++instance Pretty t => Pretty (Err t) where+  pretty = pretty . diagnose0+  prettyList = prettyList . map diagnose0++instance PrettyTerm t => PrettyTerm (Err t) where+  prettyTerm = prettyTerm . diagnoseTerm0+  prettyTermList = prettyTermList . map diagnoseTerm0+  +instance Pretty t => Show (Err t) where+  show = show . pretty++instance Functor Err where+  fmap _ EmptyErr          = EmptyErr+  fmap _ (FailErr s)       = FailErr s+  fmap _ EndOfFileErr      = EndOfFileErr+  fmap _ (UnexpectedErr s) = UnexpectedErr s +  fmap f (RichErr k)       = RichErr (fmap f . k)++instance Alt Err where+  EmptyErr <!> a = a+  a        <!> _ = a+  {-# INLINE (<!>) #-}++instance Plus Err where+  zero = EmptyErr++instance Semigroup (Err t) where+  (<>) = (<!>)+  replicate1p _ = id++instance Monoid (Err t) where+  mempty = EmptyErr+  mappend = (<!>)
+ Text/Trifecta/Parser/Err/State.hs view
@@ -0,0 +1,34 @@+module Text.Trifecta.Parser.Err.State +  ( ErrState(..)+  ) where++import Data.Functor.Plus+import Data.Set as Set+import Data.Sequence as Seq+import Data.Semigroup+import Data.Monoid+import Text.Trifecta.Parser.Err+import Text.Trifecta.Diagnostic++data ErrState e = ErrState+ { errExpected :: !(Set String)+ , errMessage  :: !(Err e)+ , errLog      :: !(Seq (Diagnostic e))+ }++instance Functor ErrState where+  fmap f (ErrState a b c) = ErrState a (fmap f b) (fmap (fmap f) c)++instance Alt ErrState where+  ErrState a b c <!> ErrState a' b' c' = ErrState (a <> a') (b <!> b') (c <!> c')+  {-# INLINE (<!>) #-}++instance Plus ErrState where+  zero = ErrState mempty zero zero+ +instance Semigroup (ErrState e) where+  (<>) = (<!>) ++instance Monoid (ErrState e) where+  mempty = zero+  mappend = (<!>)
+ Text/Trifecta/Parser/Prim.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, Rank2Types, FlexibleInstances #-}+module Text.Trifecta.Parser.Prim +  ( Parser(..)+  , why+-- , stepParser+  ) where++import Control.Applicative+import Control.Monad.Error.Class+import Control.Monad.Writer.Class+import Control.Monad+import Data.Functor.Plus+import Data.Semigroup+-- import Data.Monoid+import Data.Functor.Bind+import Data.Set as Set hiding (empty)+import Data.ByteString as Strict hiding (empty)+import Data.Sequence as Seq hiding (empty)+import Data.ByteString.UTF8 as UTF8+import Data.Bifunctor+import Text.PrettyPrint.Free+import Text.Trifecta.It+import Text.Trifecta.Delta+import Text.Trifecta.Diagnostic+import Text.Trifecta.Render.Prim+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Err+import Text.Trifecta.Parser.Err.State+--import Text.Trifecta.Parser.Step+--import Text.Trifecta.Parser.Result+import Text.Trifecta.Util.MaybePair+--import Text.PrettyPrint.Free+import System.Console.Terminfo.PrettyPrint++data Parser e a = Parser +  { unparser :: forall r.+    (a -> ErrState e -> Delta -> ByteString -> It r) ->  -- uncommitted ok+    (ErrState e -> Delta -> ByteString -> It r) ->       -- uncommitted err+    (a ->  ErrState e -> Delta -> ByteString -> It r) -> -- committed ok+    (ErrState e -> Delta -> ByteString -> It r) ->       -- committed err+    ErrState e -> Delta -> ByteString -> It r+  } ++instance Functor (Parser e) where+  fmap f (Parser m) = Parser $ \ eo ee co -> m (eo . f) ee (co . f)+  {-# INLINE fmap #-}++instance Apply (Parser e) where (<.>) = (<*>)+instance Applicative (Parser e) where+  pure a = Parser $ \ eo _ _ _ -> eo a +  {-# INLINE pure #-}+  Parser m <*> Parser n = Parser $ \ eo ee co ce -> +    m (\f -> n (eo . f) ee (co . f) ce) ee+      (\f -> n (co . f) ce (co . f) ce) ce+  {-# INLINE (<*>) #-}++instance Alt (Parser e) where (<!>) = (<|>)+instance Plus (Parser e) where zero = empty+instance Alternative (Parser e) where+  empty = Parser $ \_ ee _ _ -> ee+  {-# INLINE empty #-}+  Parser m <|> Parser n = Parser $ \ eo ee co ce -> m eo (n eo ee co ce) co ce+  {-# INLINE (<|>) #-}++instance Bind (Parser e) where (>>-) = (>>=)+instance Monad (Parser e) where+  return a = Parser $ \ eo _ _ _ -> eo a +  {-# INLINE return #-}+  Parser m >>= k = Parser $ \ eo ee co ce -> +    m (\a -> unparser (k a) eo ee co ce) ee +      (\a -> unparser (k a) co ce co ce) ce+  {-# INLINE (>>=) #-}+  fail = throwError . FailErr+  {-# INLINE fail #-}++instance MonadPlus (Parser e) where+  mzero = empty+  mplus = (<|>) ++instance MonadWriter (Seq (Diagnostic e)) (Parser e) where+  tell w = Parser $ \eo _ _ _ e -> eo () e { errLog = errLog e <> w }+  {-# INLINE tell #-}+  listen (Parser m) = Parser $ \eo ee co ce -> +    m (\ a e -> eo (a,errLog e) e) ee +      (\ a e -> co (a,errLog e) e) ce +  pass (Parser m) = Parser $ \eo ee co ce -> +    m (\(a,p) e -> eo a e { errLog = p $ errLog e }) ee+      (\(a,p) e -> co a e { errLog = p $ errLog e }) ce++instance MonadError (Err e) (Parser e) where+  throwError m = Parser $ \_ ee _ _ e -> ee e { errMessage = errMessage e <> m } +  {-# INLINE throwError #-}+  catchError (Parser p) k = Parser $ \ eo ee co ce e -> p eo (\e' -> unparser (k (errMessage e')) eo ee co ce e) co ce e+  {-# INLINE catchError #-}++instance MonadParser (Parser e) where+  commit (Parser m) = Parser $ \ _ _ co ce -> m co ce co ce+  unexpected s = Parser $ \ _ ee _ _ e -> ee e { errMessage = UnexpectedErr s } +  {-# INLINE commit #-}+  labels (Parser p) msgs = Parser $ \ eo ee -> p+     (\a e -> eo a (if knownErr (errMessage e) then e { errExpected = errExpected e `union` msgs } else e))+     (\e -> ee e { errExpected = errExpected e `union` msgs })+  {-# INLINE labels #-}+  it m = Parser $ \ eo _ _ _ e d bs -> do +     a <- m+     eo a e d bs+  {-# INLINE it #-}+  mark = Parser $ \eo _ _ _ e d -> eo d e d+  {-# INLINE mark #-}+  release d' = Parser $ \eo ee _ _ e d bs -> do+    mbs <- lineIt d'+    case mbs of+      Just bs' -> eo () e d' bs'+      Nothing -> ee e d bs+  {-# INLINE release #-}+  line = Parser $ \eo _ _ _ e d bs -> eo bs e d bs+  {-# INLINE line #-}+  satisfy f = Parser $ \ eo ee _ _ e d bs ->+    case UTF8.uncons $ Strict.drop (columnByte d) bs of+      Nothing -> ee e { errMessage = EndOfFileErr } d bs+      Just (c, xs) +        | not (f c) -> ee e d bs+        | Strict.null xs -> fillIt (d <> delta c) >>= \dbs -> case dbs of+          JustPair d' bs' -> eo c e d' bs'+          NothingPair -> eo c e (d <> delta c) bs -- END OF LINE+        | otherwise -> eo c e (d <> delta c) bs +  {-# INLINE satisfy #-}+  satisfyAscii f = Parser $ \ eo ee _ _ e d bs ->+    let b = columnByte d in+    if b >= 0 && b < Strict.length bs +    then case toEnum $ fromEnum $ Strict.index bs b of+      c | not (f c) -> ee e d bs+        | b == Strict.length bs - 1 -> fillIt (d <> delta c) >>= \dbs -> case dbs of+          JustPair d' bs' -> eo c e d' bs'+          NothingPair -> eo c e (d <> delta c) bs+        | otherwise -> eo c e (d <> delta c) bs+    else ee e { errMessage = EndOfFileErr } d bs+  {-# INLINE satisfyAscii #-}++data St e a = JuSt a !(ErrState e) !Delta !ByteString+            | NoSt !(ErrState e) !Delta !ByteString++instance Bifunctor St where+  bimap f g (JuSt a e d bs) = JuSt (g a) (fmap f e) d bs+  bimap f _ (NoSt e d bs) = NoSt (fmap f e) d bs++{-+stepParser :: (Diagnostic e -> Diagnostic t) -> +              (ErrState e -> Delta -> ByteString -> Diagnostic t) ->+              Parser e a -> ErrState e -> Delta -> ByteString -> Step e a+stepParser yl y (Parser p) e0 d0 bs0 = +  go mempty $ p ju no ju no e0 d0 bs0+  where+    ju a e d bs = Pure (JuSt a e d bs)+    no e d bs = Pure (NoSt e d bs)+    go r (Pure (JuSt a e _ _)) = StepDone r (yl <$> errLog e) a+    go r (Pure (NoSt e d bs))  = StepFail r (yl <$> errLog e) $ y e d bs+    go r (It ma k) = StepCont r (case ma of+                                   JuSt a e _ _ -> Success (yl <$> errLog e) a+                                   NoSt e d bs  -> Failure (yl <$> errLog e) (y e d bs)) +                                (go <*> k)+-}++why :: PrettyTerm e => ErrState e -> Delta -> ByteString -> Diagnostic TermDoc+why (ErrState ss m _) d bs +  | Set.null ss = diagnose prettyTerm (surface d bs) m+  | otherwise   = expected <$> diagnose prettyTerm (surface d bs) m +  where+    expected doc = doc <> text ", expected" <+> fillSep (punctuate (char ',') $ text <$> toList ss)
+ Text/Trifecta/Parser/Result.hs view
@@ -0,0 +1,60 @@+module Text.Trifecta.Parser.Result +  ( Result(..)+  ) where++import Control.Applicative+import Data.Monoid+import Data.Semigroup+import Data.Foldable+import Data.Functor.Apply+import Data.Functor.Plus+import Data.Traversable+import Data.Bifunctor+import Data.Sequence+import Text.Trifecta.Diagnostic++data Result e a+  = Success !(Seq (Diagnostic e)) a+  | Failure !(Seq (Diagnostic e)) !(Diagnostic e)++instance Functor (Result e) where+  fmap f (Success xs a) = Success xs (f a)+  fmap _ (Failure xs e) = Failure xs e++instance Bifunctor Result where+  bimap f g (Success xs a) = Success (fmap (fmap f) xs) (g a)+  bimap f _ (Failure xs e) = Failure (fmap (fmap f) xs) (fmap f e)++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 e) = pure $ Failure xs e++instance Applicative (Result e) where+  pure = Success mempty+  Success xs f <*> Success ys a  = Success (xs <> ys) (f a)+  Success xs _ <*> Failure ys e  = Failure (xs <> ys) e+  Failure xs e <*> Success ys _  = Failure (xs <> ys) e+  Failure xs e <*> Failure ys e' = Failure (xs <> ys |> e) e'++instance Apply (Result e) where+  (<.>) = (<*>)++{-+instance Alt (Result e) where+  Failure xs e <!> Failure ys e' = Failure (xs <> ys |> e) e'+  Success xs a <!> Success ys _  = Success (xs <> ys) a+  Success xs a <!> Failure ys e  = Success (xs <> ys) a+  Failure xs _ <!> Success ys a  = Success (xs <> ys |> e) a++instance Plus (Result e) where+  zero = Failure mempty zero++instance Alternative (Result e) where +  (<|>) = (<!>)+  empty = zero+-}+
+ Text/Trifecta/Parser/Step.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts #-}+module Text.Trifecta.Parser.Step +  ( Step(..)+  , feed+  , eof+  , eof'+  , stepResult+  ) where++import Data.Bifunctor+import Data.Semigroup.Reducer+import Data.Sequence+import Text.Trifecta.Rope+import Text.Trifecta.Diagnostic+import Text.Trifecta.Parser.Result++data Step e a+  = StepDone !Rope !(Seq (Diagnostic e)) a+  | StepFail !Rope !(Seq (Diagnostic e)) !(Diagnostic e)+  | StepCont !Rope (Result e a) (Rope -> Step e a)++instance Functor (Step e) where+  fmap f (StepDone r xs a) = StepDone r xs (f a)+  fmap _ (StepFail r xs e) = StepFail r xs e+  fmap f (StepCont r z k)  = StepCont r (fmap f z) (fmap f . k)++instance Bifunctor Step where+  bimap f g (StepDone r xs a) = StepDone r (fmap (fmap f) xs) (g a)+  bimap f _ (StepFail r xs e) = StepFail r (fmap (fmap f) xs) (fmap f e)+  bimap f g (StepCont r z k)  = StepCont r (bimap f g z) (bimap f g . k)++feed :: Reducer t Rope => Step e r -> t -> Step e r+feed (StepDone r xs a) t = StepDone (snoc r t) xs a+feed (StepFail r xs e) t = StepFail (snoc r t) xs e+feed (StepCont r _ k) t = k (snoc r t)++eof :: Step e a -> Result e a+eof (StepDone _ xs a) = Success xs a+eof (StepFail _ xs e) = Failure xs e+eof (StepCont _ z _)  = z++eof' :: Step e a -> Result e (Rope, a)+eof' (StepDone r xs a) = Success xs (r, a)+eof' (StepFail _ xs e) = Failure xs e+eof' (StepCont r z _)  = fmap ((,) r) z++stepResult :: Rope -> Result e a -> Step e a+stepResult r (Success xs a) = StepDone r xs a+stepResult r (Failure xs e) = StepFail r xs e+
Text/Trifecta/Path.hs view
@@ -101,23 +101,3 @@ pathCache = mkCache {-# NOINLINE pathCache #-} -{--instance Pretty Path where-  pretty p = prettyPathWith id p 0--prettyPathWith :: (Doc e -> Doc e) -> Path -> Int -> Doc e -prettyPathWith wrapDir = go where-  go (Path _ h mf l flags) delta -     = addHistory -     $ wrapDir $ hsep $ text "#" : pretty (l + delta) : addFile (map pretty flags) where-    addHistory = case h of-      Continue p d -> above (prettyPathWith wrapDir p d)-      Complete -> id-    addFile = case mf of-      JustFileName f -> (:) (dquotes (pretty (unintern f)))-      NothingFileName -> id--instance Show Path where-  showsPrec d (Path _ _ (JustFileName f) l _) = showString (unintern f) . showChar ':' . showsPrec 10 l-  showsPrec d (Path _ _ NothingFileName l _) = showString "-:" . showsPrec 10 l--}
− Text/Trifecta/Render.hs 
@@ -1,119 +0,0 @@-{-# LANGUAGE TypeSynonymInstances #-}--- | Diagnostics rendering-module Text.Trifecta.Render -  ( Render(..)-  , Renderable(..)-  , Source(..)-  , surface-  -- * Lower level drawing primitives-  , Lines-  , draw-  , ifNear-  , (.#)-  ) where--import Data.ByteString hiding (groupBy, empty, any)-import qualified Data.ByteString.UTF8 as UTF8 -import Data.List (groupBy)-import Data.Function (on)-import Text.Trifecta.Delta-import Data.Semigroup-import Data.Array-import Text.PrettyPrint.Free hiding (column)-import System.Console.Terminfo.PrettyPrint-import Control.Monad.State-import Prelude as P--outOfRangeEffects :: [ScopedEffect] -> [ScopedEffect]-outOfRangeEffects xs = soft Bold : xs--type Lines = Array (Int,Int) ([ScopedEffect], Char)--(///) :: Ix i => Array i e -> [(i, e)] -> Array i e-a /// xs = a // P.filter (inRange (bounds a) . fst) xs--grow :: Int -> Lines -> Lines-grow y a -  | inRange (t,b) y = a-  | otherwise = array new [ (i, if inRange old i then a ! i else ([],' ')) | i <- range new ]-  where old@((t,lo),(b,hi)) = bounds a-        new = ((min t y,lo),(max b y,hi))--draw :: [ScopedEffect] -> Int -> Int -> String -> Lines -> Lines-draw e y n xs a0 = gt $ lt (a /// out) where -  a = grow y a0-  ((_,lo),(_,hi)) = bounds a-  out = P.zipWith (\i c -> ((y,i),(e,c))) [n..] xs-  lt | any (\el -> snd (fst el) < lo) out = (// [((y,lo),(outOfRangeEffects e,'<'))])-     | otherwise = id-  gt | any (\el -> snd (fst el) > hi) out = (// [((y,hi),(outOfRangeEffects e,'>'))])-     | otherwise = id--data Render = Render -  { rDelta     :: !Delta                  -- focus, the render will keep this visible-  , rLineLen   :: {-# UNPACK #-} !Int     -- actual line length-  , rLine      :: Lines -> Lines-  , rDraw      :: Delta -> Lines -> Lines-  }--instance Semigroup Render where-  Render del len doc f <> Render _ _ _ g = Render del len doc $ \d l -> f d (g d l)--ifNear :: Delta -> (Lines -> Lines) -> Delta -> Lines -> Lines-ifNear d f d' l | near d d' = f l -                | otherwise = l--instance HasDelta Render where-  delta = rDelta--class Renderable t where-  render :: t -> Render --instance Renderable Render where-  render = id--class Source t where-  source :: t -> (Int, Lines -> Lines)--instance Source String where-  source s = (P.length s', draw [] 0 0 s') where -    s' = go 0 s-    go n ('\t':xs) = let t = 8 - mod n 8 in P.replicate t ' ' ++ go (n + t) xs-    go _ ('\n':_)  = []-    go n (x:xs)    = x : go (n + 1) xs-    go _ []        = []--instance Source ByteString where-  source = source . UTF8.toString---- | create a drawing surface-surface :: Source s => Delta -> s -> Render-surface del s = case source s of -  (len, doc) -> Render del len doc (\_ l -> l)--(.#) :: (Delta -> Lines -> Lines) -> Render -> Render-f .# Render d ll s g = Render d ll s $ \e l -> f e $ g e l --instance Pretty Render where-  pretty r = prettyTerm r >>= const empty--instance Show Render where-  showsPrec _ = displayS . renderPretty 0.9 100 . prettyTerm--instance PrettyTerm Render where-  prettyTerm (Render d ll l f) = nesting $ \k -> columns $ \n -> go (n - k) where-    go cols = align (vsep (P.map ln [t..b])) where -      (lo, hi) = window (column d) ll (cols - 2)-      a = f d $ l $ array ((0,lo),(-1,hi)) []-      ((t,_),(b,_)) = bounds a-      ln y = hcat -           $ P.map (\g -> P.foldr with (string (P.map snd g)) (fst (P.head g)))-           $ groupBy ((==) `on` fst) -           [ a ! (y,i) | i <- [lo..hi] ] --window :: Int -> Int -> Int -> (Int, Int)-window c l w -  | c <= w2     = (0, min w l)-  | c + w2 >= l = if l > w then (l-w, l) else (0, w)-  | otherwise   = (c-w2,c + w2)-  where w2 = div w 2
+ Text/Trifecta/Render/Caret.hs view
@@ -0,0 +1,104 @@+module Text.Trifecta.Render.Caret+  ( Caret(..)+  , HasCaret(..)+  , Careted(..)+  , careted+  -- * Internals+  , drawCaret+  , addCaret+  , caretEffects+  ) where++import Control.Applicative+import Control.Comonad+import Data.ByteString (ByteString)+import Data.Foldable+import Data.Functor.Bind+import Data.Hashable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Traversable+import Prelude hiding (span)+import System.Console.Terminfo.Color+import System.Console.Terminfo.PrettyPrint+import Text.Trifecta.Bytes+import Text.Trifecta.Delta+import Text.Trifecta.Parser.Class+import Text.Trifecta.Render.Prim++-- |+-- > In file included from baz.c:9+-- > In file included from bar.c:4+-- > foo.c:8:36: note+-- > int main(int argc, char ** argv) { int; }+-- >                                    ^+data Caret = Caret !Delta {-# UNPACK #-} !ByteString deriving (Eq,Ord,Show)++instance Hashable Caret where+  hash (Caret d bs) = hash d `hashWithSalt` bs++caretEffects :: [ScopedEffect]+caretEffects = [soft (Foreground Green), soft Bold]++drawCaret :: Delta -> Delta -> Lines -> Lines+drawCaret p = ifNear p $ draw caretEffects 1 (column p) "^"++addCaret :: Delta -> Render -> Render+addCaret p r = drawCaret p .# r++class HasCaret t where+  caret :: t -> Caret++instance HasCaret Caret where+  caret = id++instance HasBytes Caret where+  bytes = bytes . delta++instance HasDelta Caret where+  delta (Caret d _) = d++instance Renderable Caret where+  render (Caret d bs) = addCaret d $ surface d bs++instance Semigroup Caret where+  a <> _ = a++data Careted a = a :^ Caret deriving (Eq,Ord,Show)++instance Functor Careted where+  fmap f (a :^ s) = f a :^ s++instance Extend Careted where+  extend f as@(_ :^ s) = f as :^ s++instance Comonad Careted where+  extract (a :^ _) = a++instance Foldable Careted where+  foldMap f (a :^ _) = f a++instance Traversable Careted where+  traverse f (a :^ s) = (:^ s) <$> f a++instance Foldable1 Careted where+  foldMap1 f (a :^ _) = f a++instance Traversable1 Careted where+  traverse1 f (a :^ s) = (:^ s) <$> f a++instance Renderable (Careted a) where+  render = render . caret++instance HasCaret (Careted a) where+  caret (_ :^ c) = c++instance Hashable a => Hashable (Careted a) where+  +careted :: MonadParser m => m a -> m (Careted a)+careted p = do+  m <- mark+  l <- line+  a <- p+  return $ a :^ Caret m l
+ Text/Trifecta/Render/Fixit.hs view
@@ -0,0 +1,57 @@+module Text.Trifecta.Render.Fixit+  ( Fixit(..)+  , drawFixit+  , addFixit+  , fixit+  ) where++import Data.Functor+import Data.Hashable+import Data.ByteString (ByteString)+import qualified Data.ByteString as Strict+import qualified Data.ByteString.UTF8 as UTF8+import Text.Trifecta.Bytes+import Text.Trifecta.Delta+import Text.Trifecta.Render.Prim+import Text.Trifecta.Render.Span+import Text.Trifecta.Render.Caret+import Text.Trifecta.Parser.Class+import Text.Trifecta.Util+import System.Console.Terminfo.Color+import System.Console.Terminfo.PrettyPrint+import Prelude hiding (span)++-- |+-- > int main(int argc char ** argv) { int; }+-- >                  ^+-- >                  ,+drawFixit :: Delta -> Delta -> String -> Delta -> Lines -> Lines+drawFixit s e rpl d a = ifNear l (draw [soft (Foreground Blue)] 2 (column l) rpl) d +                      $ drawSpan s e d a+  where l = argmin bytes s e++addFixit :: Delta -> Delta -> String -> Render -> Render+addFixit s e rpl r = drawFixit s e rpl .# r++data Fixit = Fixit +  { fixitSpan        :: {-# UNPACK #-} !Span+  , fixitReplacement  :: {-# UNPACK #-} !ByteString +  } deriving (Eq,Ord,Show)++instance HasSpan Fixit where+  span (Fixit s _) = s++instance HasDelta Fixit where+  delta = delta . caret++instance HasCaret Fixit where+  caret = caret . span++instance Hashable Fixit where+  hash (Fixit s b) = hash s `hashWithSalt` b++instance Renderable Fixit where+  render (Fixit (Span s e bs) r) = addFixit s e (UTF8.toString r) $ surface s bs++fixit :: MonadParser m => m Strict.ByteString -> m Fixit+fixit p = (\(r :~ s) -> Fixit s r) <$> spanned p
+ Text/Trifecta/Render/Span.hs view
@@ -0,0 +1,124 @@+module Text.Trifecta.Render.Span+  ( Span(..)+  , HasSpan(..)+  , Spanned(..)+  , spanned+  -- * Internals+  , spanEffects+  , drawSpan+  , addSpan+  ) where++import Control.Applicative+import Data.Hashable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Foldable+import Data.Traversable+import Control.Comonad+import Data.Functor.Bind+import Data.ByteString (ByteString)+import Text.Trifecta.Bytes+import Text.Trifecta.Delta+import Text.Trifecta.Render.Prim+import Text.Trifecta.Render.Caret+import Text.Trifecta.Util+import Text.Trifecta.Parser.Class+import Data.Array+import System.Console.Terminfo.Color+import System.Console.Terminfo.PrettyPrint+import Prelude as P hiding (span)++spanEffects :: [ScopedEffect]+spanEffects  = [soft (Foreground Green)]++drawSpan :: Delta -> Delta -> Delta -> Lines -> Lines+drawSpan s e d a+  | nl && nh  = go (column l) (P.replicate (max (column h   - column l + 1) 0) '~') a+  | nl        = go (column l) (P.replicate (max (snd (snd (bounds a)) - column l + 2) 0) '~') a+  |       nh  = go (-1)       (P.replicate (max (column h + 1) 0) '~') a+  | otherwise = a+  where+    go = draw spanEffects 1+    l = argmin bytes s e+    h = argmax bytes s e+    nl = near l d+    nh = near h d++-- |+-- > int main(int argc, char ** argv) { int; }+-- >                                    ^~~+addSpan :: Delta -> Delta -> Render -> Render+addSpan s e r = drawSpan s e .# r++data Span = Span !Delta !Delta {-# UNPACK #-} !ByteString deriving (Eq,Ord,Show)++instance HasCaret Span where+  caret (Span s _ b) = Caret s b++instance Renderable Span where+  render (Span s e bs) = addSpan s e $ surface s bs++class HasSpan t where+  span :: t -> Span++instance HasSpan Span where+  span = id++instance Semigroup Span where+  Span s _ b <> Span _ e _ = Span s e b+++data Spanned a = a :~ Span deriving (Eq,Ord,Show)++instance Functor Spanned where+  fmap f (a :~ s) = f a :~ s++instance Extend Spanned where+  extend f as@(_ :~ s) = f as :~ s++instance Comonad Spanned where+  extract (a :~ _) = a++instance Apply Spanned where+  (f :~ s) <.> (a :~ t) = f a :~ (s <> t)++instance Bind Spanned where+  (a :~ s) >>- f = case f a of+     b :~ t -> b :~ (s <> t)++instance Foldable Spanned where+  foldMap f (a :~ _) = f a ++instance Traversable Spanned where+  traverse f (a :~ s) = (:~ s) <$> f a++instance Foldable1 Spanned where+  foldMap1 f (a :~ _) = f a ++instance Traversable1 Spanned where+  traverse1 f (a :~ s) = (:~ s) <$> f a++instance HasSpan (Spanned a) where+  span (_ :~ c) = c++instance Renderable (Spanned a) where+  render = render . span++instance HasCaret (Spanned a) where+  caret = caret . span++instance Hashable Span where+  hash (Span s e bs) = hash s `hashWithSalt` e `hashWithSalt` bs++instance Hashable a => Hashable (Spanned a) where+  hash (a :~ s) = hash a `hashWithSalt` s++spanned :: MonadParser m => m a -> m (Spanned a)+spanned p = do+  m <- mark+  l <- line+  a <- p+  r <- mark+  return $ a :~ Span m r l
− Text/Trifecta/Rendered.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, BangPatterns, PatternGuards #-}-module Text.Trifecta.Rendered-  ( Rendered(..)-  ) where--import Control.Applicative-import Data.Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Foldable-import Data.Traversable-import Control.Comonad-import Data.Functor.Bind-import Text.Trifecta.Delta-import Text.Trifecta.Bytes-import Text.Trifecta.Render-import Prelude hiding (span)--data Rendered a = a :@ Render--instance Functor Rendered where-  fmap f (a :@ s) = f a :@ s--instance HasDelta (Rendered a) where-  delta = delta . render--instance HasBytes (Rendered a) where-  bytes = bytes . delta--instance Extend Rendered where-  extend f as@(_ :@ s) = f as :@ s--instance Comonad Rendered where-  extract (a :@ _) = a--instance Apply Rendered where-  (f :@ s) <.> (a :@ t) = f a :@ (s <> t)--instance Bind Rendered where-  (a :@ s) >>- f = case f a of-     b :@ t -> b :@ (s <> t)--instance Foldable Rendered where-  foldMap f (a :@ _) = f a --instance Traversable Rendered where-  traverse f (a :@ s) = (:@ s) <$> f a--instance Foldable1 Rendered where-  foldMap1 f (a :@ _) = f a --instance Traversable1 Rendered where-  traverse1 f (a :@ s) = (:@ s) <$> f a--instance Renderable (Rendered a) where-  render (_ :@ s) = s
Text/Trifecta/Rope.hs view
@@ -3,8 +3,8 @@   ( Rope(..)   , rope   , strands-  , grab-  , lastNewline+  , grabRest+  , grabLine   ) where  import Data.Monoid@@ -28,6 +28,20 @@ strands :: Rope -> FingerTree Delta Strand strands (Rope _ r) = r +-- | grab a the contents of a rope from a given location up to a newline+grabRest :: Delta -> Rope -> r -> (Delta -> Lazy.ByteString -> r) -> r+grabRest i t kf ks = trim (toList r) (delta l) (bytes i - bytes l) where+  trim (PathStrand p : xs) j k = trim xs (j <> delta p) k+  trim (HunkStrand (Hunk _ _ h) : xs) j 0 = go j h xs+  trim (HunkStrand (Hunk _ _ h) : xs) _ k = go i (Strict.drop k h) xs+  trim [] _ _ = kf+  go j h s = ks j $ Lazy.fromChunks $ h : [ a | HunkStrand (Hunk _ _ a) <- s ]+  (l, r) = FingerTree.split (\b -> bytes b > bytes i) $ strands t++-- | grab a the contents of a rope from a given location up to a newline+grabLine :: Delta -> Rope -> r -> (Delta -> Strict.ByteString -> r) -> r+grabLine i t kf ks = grabRest i t kf $ \c -> ks c . Strict.concat . Lazy.toChunks . Lazy.takeWhile (/= 10)+ instance HasBytes Rope where   bytes = bytes . measure @@ -36,23 +50,6 @@  instance Measured Delta Rope where   measure (Rope s _) = s---- | obtain the byte location of the last newline in a rope, or the end of the rope if at EOF-lastNewline :: Rope -> Bool -> Delta-lastNewline t True  = delta t-lastNewline t False = rewind (delta t)---- | grab a lazy bytestring starting from some point. This bytestring does not cross path nodes---   if the index is to the start of a bytestring fragment, we update it to deal with any ---   intervening path fragments-grab :: Delta -> Rope -> (Delta ->  Lazy.ByteString -> r) -> r -> r-grab i t ks kf = trim (toList r) (delta l) (bytes i - bytes l) where-  trim (PathStrand p : xs)            j k = trim xs (j <> delta p) k-  trim (HunkStrand (Hunk _ _ h) : xs) j 0 = go j h xs-  trim (HunkStrand (Hunk _ _ h) : xs) _ k = go i (Strict.drop k h) xs-  trim [] _ _                             = kf-  go j h s = ks j $ Lazy.fromChunks $ h : [ a | HunkStrand (Hunk _ _ a) <- s ]-  (l, r) = FingerTree.split (\b -> bytes b > bytes i) (strands t)  instance Monoid Rope where   mempty = Rope mempty mempty
− Text/Trifecta/Slice.hs 
@@ -1,51 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}-module Text.Trifecta.Slice-  ( slice-  , sliced-  ) where--import Control.Monad.Trans.Class-import Data.Semigroup-import Data.Interned-import Data.Foldable (toList)-import Data.FingerTree as FingerTree-import Data.ByteString as Strict-import Data.ByteString.Lazy as Lazy-import Text.Trifecta.Hunk-import Text.Trifecta.Bytes-import Text.Trifecta.Rope as Rope-import Text.Trifecta.Delta-import Text.Trifecta.Strand-import Text.Trifecta.It-import Text.Parsec.Prim hiding ((<|>))--slice :: Delta -> Delta -> P u Strict.ByteString-slice !i !j = lift (Cont loop)-  where-    bi = bytes i-    bj = bytes j-    loop t eof-      | bj <= bytes t || eof = Done t eof $ go $ strands t-      | otherwise = Cont $ \t' eof' -> loop (t <> t') eof'-    go !t-      | required <= Strict.length first = Strict.take required first-      | otherwise = Strict.concat -                  $ Lazy.toChunks -                  $ Lazy.take (fromIntegral required) -                  $ Lazy.fromChunks -                  $ first : Prelude.foldr iter [] (toList r')-      where -        iter (HunkStrand h) b = unintern h : b-        iter (PathStrand _) b = b-        (l,r) = FingerTree.split (\m -> bytes m > bi) t-        HunkStrand (Hunk _ _ a) :< r' = FingerTree.viewl r-        first = Strict.drop (bi - bytes l) a-        required = bj - bi--sliced :: (a -> Strict.ByteString -> r) -> P u a -> P u r-sliced f pa = do-  mark <- getInput-  a <- pa-  release <- getInput-  bs <- slice mark release-  return $ f a bs
− Text/Trifecta/Span.hs 
@@ -1,125 +0,0 @@-module Text.Trifecta.Span-  ( Span(..)-  , HasSpan(..)-  , Spanned(..)-  , spanned-  -- * Internals-  , spanEffects-  , drawSpan-  , addSpan-  ) where--import Control.Applicative-import Data.Hashable-import Data.Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Foldable-import Data.Traversable-import Control.Comonad-import Data.Functor.Bind-import Data.ByteString (ByteString)-import Text.Trifecta.Bytes-import Text.Trifecta.Caret-import Text.Trifecta.Delta-import Text.Trifecta.Render-import Text.Trifecta.It-import Text.Trifecta.Util-import Text.Parsec.Prim-import Data.Array-import System.Console.Terminfo.Color-import System.Console.Terminfo.PrettyPrint-import Prelude as P hiding (span)--spanEffects :: [ScopedEffect]-spanEffects  = [soft (Foreground Green)]--drawSpan :: Delta -> Delta -> Delta -> Lines -> Lines-drawSpan s e d a-  | nl && nh  = go (column l) (P.replicate (max (column h   - column l + 1) 0) '~') a-  | nl        = go (column l) (P.replicate (max (snd (snd (bounds a)) - column l + 2) 0) '~') a-  |       nh  = go (-1)       (P.replicate (max (column h + 1) 0) '~') a-  | otherwise = a-  where-    go = draw spanEffects 1-    l = argmin bytes s e-    h = argmax bytes s e-    nl = near l d-    nh = near h d---- |--- > int main(int argc, char ** argv) { int; }--- >                                    ^~~-addSpan :: Delta -> Delta -> Render -> Render-addSpan s e r = drawSpan s e .# r--data Span = Span !Delta !Delta {-# UNPACK #-} !ByteString deriving (Eq,Ord,Show)--instance HasCaret Span where-  caret (Span s _ b) = Caret s b--instance Renderable Span where-  render (Span s e bs) = addSpan s e $ surface s bs--class HasSpan t where-  span :: t -> Span--instance HasSpan Span where-  span = id--instance Semigroup Span where-  Span s _ b <> Span _ e _ = Span s e b---data Spanned a = a :~ Span deriving (Eq,Ord,Show)--instance Functor Spanned where-  fmap f (a :~ s) = f a :~ s--instance Extend Spanned where-  extend f as@(_ :~ s) = f as :~ s--instance Comonad Spanned where-  extract (a :~ _) = a--instance Apply Spanned where-  (f :~ s) <.> (a :~ t) = f a :~ (s <> t)--instance Bind Spanned where-  (a :~ s) >>- f = case f a of-     b :~ t -> b :~ (s <> t)--instance Foldable Spanned where-  foldMap f (a :~ _) = f a --instance Traversable Spanned where-  traverse f (a :~ s) = (:~ s) <$> f a--instance Foldable1 Spanned where-  foldMap1 f (a :~ _) = f a --instance Traversable1 Spanned where-  traverse1 f (a :~ s) = (:~ s) <$> f a--instance HasSpan (Spanned a) where-  span (_ :~ c) = c--instance Renderable (Spanned a) where-  render = render . span--instance HasCaret (Spanned a) where-  caret = caret . span--instance Hashable Span where-  hash (Span s e bs) = hash s `hashWithSalt` e `hashWithSalt` bs--instance Hashable a => Hashable (Spanned a) where-  hash (a :~ s) = hash a `hashWithSalt` s--spanned :: P u a -> P u (Spanned a)-spanned p = do-  m <- getInput-  l <- line m-  a <- p-  r <- getInput-  return $ a :~ Span m r l
− Text/Trifecta/Supply.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-module Text.Trifecta.Supply -  ( Supply(..)-  , EOF(EOF)-  , supplyEOF-  -- * type restricted versions of supply-  , supplyDefault-  , supplyStrand-  , supplyHunk-  , supplyPath-  , supplyByteString-  ) where--import Control.Parallel.Strategies hiding (Done)-import Data.Monoid-import Data.Semigroup.Reducer-import Data.Foldable-import Data.Word-import Data.Semigroup.Foldable-import Data.List.NonEmpty-import Data.FingerTree as FingerTree-import qualified Data.ByteString as Strict-import qualified Data.ByteString.Lazy as Lazy-import Data.ByteString.UTF8 as UTF8-import Text.Trifecta.Path-import Text.Trifecta.Rope-import Text.Trifecta.Hunk-import Text.Trifecta.Strand-import Text.Trifecta.It---- enumerators for our iteratee--class Supply t where-  supply :: t -> It a -> It a -  supplyList :: [t] -> It a -> It a -  supplyList = Prelude.foldr (\t b -> b . supply t) id--data EOF = EOF--instance Supply EOF where-  supply _ = supplyEOF--supplyEOF :: It a -> It a-supplyEOF (Cont k)     = k mempty True-supplyEOF (Done r _ a) = Done r True a-supplyEOF (Fail r _ a) = Fail r True a--supplyDefault :: Reducer t Rope => t -> It a -> It a-supplyDefault new (Done old _ a) = Done (snoc old new) False a-supplyDefault new (Fail old _ a) = Fail (snoc old new) False a-supplyDefault new (Cont k)       = k (unit new) False--supplyStrand :: Strand -> It a -> It a -supplyStrand = supplyDefault--supplyHunk :: Hunk -> It a -> It a-supplyHunk = supplyDefault--supplyPath :: Path -> It a -> It a-supplyPath = supplyDefault--supplyByteString :: ByteString -> It a -> It a -supplyByteString = supplyDefault---- DO NOT WANT-instance Supply Word8 where-  supply = supplyByteString . Strict.singleton-  supplyList = supplyByteString . Strict.pack--instance Supply Char where-  supply c = supplyByteString (UTF8.fromString [c])-  supplyList = supplyByteString . UTF8.fromString--instance Supply a => Supply [a] where-  supply = supplyList--instance Supply Strict.ByteString where-  supply = supplyByteString-  supplyList = supplyList . Prelude.map (HunkStrand . hunk)--instance Supply Lazy.ByteString where-  supply = supplyList . Lazy.toChunks --instance Supply Hunk where-  supply = supplyHunk-  supplyList = supplyList . Prelude.map HunkStrand--instance Supply Path where-  supply = supplyPath-  supplyList [] = id-  supplyList (x:xs) = supplyPath $ fold1 (x :| xs)--instance Supply Strand where-  supply = supplyStrand-  supplyList xs = supply (rope (FingerTree.fromList xs')) where-     !xs' = withStrategy (evalList rseq) xs--instance Supply Rope where-  supply = supplyDefault-  supplyList = supplyDefault . fold
Text/Trifecta/Util.hs view
@@ -7,9 +7,11 @@ argmin f a b   | f a <= f b = a   | otherwise = b+{-# INLINE argmin #-}  argmax :: Ord b => (a -> b) -> a -> a -> a argmax f a b   | f a > f b = a   | otherwise = b+{-# INLINE argmax #-}
+ Text/Trifecta/Util/MaybePair.hs view
@@ -0,0 +1,61 @@+module Text.Trifecta.Util.MaybePair+  ( MaybePair(..)+  ) where++import Control.Applicative+import Data.Semigroup+import Data.Monoid+import Data.Functor.Apply+import Data.Functor.Plus+import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable+import Data.Foldable+import Data.Traversable++data MaybePair a b = JustPair a b | NothingPair++instance (Semigroup a, Semigroup b) => Semigroup (MaybePair a b) where+  a <> NothingPair = a+  NothingPair <> b = b+  JustPair a b <> JustPair c d = JustPair (a <> c) (b <> d)++instance (Semigroup a, Semigroup b) => Monoid (MaybePair a b) where+  mappend = (<>) +  mempty = NothingPair++instance Bifunctor MaybePair where+  bimap f g (JustPair a b) = JustPair (f a) (g b)+  bimap _ _ NothingPair = NothingPair+ +instance Functor (MaybePair a) where+  fmap f (JustPair a b) = JustPair a (f b)+  fmap _ NothingPair = NothingPair++instance Semigroup a => Apply (MaybePair a) where+  JustPair a b <.> JustPair c d = JustPair (a <> c) (b d)+  _ <.> _ = NothingPair++instance Semigroup a => Alt (MaybePair a) where+  a <!> NothingPair = a+  NothingPair <!> b = b+  JustPair a b <!> JustPair c _ = JustPair (a <> c) b++instance Semigroup a => Plus (MaybePair a) where+  zero = NothingPair++instance Foldable (MaybePair a) where+  foldMap f (JustPair _ b) = f b+  foldMap _ NothingPair = mempty++instance Traversable (MaybePair a) where+  traverse f (JustPair a b) = JustPair a <$> f b+  traverse _ NothingPair = pure NothingPair++instance Bifoldable MaybePair where+  bifoldMap f g (JustPair a b) = f a `mappend` g b+  bifoldMap _ _ NothingPair = mempty++instance Bitraversable MaybePair where+  bitraverse f g (JustPair a b) = JustPair <$> f a <*> g b+  bitraverse _ _ NothingPair = pure NothingPair
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing-version:       0.11+version:       0.12 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -44,21 +44,26 @@    exposed-modules:     Text.Trifecta+    Text.Trifecta.Bytes+    Text.Trifecta.Delta+    Text.Trifecta.Diagnostic+    Text.Trifecta.Diagnostic.Level+    Text.Trifecta.Hunk     Text.Trifecta.It+    Text.Trifecta.Parser.Char+    Text.Trifecta.Parser.Class+    Text.Trifecta.Parser.Err+    Text.Trifecta.Parser.Err.State+    Text.Trifecta.Parser.Prim+    Text.Trifecta.Parser.Result+    Text.Trifecta.Parser.Step     Text.Trifecta.Path+    Text.Trifecta.Render.Caret+    Text.Trifecta.Render.Fixit+    Text.Trifecta.Render.Span     Text.Trifecta.Rope-    Text.Trifecta.Hunk-    Text.Trifecta.Span-    Text.Trifecta.Bytes-    Text.Trifecta.Caret-    Text.Trifecta.Fixit-    Text.Trifecta.Delta-    Text.Trifecta.Slice     Text.Trifecta.Strand-    Text.Trifecta.Supply-    Text.Trifecta.Render-    Text.Trifecta.Rendered-    Text.Trifecta.Diagnostic+    Text.Trifecta.Util.MaybePair    other-modules:     Text.Trifecta.Util