packages feed

trifecta 0.2 → 0.3

raw patch · 13 files changed

+466/−244 lines, 13 filesdep ~reducers

Dependency ranges changed: reducers

Files

Text/Trifecta.hs view
@@ -1,17 +1,23 @@ module Text.Trifecta -  ( module Text.Trifecta.Cursor-  , module Text.Trifecta.Delta+  ( module Text.Trifecta.It   , module Text.Trifecta.Hunk-  , module Text.Trifecta.It   , module Text.Trifecta.Path   , module Text.Trifecta.Rope+  , module Text.Trifecta.Bytes+  , module Text.Trifecta.Caret+  , module Text.Trifecta.Delta+  , module Text.Trifecta.Strand   , module Text.Trifecta.Supply+  , module Text.Trifecta.Parser   ) where -import Text.Trifecta.Cursor-import Text.Trifecta.Delta-import Text.Trifecta.Hunk import Text.Trifecta.It+import Text.Trifecta.Hunk import Text.Trifecta.Path import Text.Trifecta.Rope+import Text.Trifecta.Caret+import Text.Trifecta.Bytes+import Text.Trifecta.Delta+import Text.Trifecta.Strand import Text.Trifecta.Supply+import Text.Trifecta.Parser
+ Text/Trifecta/Bytes.hs view
@@ -0,0 +1,15 @@+module Text.Trifecta.Bytes+  ( HasBytes(..)+  ) where++import Data.ByteString as Strict+import Data.FingerTree++class HasBytes t where+  bytes :: t -> Int++instance HasBytes ByteString where+  bytes = Strict.length++instance (Measured v a, HasBytes v) => HasBytes (FingerTree v a) where+  bytes = bytes . measure
+ Text/Trifecta/Caret.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, BangPatterns, PatternGuards #-}+module Text.Trifecta.Caret+  ( Caret(..)+  , HasCaret(..)+  , Careted(..)+  , Cover(..)+  , HasCover(..)+  , Covered(..)+  , Fixit(..)+  , Diagnostic(..)+  ) where++import Data.Hashable+import Data.ByteString as Strict+import Text.Trifecta.Delta++-- |+-- > 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++class HasCaret t where+  caret :: t -> Caret++instance HasCaret Caret where+  caret = id++data Careted a = a :^ Caret deriving (Eq,Ord,Show)++instance HasCaret (Careted a) where+  caret (_ :^ c) = c++instance Hashable a => Hashable (Careted a) where+  +-- |+-- > In file included from bar.c:9+-- > foo.c:8:36: note+-- > int main(int argc, char ** argv) { int; }+-- >                                    ^~~+data Cover = Cover {-# UNPACK #-} !Caret !Delta deriving (Eq,Ord,Show)++instance HasCaret Cover where+  caret (Cover c _) = c++class HasCover t where+  cover :: t -> Cover++instance HasCover Cover where+  cover = id++data Covered a = a :~ Cover deriving (Eq,Ord,Show)++instance HasCover (Covered a) where+  cover (_ :~ c) = c++instance HasCaret (Covered a) where+  caret = caret . cover++instance Hashable Cover where+  hash (Cover c bs) = hash c `hashWithSalt` bs++instance Hashable a => Hashable (Covered a) where+  hash (a :~ s) = hash a `hashWithSalt` s++-- |+-- > In file included from bar.c:12+-- > foo.c:12:17: note+-- > int main(int argc char ** argv) { int; }+-- >                  ^+-- >                  ,+data Fixit = Fixit +  { fixitCover        :: {-# UNPACK #-} !Cover+  , fixitReplacement  :: {-# UNPACK #-} !ByteString +  } deriving (Eq,Ord,Show)++instance HasCover Fixit where+  cover (Fixit s _) = s++instance HasCaret Fixit where+  caret = caret . cover++instance Hashable Fixit where+  hash (Fixit s b) = hash s `hashWithSalt` b++-- |+-- > In file included from bar.h:12+-- > baz.h:12:17: note+-- > foo + bar+-- > ~~~ ^ ~~~+data Diagnostic = Diagnostic !Caret [Cover] [Fixit]++instance HasCaret Diagnostic where+  caret (Diagnostic c _ _) = c++instance Hashable Diagnostic where+  hash (Diagnostic c ss fs) = hash c `hashWithSalt` ss `hashWithSalt` fs
− Text/Trifecta/Cursor.hs 
@@ -1,34 +0,0 @@-module Text.Trifecta.Cursor -  ( Cursor(..)-  ) where--import Data.Hashable-import Data.Monoid-import Data.Sequence-import Data.Interned-import Data.Semigroup-import Data.Foldable--import Text.Trifecta.Delta--data Cursor = Cursor -  { cursorBytes   :: {-# UNPACK #-} !Int-  , cursorDelta   :: !Delta-  , cursorSeqHash :: {-# UNPACK #-} !Int-  , cursorSeq     :: !(Seq Id)-  } deriving Show---instance Eq Cursor where-  Cursor _ _ h k == Cursor _ _ h' k' = h == h' && k == k'--instance Hashable Cursor where-  hash (Cursor _ _ _ s) = hash (toList s)-    -instance Monoid Cursor where-  mempty = Cursor 0 mempty 0 mempty-  Cursor s d l q `mappend` Cursor s' d' l' q' = Cursor (s + s') (d <> d') (l + l') (q <> q')--instance Semigroup Cursor where-  Cursor s d l q <> Cursor s' d' l' q' = Cursor (s + s') (d <> d') (l + l') (q <> q')-
Text/Trifecta/Delta.hs view
@@ -2,6 +2,8 @@   ( Delta(..)    , HasDelta(..)   , nextTab+  , rewind+  , near   ) where  import Data.Monoid@@ -9,65 +11,102 @@ import Data.Hashable import Data.Word import Data.Foldable+import Data.FingerTree import Data.ByteString import Text.Trifecta.Path+import Text.Trifecta.Bytes  data Delta-  = Directed                 !Path -- ^ the sequence of #line directives since the start of the file-              {-# UNPACK #-} !Int  -- ^ the number of lines since the last line directive+  = Columns   {-# UNPACK #-} !Int  -- ^ the number of characters+              {-# UNPACK #-} !Int  -- ^ the number of bytes+  | Tab       {-# UNPACK #-} !Int  -- ^ the number of characters before the tab+              {-# UNPACK #-} !Int  -- ^ the number of characters after the tab+              {-# UNPACK #-} !Int  -- ^ the number of bytes+  | Lines     {-# UNPACK #-} !Int  -- ^ the number of newlines contained               {-# UNPACK #-} !Int  -- ^ the number of characters since the last newline+              {-# UNPACK #-} !Int  -- ^ number of bytes               {-# UNPACK #-} !Int  -- ^ the number of bytes since the last newline-  | Lines     {-# UNPACK #-} !Int  -- ^ the number of newlines contained+  | Directed                 !Path -- ^ the sequence of #line directives since the start of the file+              {-# UNPACK #-} !Int  -- ^ the number of lines since the last line directive               {-# UNPACK #-} !Int  -- ^ the number of characters since the last newline+              {-# UNPACK #-} !Int  -- ^ number of bytes               {-# UNPACK #-} !Int  -- ^ the number of bytes since the last newline-  | Tab       {-# UNPACK #-} !Int  -- ^ the number of characters before the tab-              {-# UNPACK #-} !Int  -- ^ the number of characters after the tab-              {-# UNPACK #-} !Int  -- ^ the number of bytes in this range-  | Columns   {-# UNPACK #-} !Int  -- ^ the number of characters-              {-# UNPACK #-} !Int  -- ^ the number of bytes-  deriving Show+  deriving (Eq, Ord, Show) +instance HasBytes Delta where+  bytes (Columns _ b) = b+  bytes (Tab _ _ b) = b+  bytes (Lines _ _ b _) = b+  bytes (Directed _ _ _ b _) = b+ instance Hashable Delta where-  hash (Columns c a)      = 0 `hashWithSalt` c `hashWithSalt` a-  hash (Tab x y a)        = 1 `hashWithSalt` x `hashWithSalt` y `hashWithSalt` a-  hash (Lines l c a)      = 2 `hashWithSalt` l `hashWithSalt` c `hashWithSalt` a-  hash (Directed p l c a) = 3 `hashWithSalt` p `hashWithSalt` l `hashWithSalt` c `hashWithSalt` a+  hash (Columns c a)        = 0 `hashWithSalt` c `hashWithSalt` a+  hash (Tab x y a)          = 1 `hashWithSalt` x `hashWithSalt` y `hashWithSalt` a+  hash (Lines l c b a)      = 2 `hashWithSalt` l `hashWithSalt` c `hashWithSalt` b `hashWithSalt` a+  hash (Directed p l c b a) = 3 `hashWithSalt` p `hashWithSalt` l `hashWithSalt` c `hashWithSalt` b `hashWithSalt` a  instance Monoid Delta where   mempty = Columns 0 0   mappend = (<>)  instance Semigroup Delta where-  Columns c a      <> Columns d b         = Columns (c + d) (a + b)-  Columns c a      <> Tab x y b           = Tab (c + x) y (a + b)-  Lines l c a      <> Columns d b         = Lines l (c + d) (a + b)-  Lines l _ _      <> Lines m d b         = Lines (l + m) d b-  Lines l c a      <> Tab x y b           = Lines l (nextTab (c + x) + y) (a + b)-  Tab x y a        <> Columns d b         = Tab x (y + d) (a + b)-  Tab x y a        <> Tab x' y' b         = Tab x (nextTab (y + x') + y') (a + b) -  Directed p l _ a <> Lines m d b         = Directed p (l + m) d (a + b)-  Directed p l c a <> Columns d b         = Directed p l (c + d) (a + b)-  Directed p l c a <> Tab x y b           = Directed p l (nextTab (c + x) + y) (a + b)-  Directed p l _ _ <> Directed p' l' c' b = Directed (appendPath p l p') l' c' b-  _                <> t                   = t+  Columns c a        <> Columns d b            = Columns (c + d) (a + b)+  Columns c a        <> Tab x y b              = Tab (c + x) y (a + b)+  Columns _ a        <> Lines l c t a'         = Lines l c (t + a) a'+  Columns _ a        <> Directed p l c t a'    = Directed p l c (t + a) a'+  Lines l c t a      <> Columns d b            = Lines l (c + d) (t + b) (a + b)+  Lines l c t a      <> Tab x y b              = Lines l (nextTab (c + x) + y) (t + b) (a + b)+  Lines l _ t _      <> Lines m d t' b         = Lines (l + m) d (t + t') b+  Lines _ _ t _      <> Directed p l c t' a    = Directed p l c (t + t') a+  Tab x y a          <> Columns d b            = Tab x (y + d) (a + b)+  Tab x y a          <> Tab x' y' b            = Tab x (nextTab (y + x') + y') (a + b) +  Tab _ _ a          <> Lines l c t a'         = Lines l c (t + a) a'+  Tab _ _ a          <> Directed p l c t a'    = Directed p l c (t + a) a' +  Directed p l c t a <> Columns d b            = Directed p l (c + d) (t + b) (a + b)+  Directed p l c t a <> Tab x y b              = Directed p l (nextTab (c + x) + y) (t + b) (a + b)+  Directed p l _ t a <> Lines m d t' b         = Directed p (l + m) d (t + t') (a + b)+  Directed p l _ t _ <> Directed p' l' c' t' b = Directed (appendPath p l p') l' c' (t + t') b    nextTab :: Int -> Int nextTab x = x + (8 - mod x 8) +rewind :: Delta -> Delta+rewind (Lines n _ b d)      = Lines n 0 (b - d) 0+rewind (Directed p n _ b d) = Directed p n 0 (b - d) 0+rewind _                    = Columns 0 0 ++near :: Delta -> Delta -> Bool+near (Directed p l _ _ _) (Directed p' l' _ _ _) = p == p' && l == l'+near (Lines l _ _ _) (Lines l' _ _ _) = l == l'+near _ _ = True+ class HasDelta t where   delta :: t -> Delta +instance HasDelta Delta where+  delta = id+ instance HasDelta Char where   delta '\t' = Tab 0 0 1-  delta '\n' = Lines 1 0 0-  delta _    = Columns 1 1+  delta '\n' = Lines 1 0 1 0+  delta c | o <= 0x7f   = Columns 1 1+          | o <= 0x7ff  = Columns 1 2+          | o <= 0xffff = Columns 1 3+          | otherwise   = Columns 1 4+    where o = fromEnum c  instance HasDelta Word8 where   delta 9  = Tab 0 0 1-  delta 10 = Lines 1 0 0+  delta 10 = Lines 1 0 1 0   delta n | n <= 0x7f              = Columns 1 1           | n >= 0xc0 && n <= 0xf4 = Columns 1 1           | otherwise              = Columns 0 1  instance HasDelta ByteString where   delta = foldMap delta . unpack++instance HasDelta Path where+  delta p = Directed p 0 0 0 0++instance (Measured v a, HasDelta v) => HasDelta (FingerTree v a) where+  delta = delta . measure
Text/Trifecta/Hunk.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances #-} module Text.Trifecta.Hunk    ( Hunk(..)+  , hunk   ) where  import Data.ByteString-import Data.FingerTree+import Data.FingerTree as FingerTree import Data.Function (on) import Data.Hashable import Data.Interned@@ -13,10 +14,12 @@ import GHC.IO import Text.Trifecta.Delta import Text.PrettyPrint.Leijen.Extras---import Control.Exception  data Hunk = Hunk {-# UNPACK #-} !Id !Delta {-# UNPACK #-} !ByteString +hunk :: ByteString -> Hunk+hunk = intern + -- assuming utf8 encoding prettyByteString :: ByteString -> Doc e prettyByteString bs = string (Text.unpack (toUnicode (unsafeDupablePerformIO (open "UTF8" Nothing)) bs))@@ -27,7 +30,6 @@ instance Show Hunk where   showsPrec _ h = displayS (renderPretty 0.9 80 (pretty h)) - instance Eq Hunk where   (==) = (==) `on` identity @@ -46,7 +48,6 @@   describe = Describe   identify i bs = Hunk i (delta bs) bs   identity (Hunk i _ _) = i--- modifyAdvice = bracket_ (Prelude.putStrLn "entering hunk") (Prelude.putStrLn "exiting hunk")   cache = hunkCache  instance Uninternable Hunk where
Text/Trifecta/It.hs view
@@ -1,30 +1,19 @@ {-# LANGUAGE MultiParamTypeClasses, BangPatterns #-} module Text.Trifecta.It    ( It(..)-  , getRope-  , getMeasure-  , getEof-  , getWord8-  , sliceIt-  , slice-  , sliced+  , input+  , peekIt   ) where  import Control.Applicative import Control.Monad-import Control.Monad.Trans.Class import Data.Semigroup import Data.Monoid-import Data.Word-import Data.Interned-import Data.Foldable (toList) 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.Cursor-import Text.Trifecta.Hunk import Text.Trifecta.Rope as Rope import Text.Trifecta.Delta import Text.Parsec.Prim hiding ((<|>))@@ -81,61 +70,19 @@   mplus = (<!>)    mzero = fail "mzero" -getRope :: It Rope-getRope = Cont $ \r e -> Done r e r--getMeasure :: It Cursor-getMeasure = Cont $ \r e -> Done r e (measure r)--getEof :: It Bool-getEof = Cont $ \ r e -> Done r e e +input :: It Rope+input = Cont $ \r e -> Done r e r -instance Stream Cursor It Char where-  uncons (Cursor b d _ _) = (getWord8 b >>= go) <|> return Nothing where-    go c | c <= 0x7f = do-        Cursor _ _ i t <- getMeasure-        return $ Just (toEnum (fromEnum c), Cursor (b + 1) (d <> delta c) i t) -- TODO: add in PathHunks-         | otherwise = error "TODO"-    -- TODO: finish these+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 -getWord8 :: Int -> It Word8-getWord8 n = Cont go where+peekIt :: Delta -> It (Delta, Lazy.ByteString)+peekIt n = Cont go where   go h eof -    | n < Rope.lastNewline h eof = Done h eof $ indexByte n h-    | eof                        = Fail h True "Unexpected EOF"-    | otherwise                  = Cont $ \h' -> go (h <> h') -- h' <> h--sliceIt :: Int -> Int -> It Strict.ByteString-sliceIt !i !j = Cont go where-  go :: Rope -> Bool -> It Strict.ByteString-  go t@(Rope _ h) eof-    | j <= cursorBytes (measure h) || eof = Done t eof (sliceStrands h)-    | otherwise = Cont $ \t' eof' -> go (t <> t') eof'-  sliceStrands :: FingerTree Cursor Strand -> Strict.ByteString-  sliceStrands !t-    | req <= rmn = Strict.take req first -- yay! sharing-    | otherwise = Strict.concat -                $ Lazy.toChunks -                $ Lazy.take (fromIntegral req) -                $ 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 -> cursorBytes m > i) t-          HunkStrand (Hunk _ _ a) :< r' = FingerTree.viewl r-          first = Strict.drop (i - cursorBytes (measure l)) a-          req = j - i-          rmn = Strict.length first--slice :: Cursor -> Cursor -> ParsecT Cursor u It Strict.ByteString-slice mark release = lift $ sliceIt (cursorBytes mark) (cursorBytes release)--sliced :: ParsecT Cursor u It a -> ParsecT Cursor u It Strict.ByteString-sliced p = do-  mark <- getInput-  _ <- p-  release <- getInput-  slice mark release---- sliceDelta :: Int -> Int -> It Delta-+    | n < 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
+ Text/Trifecta/Parser.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}+module Text.Trifecta.Parser+  ( P+  , line+  , slice+  , sliced+  , careted+  , covered+  ) 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.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++covered :: P u a -> P u (Covered a)+covered p = do+  m <- getInput+  l <- line m+  a <- p+  r <- getInput+  return $ a :~ Cover (Caret m l) r++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/Path.hs view
@@ -12,14 +12,16 @@ import Data.Hashable import Data.Interned import Data.Interned.String---import Control.Exception+import Data.Function (on) import Data.Semigroup import Text.PrettyPrint.Leijen.Extras  type FileName = InternedString  data Path = Path {-# UNPACK #-} !Id !History !MaybeFileName {-# UNPACK #-} !Int [Int]+  deriving Show +-- Todo: Make a prettier path prettyPathWith :: (Doc e -> Doc e) -> Path -> Int -> Doc e  prettyPathWith wrapDir = go where   go (Path _ h mf l flags) delta @@ -35,19 +37,26 @@ instance Pretty Path where   pretty p = prettyPathWith id p 0 -instance Show Path where-  showsPrec _ p = displayS (renderPretty 0.9 80 (pretty p)) -data History = Continue !Path {-# UNPACK #-} !Int | Complete-data MaybeFileName = JustFileName !FileName | NothingFileName deriving Eq+instance Eq Path where+  (==) = (==) `on` identity +-- NB: this is subtle in that it also lets us say +-- if one might be a prefix of the other due to+-- the way we construct the hash cons table+instance Ord Path where+  compare = compare `on` identity++data History = Continue !Path {-# UNPACK #-} !Int | Complete deriving (Eq, Show)++data MaybeFileName = JustFileName !FileName | NothingFileName deriving (Eq, Show)+ startPath :: FileName -> Path  startPath !n = path Complete (JustFileName n) 0 []  snocPath :: Path -> Int -> MaybeFileName -> Int -> [Int] -> Path snocPath d l jf l' flags = path (Continue d l) jf l' flags --- does case analysis to ensure the Maybe carries a fully evaluated argument path :: History -> MaybeFileName -> Int -> [Int] -> Path path !h !mf l flags = intern (UPath h mf l flags) @@ -79,7 +88,6 @@         JustFileName f -> Just (identity f)         NothingFileName -> Nothing                      ---  modifyAdvice = bracket_ (putStrLn "entering path") (putStrLn "exiting path")   identify i (UPath h mf l flags) = Path i h mf l flags   identity (Path i _ _ _ _) = i   cache = pathCache
Text/Trifecta/Rope.hs view
@@ -1,90 +1,100 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, BangPatterns, PatternGuards #-} module Text.Trifecta.Rope-  ( Strand(..)-  , Rope(..)-  , indexByte-  , size+  ( Rope(..)+  , rope+  , strands+  , grab   , lastNewline   ) where -import Data.Sequence as Seq-import Data.Interned-import Data.Hashable import Data.Monoid import Data.Semigroup-import Data.ByteString as Strict+import Data.Semigroup.Reducer+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Lazy as Lazy import Data.FingerTree as FingerTree-import Data.Word import Data.Foldable (toList) import Text.Trifecta.Hunk import Text.Trifecta.Path-import Text.Trifecta.Cursor import Text.Trifecta.Delta--- import Control.Exception+import Text.Trifecta.Bytes+import Text.Trifecta.Strand -data Strand-  = HunkStrand !Hunk-  | PathStrand !Path+data Rope = Rope !Delta !(FingerTree Delta Strand) -instance Show Strand where-  showsPrec d (HunkStrand h) = showsPrec d h-  showsPrec d (PathStrand p) = showsPrec d p+rope :: FingerTree Delta Strand -> Rope+rope r = Rope (measure r) r --- measure twice, cut once-instance Measured Cursor Strand where-  measure (HunkStrand s) = Cursor (Strict.length (unintern s)) (delta s) i (Seq.singleton i) where i = 42 + (identity s * 2)-  measure (PathStrand p) = Cursor 0 (Directed p 0 0 0) i (Seq.singleton i)   where i = 230 + (identity p * 2 + 1)+strands :: Rope -> FingerTree Delta Strand+strands (Rope _ r) = r -data Rope = Rope -  { _ropeId  :: {-# UNPACK #-} !Id-  , ropeTree :: !(FingerTree Cursor Strand)-  }+instance HasBytes Rope where+  bytes = bytes . measure -size :: Rope -> Int-size = cursorBytes . measure+instance HasDelta Rope where+  delta = measure -instance Measured Cursor Rope where-  measure (Rope _ t) = measure t+instance Measured Delta Rope where+  measure (Rope s _) = s +instance Reducer Rope Rope where+  unit = id++instance Reducer Strand Rope where+  unit s = rope (singleton s)+  cons s (Rope mt t) = Rope (delta s `mappend` mt) (s <| t)+  snoc (Rope mt t) !s = Rope (mt `mappend` delta s) (t |> s)++instance Reducer Hunk Rope where+  unit s = Rope (delta s) (singleton (HunkStrand s))+  cons s (Rope mt t) = Rope (delta s `mappend` mt) (HunkStrand s <| t)+  snoc (Rope mt t) s = Rope (mt `mappend` delta s) (t |> HunkStrand s)+  +instance Reducer Path Rope where+  unit s = Rope (delta s) (singleton (PathStrand s))+  cons s (Rope mt t) = Rope (delta s `mappend` mt) (PathStrand s <| t)+  snoc (Rope mt t) s = Rope (mt `mappend` delta s) (t |> PathStrand s)++instance Reducer Strict.ByteString Rope where+  unit = unit . hunk+  cons = cons . hunk +  snoc r = snoc r . hunk+ instance Show Rope where   showsPrec d (Rope _ r) = showsPrec d (toList r) -lastNewline :: Rope -> Bool -> Int-lastNewline t True  = size t-lastNewline t False = case d of-	Columns _ _       -> 0-        Tab _ _ _         -> 0-        Lines _ _ b'      -> b - b'-        Directed _ _ _ b' -> b - b'-  where Cursor b d _ _ = measure t+-- | 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 = case FingerTree.viewl r of+  HunkStrand (Hunk _ _ a) :< r' -> case bi - bl of +    0  -> ks (measure l) (Lazy.fromChunks $ a : chunks r')+    db -> ks i           (Lazy.fromChunks $ (Strict.drop db a) : chunks r')+  _ -> kf+  where +    bi = bytes i+    bl = bytes l+    (l, r) = FingerTree.split (\b -> bytes b > bi) (strands t)+    chunks s = case viewl s of +      HunkStrand (Hunk _ _ a) :< s' -> a : chunks s'+      _ -> []++{- indexByte :: Int -> Rope -> Word8-indexByte i (Rope _ t) = Strict.index a $ i - cursorBytes (measure l) where-   (l, r) = FingerTree.split (\b -> cursorBytes b > i) t-   HunkStrand (Hunk _ _ a) FingerTree.:< _ = FingerTree.viewl r+indexByte i (Rope _ t) = Strict.index a $ i - bytes l where+   (l, r) = FingerTree.split (\b -> bytes b > i) t+   HunkStrand (Hunk _ _ a) :< _ = FingerTree.viewl r+-}  instance Monoid Rope where-  mempty = intern mempty-  mappend x y = intern (unintern x `mappend` unintern y)+  mempty = Rope mempty mempty+  mappend = (<>)  instance Semigroup Rope where-  x <> y = intern (unintern x `mappend` unintern y)--instance Interned Rope where-  type Uninterned Rope = FingerTree Cursor Strand-  data Description Rope = DR {-# UNPACK #-} !Int !(Seq Id) deriving Eq-  describe t = DR h i where Cursor _ _ h i = measure t-  identify = Rope-  identity (Rope i _) = i--- modifyAdvice = bracket_ (Prelude.putStrLn "entering rope") (Prelude.putStrLn "exiting rope")-  cache = ropeCache--instance Hashable (Description Rope) where-  hash (DR i s) = hashWithSalt i (toList s) --instance Uninternable Rope where-  unintern (Rope _ r) = r--ropeCache :: Cache Rope-ropeCache = mkCache-{-# NOINLINE ropeCache #-}+  Rope mx x <> Rope my y = Rope (mx <> my) (x `mappend` y)
+ Text/Trifecta/Strand.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}+module Text.Trifecta.Strand+  ( Strand(..)+  ) where++import Data.Interned+import Data.Hashable+import Data.ByteString as Strict+import Data.FingerTree as FingerTree+import Text.Trifecta.Hunk+import Text.Trifecta.Path+import Text.Trifecta.Bytes+import Text.Trifecta.Delta+import Text.PrettyPrint.Leijen.Extras++data Strand+  = HunkStrand !Hunk+  | PathStrand !Path++instance Show Strand where+  showsPrec d (HunkStrand h) = showsPrec d h+  showsPrec d (PathStrand p) = showsPrec d p++instance Pretty Strand where+  pretty (HunkStrand h) = pretty h+  pretty (PathStrand p) = pretty p++instance Measured Delta Strand where+  measure (HunkStrand s) = delta s+  measure (PathStrand p) = delta p++instance Hashable Strand where+  hash (HunkStrand h) = hashWithSalt 0 h+  hash (PathStrand p) = hashWithSalt 0 p++instance HasDelta Strand where+  delta = measure++instance HasBytes Strand where+  bytes (HunkStrand h) = Strict.length (unintern h)+  bytes _ = 0
Text/Trifecta/Supply.hs view
@@ -1,29 +1,32 @@+{-# LANGUAGE FlexibleContexts #-} module Text.Trifecta.Supply    ( Supply(..)-  , EOF(..)+  , EOF(EOF)   , supplyEOF-  , supplyRope+  -- * type restricted versions of supply+  , supplyDefault   , supplyStrand   , supplyHunk   , supplyPath   , supplyByteString   ) where -import Text.Trifecta.Path-import Text.Trifecta.Rope-import Text.Trifecta.Hunk-import Text.Trifecta.It-import Data.Interned+import Control.Parallel.Strategies hiding (Done) import Data.Monoid-import Data.Semigroup+import Data.Semigroup.Reducer import Data.Foldable import Data.Word import Data.Semigroup.Foldable import Data.List.NonEmpty import Data.FingerTree as FingerTree-import Data.ByteString as Strict+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Lazy as Lazy import Data.ByteString.UTF8 as UTF8-import Control.Parallel.Strategies hiding (Done)+import Text.Trifecta.Path+import Text.Trifecta.Rope+import Text.Trifecta.Hunk+import Text.Trifecta.Strand+import Text.Trifecta.It  -- enumerators for our iteratee @@ -42,40 +45,42 @@ supplyEOF (Done r _ a) = Done r True a supplyEOF (Fail r _ a) = Fail r True a -supplyRope :: Rope -> It a -> It a-supplyRope new (Done old _ a) = Done (old <> new) False a-supplyRope new (Fail old _ a) = Fail (old <> new) False a-supplyRope new (Cont k) = k new False+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 = supplyRope . intern . FingerTree.singleton+supplyStrand = supplyDefault  supplyHunk :: Hunk -> It a -> It a-supplyHunk = supplyStrand . HunkStrand+supplyHunk = supplyDefault  supplyPath :: Path -> It a -> It a-supplyPath = supplyStrand . PathStrand+supplyPath = supplyDefault  supplyByteString :: ByteString -> It a -> It a -supplyByteString bs = supplyHunk (intern bs)+supplyByteString = supplyDefault +-- DO NOT WANT instance Supply Word8 where   supply = supplyByteString . Strict.singleton   supplyList = supplyByteString . Strict.pack  instance Supply Char where-  supply c | fromEnum c <= 0x7f = supplyByteString $ Strict.singleton $ toEnum $ fromEnum c-           | otherwise = error "TODO"-        -- TODO: more+  supply c = supplyByteString (UTF8.fromString [c])   supplyList = supplyByteString . UTF8.fromString  instance Supply a => Supply [a] where   supply = supplyList -instance Supply ByteString where+instance Supply Strict.ByteString where   supply = supplyByteString-  supplyList = supplyList . Prelude.map (HunkStrand . intern)+  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@@ -83,13 +88,13 @@ instance Supply Path where   supply = supplyPath   supplyList [] = id-  supplyList (x:xs) = supplyPath $ fold1 (x:|xs)+  supplyList (x:xs) = supplyPath $ fold1 (x :| xs)  instance Supply Strand where   supply = supplyStrand-  supplyList xs = supplyRope (intern (FingerTree.fromList xs')) where+  supplyList xs = supply (rope (FingerTree.fromList xs')) where      !xs' = withStrategy (evalList rseq) xs  instance Supply Rope where-  supply = supplyRope-  supplyList = supplyRope . fold+  supply = supplyDefault+  supplyList = supplyDefault . fold
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing-version:       0.2+version:       0.3 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -29,7 +29,7 @@     wl-pprint-extras >= 1.2      && < 1.3,     semigroups       >= 0.7.1    && < 0.8,      fingertree       >= 0.0.1    && < 0.1,-    reducers         >= 0.1      && < 0.2,+    reducers         >= 0.1.2    && < 0.2,     parsec           >= 3.1.1    && < 3.2,     utf8-string      >= 0.3.6    && < 0.4,     semigroupoids    >= 1.2.4    && < 1.3,@@ -40,11 +40,13 @@    exposed-modules:     Text.Trifecta+    Text.Trifecta.It     Text.Trifecta.Path-    Text.Trifecta.Delta-    Text.Trifecta.Cursor     Text.Trifecta.Rope     Text.Trifecta.Hunk-    Text.Trifecta.It+    Text.Trifecta.Bytes+    Text.Trifecta.Caret+    Text.Trifecta.Delta+    Text.Trifecta.Strand     Text.Trifecta.Supply-+    Text.Trifecta.Parser