rewrite-inspector 0.1.0.8 → 0.1.0.9

raw patch · 3 files changed

+50/−39 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• rewrite-inspector.cabal +3/−3
• src/BrickUI.hs +36/−24
• src/Pretty.hs +11/−12

@@ -1,5 +1,5 @@ name: rewrite-inspector-version: 0.1.0.8+version: 0.1.0.9 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -42,8 +42,8 @@                       microlens-th,                       data-default  >= 0.7.1.1 --    default-language: Haskell2010+    ghc-options:        -Wall+    default-language:   Haskell2010     default-extensions: ScopedTypeVariables                         ViewPatterns                         LambdaCase

@@ -5,22 +5,30 @@    Basic functionality for the terminal user-inteface (TUI). -}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans       #-}+ module BrickUI where -import System.Environment  (getArgs)-import Control.Applicative ((<|>))-import Control.Monad       (void, (>>))+import Prelude hiding (fail)++import System.Environment     (getArgs)+import Control.Applicative    ((<|>))+import Control.Monad          (void, (>>))+import Control.Monad.Fail     (MonadFail (..))+import Control.Monad.IO.Class (liftIO)++import Data.Either         (fromRight) import Data.List           (sortOn)-import Data.Maybe          (isJust, listToMaybe, catMaybes)+import Data.Maybe          (listToMaybe, catMaybes) import Lens.Micro  import Brick   ( App (..), BrickEvent (..), EventM, Next, Widget (..)   , CursorLocation (..), cursorLocationName, cursorsL   , VisibilityRequest (..), visibilityRequestsL-  , hSize, vSize, imageL+  , hSize, vSize   , continue, halt   , str, vBox, hBox   )@@ -38,19 +46,19 @@ -- | Entry point for the TUI. runTerminal :: forall term. Diff term => FilePath -> IO () runTerminal ftheme = do-  res <- loadCustomizations ftheme (defaultTheme $ userStyles @term)-  case res of-    Left err ->-      error $ "[theme.ini] Configuration file is malformed: " ++ err-    Right theme -> do-      [fname] <- getArgs-      hist    <- readHistory @term fname+  let dtheme = defaultTheme (userStyles @term)+  theme <- fromRight dtheme <$> loadCustomizations ftheme dtheme+  args <- getArgs+  case args of+    [fname] -> do+      hist <- readHistory @term fname       void $ B.customMain         -- Vty configuration         (V.mkVty $ V.defaultConfig { V.vtime = Just 100, V.vmin  = Just 1 })         Nothing                             -- event channel         (app @term (themeToAttrMap theme))  -- the Brick application         (createVizStates @term hist)        -- initial state+    _ -> error "Usage: clash-term <history_file>"  -- | The 'Brick.App' configuration. app :: Diff term => B.AttrMap -> App (VizStates term) NoCustomEvent Name@@ -111,11 +119,11 @@     diff       | v@(VizState (st:_) _ curE _ curO _ _) <- getCurrentState vs       = let-          showE vn = showCode (vs^.scroll)-                              (min 80 $ getCodeWidth vs)-                              (vs^.formData^.opts)-                              (st^.ctx)-                              (getSearchString vs)+          showE = showCode (vs^.scroll)+                           (min 80 $ getCodeWidth vs)+                           (vs^.formData^.opts)+                           (st^.ctx)+                           (getSearchString vs)           nextE = step v ^. curExpr           (visL, visR) | v^.curOccur < v^.leftN                        = (visibleCursors curO, invisibleCursors)@@ -125,10 +133,10 @@           hBoxSpaced 2             [ B.viewport LeftViewport B.Both $                 visL $-                  withBorder "Before" $ showE LeftViewport curE+                  withBorder "Before" $ showE curE             , B.viewport RightViewport B.Both $                 visR $-                  withBorder "After" $ showE RightViewport nextE+                  withBorder "After" $ showE nextE             ]        | otherwise@@ -145,7 +153,7 @@     searchMatches = C.vCenter $ str (n ++ " out of " ++ tot ++ " matches")       where         (n, tot)-          | v@(VizState (_:_) _ curE _ _ _ _) <- getCurrentState vs+          | v@(VizState (_:_) _ _ _ _ _ _) <- getCurrentState vs           , let lr = v^.leftN + v^.rightN           , lr > 0           = (show (v^.curOccur + 1), show lr)@@ -180,12 +188,16 @@  -- * Event handling. +-- | Allow pattern matches in EventM monadic do blocks.+instance MonadFail (EventM Name) where+  fail = liftIO . fail+ -- | Lookup terminal size and store in the current state. lookupSize :: EventM Name (VizStates term -> VizStates term) lookupSize = do   out    <- V.outputIface <$> B.getVtyHandle-  bounds <- V.displayBounds out-  return $ (width .~ fst bounds) . (height .~ snd bounds)+  (w, h) <- V.displayBounds out+  return $ (width .~ w) . (height .~ h)  -- | Update number of occurrences of searched string in both viewports. updateOcc :: Diff term => VizStates term -> VizStates term@@ -346,7 +358,7 @@ visibleCursors n p = Widget (hSize p) (vSize p) $ do   res <- B.render p   let crs  = map fst-           $ sortOn ((\case (SearchResult i) -> i) . snd)+           $ sortOn ((\case {SearchResult i -> i; _ -> 0}) . snd)            $ catMaybes            $ map (\c ->  case cursorLocationName c of               Just s@(SearchResult _) -> Just (c, s)

