trifecta 0.8.0.1 → 0.9
raw patch · 10 files changed
+176/−156 lines, 10 files
Files
- Text/Trifecta.hs +2/−2
- Text/Trifecta/Caret.hs +24/−1
- Text/Trifecta/Fixit.hs +23/−4
- Text/Trifecta/It.hs +14/−1
- Text/Trifecta/Parser.hs +0/−86
- Text/Trifecta/Render.hs +2/−55
- Text/Trifecta/Slice.hs +51/−0
- Text/Trifecta/Span.hs +40/−5
- Text/Trifecta/Util.hs +15/−0
- trifecta.cabal +5/−2
Text/Trifecta.hs view
@@ -8,9 +8,9 @@ , 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.Parser , module Text.Trifecta.Render , module Text.Trifecta.Rendered ) where@@ -24,8 +24,8 @@ 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.Parser import Text.Trifecta.Render import Text.Trifecta.Rendered
Text/Trifecta/Caret.hs view
@@ -2,6 +2,11 @@ ( Caret(..) , HasCaret(..) , Careted(..)+ , careted+ -- * Internals+ , drawCaret+ , addCaret+ , caretEffects ) where import Control.Applicative@@ -17,6 +22,10 @@ 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) -- |@@ -30,6 +39,15 @@ 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 @@ -79,4 +97,9 @@ 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/Fixit.hs view
@@ -1,22 +1,38 @@ 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.Delta-import Text.Trifecta.Render+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) -- |--- > In file included from bar.c:12--- > foo.c:12:17: note -- > 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 @@ -36,3 +52,6 @@ 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,15 +1,19 @@ {-# LANGUAGE MultiParamTypeClasses, BangPatterns #-} module Text.Trifecta.It - ( It(..)+ ( P+ , It(..) , input+ , line , peekIt ) where import Control.Applicative 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@@ -18,6 +22,15 @@ 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) data It a = Done !Rope !Bool a
− Text/Trifecta/Parser.hs
@@ -1,86 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}-module Text.Trifecta.Parser- ( P- , line- , slice- , sliced- , careted- , spanned- , fixit- ) where--import Control.Applicative-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.Caret-import Text.Trifecta.Span-import Text.Trifecta.Fixit-import Text.Trifecta.It-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)--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 :: P u a -> P u Strict.ByteString-sliced pa = do- mark <- getInput- _ <- pa- release <- getInput- slice mark release--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--careted :: P u a -> P u (Careted a)-careted p = do- m <- getInput- l <- line m- a <- p - return $ a :^ Caret m l--fixit :: P u Strict.ByteString -> P u Fixit-fixit p = (\(rep :~ s) -> Fixit s rep) <$> spanned p
Text/Trifecta/Render.hs view
@@ -5,18 +5,11 @@ , Renderable(..) , Source(..) , surface- , addCaret- , addSpan- , addFixit -- * Lower level drawing primitives+ , Lines , draw , ifNear , (.#)- , drawCaret- , drawFixit- , drawSpan- -- * Internals- , caretEffects, fixitEffects, spanEffects, outOfRangeEffects ) where import Data.ByteString hiding (groupBy, empty, any)@@ -26,19 +19,11 @@ import Text.Trifecta.Delta import Data.Semigroup import Data.Array-import Text.Trifecta.Bytes import Text.PrettyPrint.Leijen.Extras hiding (column)-import System.Console.Terminfo.Color import System.Console.Terminfo.PrettyPrint import Control.Monad.State import Prelude as P -caretEffects, fixitEffects, spanEffects, sourceEffects :: [ScopedEffect]-caretEffects = [soft (Foreground Green), soft Bold]-fixitEffects = [soft (Foreground Blue)]-spanEffects = [soft (Foreground Green)]-sourceEffects = []- outOfRangeEffects :: [ScopedEffect] -> [ScopedEffect] outOfRangeEffects xs = soft Bold : xs @@ -91,7 +76,7 @@ source :: t -> (Int, Lines -> Lines) instance Source String where- source s = (P.length s', draw sourceEffects 0 0 s') 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':_) = []@@ -106,37 +91,9 @@ surface del s = case source s of (len, doc) -> Render del len doc (\_ l -> l) -drawCaret :: Delta -> Delta -> Lines -> Lines-drawCaret p = ifNear p $ draw caretEffects 1 (column p) "^"- (.#) :: (Delta -> Lines -> Lines) -> Render -> Render f .# Render d ll s g = Render d ll s $ \e l -> f e $ g e l -addCaret :: Delta -> Render -> Render-addCaret p r = drawCaret p .# r--drawSpan :: Delta -> Delta -> Delta -> Lines -> Lines-drawSpan s e d a- | nl && nh = draw spanEffects 1 (column l) (P.replicate (max (column h - column l + 1) 0) '~') a- | nl = draw spanEffects 1 (column l) (P.replicate (max (snd (snd (bounds a)) - column l + 2) 0) '~') a- | nh = draw spanEffects 1 (-1) (P.replicate (max (column h + 1) 0) '~') a- | otherwise = a- where - l = argmin bytes s e - h = argmax bytes s e- nl = near l d- nh = near h d--addSpan :: Delta -> Delta -> Render -> Render-addSpan s e r = drawSpan s e .# r--drawFixit :: Delta -> Delta -> String -> Delta -> Lines -> Lines-drawFixit s e rpl d a = ifNear l (draw fixitEffects 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- instance Pretty Render where pretty r = prettyTerm r >>= const empty @@ -160,13 +117,3 @@ | c + w2 >= l = if l > w then (l-w, l) else (0, w) | otherwise = (c-w2,c + w2) where w2 = div w 2--argmin :: Ord b => (a -> b) -> a -> a -> a-argmin f a b - | f a <= f b = a- | otherwise = b--argmax :: Ord b => (a -> b) -> a -> a -> a-argmax f a b - | f a > f b = a- | otherwise = b
+ Text/Trifecta/Slice.hs view
@@ -0,0 +1,51 @@+{-# 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 view
@@ -2,6 +2,11 @@ ( Span(..) , HasSpan(..) , Spanned(..)+ , spanned+ -- * Internals+ , spanEffects+ , drawSpan+ , addSpan ) where import Control.Applicative@@ -14,16 +19,40 @@ import Control.Comonad import Data.Functor.Bind import Data.ByteString (ByteString)-import Text.Trifecta.Delta+import Text.Trifecta.Bytes import Text.Trifecta.Caret+import Text.Trifecta.Delta import Text.Trifecta.Render-import Prelude hiding (span)+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+ -- |--- > In file included from bar.c:9--- > foo.c:8:36: note -- > 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@@ -87,4 +116,10 @@ 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/Util.hs view
@@ -0,0 +1,15 @@+module Text.Trifecta.Util + ( argmin+ , argmax+ ) where++argmin :: Ord b => (a -> b) -> a -> a -> a+argmin f a b+ | f a <= f b = a+ | otherwise = b++argmax :: Ord b => (a -> b) -> a -> a -> a+argmax f a b+ | f a > f b = a+ | otherwise = b+
trifecta.cabal view
@@ -1,6 +1,6 @@ name: trifecta category: Text, Parsing-version: 0.8.0.1+version: 0.9 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -52,8 +52,11 @@ Text.Trifecta.Span Text.Trifecta.Fixit Text.Trifecta.Delta+ Text.Trifecta.Slice Text.Trifecta.Strand Text.Trifecta.Supply- Text.Trifecta.Parser Text.Trifecta.Render Text.Trifecta.Rendered++ other-modules:+ Text.Trifecta.Util