From f4c419b9ddec15bad267a4463f0720d6e28042d2 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 30 May 2019 12:18:08 +0200 Subject: Further work --- interactive-edit-lens/src/Interact.hs | 142 +++++++++++++++++++++++----------- 1 file changed, 95 insertions(+), 47 deletions(-) (limited to 'interactive-edit-lens/src/Interact.hs') diff --git a/interactive-edit-lens/src/Interact.hs b/interactive-edit-lens/src/Interact.hs index 0074e86..662052b 100644 --- a/interactive-edit-lens/src/Interact.hs +++ b/interactive-edit-lens/src/Interact.hs @@ -14,6 +14,7 @@ import Interact.Types import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.IO as Text import Data.Text.Zipper @@ -41,6 +42,7 @@ import Brick hiding (on) import Brick.Focus import Brick.Widgets.Center import Brick.Widgets.Border +import Brick.Widgets.FileBrowser import Graphics.Vty hiding (showCursor) import Config.Dyre @@ -48,14 +50,20 @@ import Config.Dyre import System.IO.Unsafe import Debug.Trace -interactiveEditLens :: (Params (InteractConfig c) -> Params (InteractConfig c)) -> InteractConfig c -> IO () +import System.CPUTime +import Text.Printf + +import Control.Exception (evaluate) +import Control.DeepSeq + +interactiveEditLens :: forall c. NFData c => (Params (InteractConfig c) -> Params (InteractConfig c)) -> InteractConfig c -> IO () interactiveEditLens f = wrapMain . f $ defaultParams { projectName = "interact-edit-lens" , showError = \s err -> s & compileError .~ Just err , realMain = interactiveEditLens' } -interactiveEditLens' :: forall c. InteractConfig c -> IO () +interactiveEditLens' :: forall c. NFData c => InteractConfig c -> IO () interactiveEditLens' cfg@InteractConfig{..} | Just err <- icfgCompileError = hPutStrLn stderr err @@ -89,9 +97,8 @@ interactiveEditLens' cfg@InteractConfig{..} where infix 1 &?~ - (&?~) :: a -> RWS (InteractConfig c) () a b -> a + (&?~), actOn :: a -> RWS (InteractConfig c) () a b -> a st &?~ act = (\(s, ()) -> s) $ execRWS act cfg st - actOn = (&?~) initialState :: InteractState c @@ -101,6 +108,8 @@ interactiveEditLens' cfg@InteractConfig{..} , istRight = (Last Valid, Last (init @(StringEdits Natural Char), 0), mempty) , istFocus = focusRing [LeftEditor, RightEditor] & focusSetCurrent (case icfgInitial of InitialRight _ -> RightEditor; _other -> LeftEditor) + , istActive = True + , istLoadBrowser = Nothing } app :: InteractApp c @@ -109,10 +118,15 @@ interactiveEditLens' cfg@InteractConfig{..} appDraw :: InteractState c -> [Widget InteractName] appDraw InteractState{..} = [ editors ] where - editors = hBox - [ mbInvalid (withFocusRing istFocus renderEditor') (istLeft `WithName` LeftEditor) - , vBorder - , mbInvalid (withFocusRing istFocus renderEditor') (istRight `WithName` RightEditor) + editors = vBox + [ case istLoadBrowser of + Nothing -> hBox + [ mbInvalid (withFocusRing istFocus renderEditor') (istLeft `WithName` LeftEditor) + , vBorder + , mbInvalid (withFocusRing istFocus renderEditor') (istRight `WithName` RightEditor) + ] + Just lBrowser -> renderFileBrowser True lBrowser + , hCenter . str $ bool "Inactive" "" istActive ] renderEditor' :: Bool -> (Seq Char, Int) `WithName` InteractName -> Widget InteractName renderEditor' foc ((content, cPos) `WithName` n) @@ -133,42 +147,75 @@ interactiveEditLens' cfg@InteractConfig{..} mbInvalid f ((Last Valid , Last x, _) `WithName` n) = f $ x `WithName` n appHandleEvent :: InteractState c -> BrickEvent InteractName InteractEvent -> EventM InteractName (Next (InteractState c)) - appHandleEvent st@InteractState{..} (VtyEvent ev) = case ev of - EvKey KEsc [] -> halt st - EvKey (KChar 'c') [MCtrl] -> halt st - EvKey (KChar '\t') [] -> continue $ st & focus %~ focusNext - EvKey KBackTab [] -> continue $ st & focus %~ focusPrev - EvKey (KChar 'a') [MCtrl] -> continue $ st &?~ doMove - (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, 0) else (l, 0)) - EvKey (KChar 'e') [MCtrl] -> continue $ st &?~ doMove - (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') $ c l then (pred l, Seq.length . c $ pred l) else (l, Seq.length $ c l)) - EvKey KLeft [MCtrl] -> continue $ st &?~ doMove - (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0)) - EvKey KRight [MCtrl] -> continue $ st &?~ doMove - (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0)) - EvKey KUp [] -> continue $ st &?~ doMove - (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p)) - EvKey KDown [] -> continue $ st &?~ doMove - (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p)) - EvKey KLeft [] -> continue $ st &?~ doMove moveLeft - EvKey KRight [] -> continue $ st &?~ doMove moveRight - EvKey KDel [] -> continue $ st &?~ doEdit (delete 0) - EvKey KBS [] -> continue . actOn st $ do - focused' <- preuse $ focused . _2 . _Wrapped - doEdit . delete $ -1 - unless (maybe False ((==) <$> view _2 <*> view (_1 . to Seq.length)) focused') $ - doMove moveLeft - EvKey (KChar c) [] -> continue . actOn st $ do - doEdit $ insert 0 c - doMove moveRight - EvKey KEnter [] -> continue . actOn st $ do - doEdit $ insert 0 '\n' - doMove moveRight - other -> suspendAndResume $ do - traceIO $ "Unhandled event:\n\t" ++ show other - return st - -- where - -- editorMovement f = continue $ st & focused . _Just . editContentsL %~ f + appHandleEvent st@InteractState{..} (VtyEvent ev) + | Nothing <- istLoadBrowser = case ev of + EvKey KEsc [] -> halt st + EvKey (KChar 'c') [MCtrl] -> halt st + EvKey (KChar '\t') [] -> continue . actOn st . runMaybeT $ do + guard =<< use active + focus %= focusNext + EvKey KBackTab [] -> continue . actOn st . runMaybeT $ do + guard =<< use active + focus %= focusPrev + EvKey (KChar 'a') [MCtrl] -> continue $ st &?~ doMove + (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, 0) else (l, 0)) + EvKey (KChar 'e') [MCtrl] -> continue $ st &?~ doMove + (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') $ c l then (pred l, Seq.length . c $ pred l) else (l, Seq.length $ c l)) + EvKey KLeft [MCtrl] -> continue $ st &?~ doMove + (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0)) + EvKey KRight [MCtrl] -> continue $ st &?~ doMove + (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0)) + EvKey KUp [] -> continue $ st &?~ doMove + (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p)) + EvKey KDown [] -> continue $ st &?~ doMove + (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p)) + EvKey KLeft [] -> continue $ st &?~ doMove moveLeft + EvKey KRight [] -> continue $ st &?~ doMove moveRight + EvKey KDel [] -> continue $ st &?~ doEdit (delete 0) + EvKey KBS [] -> continue . actOn st $ do + focused' <- preuse $ focused . _2 . _Wrapped + doEdit . delete $ -1 + unless (maybe False ((==) <$> view _2 <*> view (_1 . to Seq.length)) focused') $ + doMove moveLeft + EvKey (KChar c) [] -> continue . actOn st $ do + doEdit $ insert 0 c + doMove moveRight + EvKey KEnter [] -> continue . actOn st $ do + doEdit $ insert 0 '\n' + doMove moveRight + EvKey (KChar 'p') [MCtrl] + | istActive -> do + void . liftIO . evaluate . force . ($ st) $ (,,) <$> view left <*> view right <*> view complement + continue $ st & active .~ False + | otherwise -> do + let st' = actOn st $ do + active .= True + doEdit mempty + before <- liftIO getCPUTime + void . liftIO . evaluate . force . ($ st') $ (,,) <$> view left <*> view right <*> view complement + after <- liftIO getCPUTime + suspendAndResume $ do + printf "Resume took %.12fs\n" (fromInteger (after - before) * 1e-12 :: Double) + return st' + EvKey (KChar 'o') [MCtrl] -> do + lBrowser <- liftIO $ newFileBrowser selectNonDirectories LoadBrowser Nothing + continue $ st & loadBrowser .~ Just lBrowser + other -> suspendAndResume $ do + traceIO $ "Unhandled event:\n\t" ++ show other + return st + -- where + -- editorMovement f = continue $ st & focused . _Just . editContentsL %~ f + | Just lBrowser <- istLoadBrowser = do + lBrowser' <- handleFileBrowserEvent ev lBrowser + case fileBrowserSelection lBrowser' of + [] -> continue $ st &?~ loadBrowser .= Just lBrowser' + (FileInfo{..} : _) -> do + insEdit <- divInit . view charseq <$> liftIO (Text.readFile fileInfoFilePath) + let st' = actOn st $ do + doEdit $ (insEdit :: StringEdits Natural Char) & stringEdits . sePos %~ fromIntegral + loadBrowser .= Nothing + continue st' + appHandleEvent st _ = continue st doMove = zoom $ focused . _2 . _Wrapped @@ -259,9 +306,10 @@ doEdit relativeEdit = void . runMaybeT $ do | otherwise = currentPos aL . _2 %= (<> Last (newContent, currentPos')) absoluteEdit' <- uses (aL . _3) (absoluteEdit `mappend`) - bEdits <- prop direction absoluteEdit' - bDom <- use $ bL . _2 . _Wrapped . _1 - case bDom `apply` bEdits of + bRes <- runMaybeT $ do + guard =<< use active + (,) <$> use (bL . _2 . _Wrapped . _1) <*> prop direction absoluteEdit' + case uncurry apply =<< bRes of Nothing -> do bL . _1 %= (<> Last Invalid) aL . _3 .= absoluteEdit' -- cgit v1.2.3