@@ -12,8 +12,7 @@  module Pretty where -import Control.Arrow (first, second)-+import Control.Arrow             (first) import Data.List                 (nub, isPrefixOf, findIndices, sortOn) import Data.Text                 (unpack) import Data.Text.Prettyprint.Doc ( layoutPretty, layoutCompact@@ -42,11 +41,11 @@   -> String        -- ^ the string to search for   -> term          -- ^ code to search in   -> Int           -- ^ total number of occurrences-countOcc opts searchString+countOcc pOpts searchString   = foldl (\cur d -> cur + countDoc d) 0   . myForm @term []   . layoutCompact-  . ppr' @term opts+  . ppr' @term pOpts   where     countDoc :: MyDoc -> Int     countDoc = \case@@ -56,7 +55,7 @@  -- | Render the given expression as a 'Brick.Widget'. showCode-  :: forall n term+  :: forall term    . Diff term   => Bool          -- ^ whether to scroll to focused region   -> Int           -- ^ maximum line width@@ -65,12 +64,12 @@   -> String        -- ^ the string to search for   -> term          -- ^ code to display   -> Widget Name   -- ^ the Brick widget to display-showCode scroll w opts ctx0 searchString+showCode toScroll w pOpts ctx0 searchString   = vBox-  . fmap (render scroll searchString 0) . split . (MLine 0 :)+  . fmap (render toScroll searchString 0) . split . (MLine 0 :)   . myForm @term ctx0   . layoutPretty (LayoutOptions (AvailablePerLine w 0.8))-  . ppr' @term opts+  . ppr' @term pOpts  -- | A simpler document type, specific to our use-case. data MyDoc = MString String@@ -113,7 +112,7 @@  -- | Render a single line in Brick (highlighting when marked). render :: Bool -> String -> Int -> (Int, [MyDoc]) -> Widget Name-render scroll searchString n0 (i, xs) = B.padLeft (B.Pad i)+render toScroll searchString n0 (i, xs) = B.padLeft (B.Pad i)                                    $ hBox                                    $ render1 n0 xs   where@@ -124,7 +123,7 @@      f :: Int -> MyDoc -> (Widget Name, Int)     f n = \case-      MMod attrs w -> first (modify scroll (nub attrs)) (f n w)+      MMod attrs w -> first (modify toScroll (nub attrs)) (f n w)       MString s    -> highlightSearch n s searchString       _            -> error "render1" @@ -152,9 +151,9 @@  -- | Add a list of stylistic modifications to a 'Widget'. modify :: Bool -> [String] -> Widget n -> Widget n-modify scroll = foldr (.) id . fmap mod1 . sortOn (\case "Type" -> 1; _ -> 0)+modify toScroll = foldr (.) id . fmap mod1 . sortOn (\case "Type" -> 1; _ -> 0)   where-    mod1 "focus" = (if scroll then B.visible else id) . B.withDefAttr "focus"+    mod1 "focus" = (if toScroll then B.visible else id) . B.withDefAttr "focus"     mod1 attr    = B.withDefAttr (B.attrName attr)  -- | Highlight searched occurrences inside the given 'Widget'.