packages feed

trifecta 0.5 → 0.5.1

raw patch · 2 files changed

+41/−44 lines, 2 filesdep ~wl-pprint-extras

Dependency ranges changed: wl-pprint-extras

Files

Text/Trifecta/Render.hs view
@@ -38,7 +38,7 @@   delta = rDelta  rendering :: (Doc e -> Doc e) -> Delta -> ByteString -> Rendering e-rendering bold d bs = Rendering d (expand bs) 1 (IM.fromList [(0,id),(1,bold)]) IM.empty IM.empty where+rendering bold d bs = Rendering d (expand bs) 2 (IM.fromList [(0,id),(1,bold)]) IM.empty IM.empty where   expand :: ByteString -> String   expand = go 0 . UTF8.toString where     go n ('\t':xs) = let t = 8 - mod n 8 in P.replicate t ' ' ++ go (n + t) xs@@ -53,61 +53,58 @@    put s { rFresh = eff + 1, rEffects = IM.insert eff f (rEffects s) }    return eff -drawCaret :: EffectId -> Caret -> State (Rendering e) ()-drawCaret eff (Caret p _)  = modify img where-  img r | near p r  = addSymbol (column p) eff "^" r-        | otherwise = r+drawCaret :: EffectId -> Caret -> Rendering e -> Rendering e+drawCaret eff (Caret p _) r +  | near p r  = addSymbol (column p) eff "^" r+  | otherwise = r -drawCover :: EffectId -> Cover -> State (Rendering e) ()-drawCover eff (Cover (Caret s _) e) = modify img where-  img r | nl && nh  = addSymbol (column l) eff (P.replicate (column h - column l + 1) '~') r-        | nl        = addSymbol (column l) eff (P.replicate (cols     - column l) '~' ++ ">") r-        | nh        = addSymbol 0 eff ('<' : P.replicate (column l) '~') r-        | otherwise = r-    where -      l = argmin bytes s e -      h = argmax bytes s e-      nl = near l r-      nh = near h r-      cols = P.length (rLine r)+drawCover :: EffectId -> Cover -> Rendering e -> Rendering e+drawCover eff (Cover (Caret s _) e) r+  | nl && nh  = addSymbol (column l) eff (P.replicate (column h - column l + 1) '~') r+  | nl        = addSymbol (column l) eff (P.replicate (cols     - column l) '~' ++ ">") r+  | nh        = addSymbol 0 eff ('<' : P.replicate (column l) '~') r+  | otherwise = r+  where +    l = argmin bytes s e +    h = argmax bytes s e+    nl = near l r+    nh = near h r+    cols = P.length (rLine r)  addSymbol, addFixit :: Int -> EffectId -> String -> Rendering e -> Rendering e addSymbol n eff xs0 r = r { rSymbols = interval n eff xs0 (rSymbols r) } addFixit n eff xs0 r = r { rSymbols = interval n eff xs0 (rSymbols r) }  render :: Rendering e -> Doc e-render r = columns go where-  go cols = dots $ align $ vsep img-    where (dots, lh@(lo, hi)) = window (cols - 10) r+render r = nesting $ \k -> columns $ \n -> go (n - k) where+  go cols = (dots $ align $ vsep img) <> linebreak+    where (dots, rdots, lo, hi) = window (cols - 7) r           -- line1, line2, line3 :: Doc e-          line1 = string $ P.take (hi - lo) $ P.drop lo (rLine r)-          line2 = cluster (rEffects r) $ scan (rSymbols r)-          line3 = cluster (rEffects r) $ scan (rFixits r)-          hasFixits = P.any (inRange lh) $ IM.keys (rFixits r)+          line1 = rdots $ string $ P.take (hi - lo + 1) $ P.drop lo $ rLine r+          line2 = cluster rSymbols+          line3 = cluster rFixits+          hasFixits = P.any (inRange (lo, hi)) $ IM.keys (rFixits r)           img | hasFixits = [line1, line2, line3]                | otherwise = [line1, line2]--          scan :: IntMap (EffectId, Char) -> [(EffectId, Char)]-          scan m =   findWithDefault (0,'<') lo m :-                   [ findWithDefault (0,' ') i m | i <- [lo + 1 .. hi - 1]] ++-                   [ findWithDefault (0,'>') hi m ]--          -- cluster :: IntMap (Doc e -> Doc e) -> [(EffectId, Char)] -> Doc e-          cluster m xs = hcat [ findWithDefault id (fst (P.head g)) m $ string (P.map snd g) -                              | g <- groupBy ((==) `on` fst) xs -                              ]+          cluster m = hcat +                    . P.map (\g -> findWithDefault id (fst (P.head g)) (rEffects r) $ string (P.map snd g))+                    . groupBy ((==) `on` fst)+                    $ P.map (\i -> findWithDefault (0,' ') i (m r)) [lo .. hi] -window :: Int -> Rendering e -> (Doc e -> Doc e, (Int, Int))+window :: Int -> Rendering e -> (Doc e -> Doc e, Doc e -> Doc e, Int, Int) window w r -  | fcs <= w2 = (id ,                       (0,  hi))-  | otherwise = ((bold (text ("...")) <+>), (mn, hi))+  | clamp_lo  && clamp_hi = (id,        id,        0,    w     )+  | clamp_lo              = (id,        (<> dots), 0,    w     )+  |              clamp_hi = ((dots <>), id       , l-w,  l     )+  | otherwise             = ((dots <>), (<> dots), c-w2, c + w2)   where -    fcs = column r-    mn = fcs - w2-    mx = fcs + w2-    hi = min mx w-    w2 = div w 2     bold = rEffects r IM.! 1+    dots = bold $ text "..."+    l = P.length $ rLine r+    w2 = div w 2+    c = column r+    clamp_lo = c <= w2+    clamp_hi = c + w2 > l  interval :: Int -> EffectId -> String -> IntMap (EffectId, Char) -> IntMap (EffectId, Char) interval _ _   []     = id
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing-version:       0.5+version:       0.5.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -33,7 +33,7 @@     semigroupoids    >= 1.2.4    && < 1.3,     parallel         >= 3.1.0.1  && < 3.2,     transformers     >= 0.2.2    && < 0.3,-    wl-pprint-extras >= 1.2.1    && < 1.3+    wl-pprint-extras >= 1.2.2    && < 1.3    ghc-options: -Wall