{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE OverloadedStrings, FlexibleInstances #-} module UI.FileBrowser (State, drawUI, handleEvent, theMap) where import Brick import Brick.Widgets.Border import Brick.Widgets.Center import Brick.Widgets.List import Brick.Widgets.FileBrowser import Control.Exception (displayException, try) import Control.Monad.IO.Class import Lens.Micro.Platform import Parser import States import StateManagement import Recents import Runners import UI.BrickHelpers import qualified UI.Attributes as A import qualified Graphics.Vty as V theMap :: AttrMap theMap :: AttrMap theMap = [(AttrName, Attr)] -> AttrMap -> AttrMap applyAttrMappings [ (AttrName listSelectedFocusedAttr, Color V.black Color -> Color -> Attr `on` Color V.yellow) , (AttrName fileBrowserCurrentDirectoryAttr, Color V.white Color -> Color -> Attr `on` Color V.blue) , (AttrName fileBrowserSelectionInfoAttr, Color V.white Color -> Color -> Attr `on` Color V.blue) , (AttrName fileBrowserDirectoryAttr, Color -> Attr fg Color V.blue) , (AttrName fileBrowserBlockDeviceAttr, Color -> Attr fg Color V.magenta) , (AttrName fileBrowserCharacterDeviceAttr, Color -> Attr fg Color V.green) , (AttrName fileBrowserNamedPipeAttr, Color -> Attr fg Color V.yellow) , (AttrName fileBrowserSymbolicLinkAttr, Color -> Attr fg Color V.cyan) , (AttrName fileBrowserUnixSocketAttr, Color -> Attr fg Color V.red) , (AttrName fileBrowserSelectedAttr, Color V.white Color -> Color -> Attr `on` Color V.magenta) ] AttrMap A.theMap drawUI :: FBS -> [Widget Name] drawUI :: FBS -> [Widget Name] drawUI FBS{_fb :: FBS -> FileBrowser Name _fb=FileBrowser Name b, _exception' :: FBS -> Maybe String _exception'=Maybe String exc} = [forall n. Maybe String -> Widget n drawException Maybe String exc, forall n. Widget n -> Widget n center forall a b. (a -> b) -> a -> b $ Widget Name ui forall n. Widget n -> Widget n -> Widget n <=> forall {n}. Widget n help] where ui :: Widget Name ui = forall n. Widget n -> Widget n hCenter forall a b. (a -> b) -> a -> b $ forall n. Int -> Widget n -> Widget n vLimit Int 15 forall a b. (a -> b) -> a -> b $ forall n. Int -> Widget n -> Widget n hLimit Int 50 forall a b. (a -> b) -> a -> b $ forall n. Widget n -> Widget n -> Widget n borderWithLabel (forall n. Text -> Widget n txt Text "Choose a file") forall a b. (a -> b) -> a -> b $ forall n. (Show n, Ord n) => Bool -> FileBrowser n -> Widget n renderFileBrowser Bool True FileBrowser Name b help :: Widget n help = forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) forall a b. (a -> b) -> a -> b $ forall n. [Widget n] -> Widget n vBox [ forall n. Widget n -> Widget n hCenter forall a b. (a -> b) -> a -> b $ forall n. Text -> Widget n txt Text "Up/Down: select, h: toggle show hidden files" , forall n. Widget n -> Widget n hCenter forall a b. (a -> b) -> a -> b $ forall n. Text -> Widget n txt Text "/: search, Ctrl-C or Esc: cancel search" , forall n. Widget n -> Widget n hCenter forall a b. (a -> b) -> a -> b $ forall n. Text -> Widget n txt Text "Enter: change directory or select file" , forall n. Widget n -> Widget n hCenter forall a b. (a -> b) -> a -> b $ forall n. Text -> Widget n txt Text "Esc or q: quit" ] handleEvent :: BrickEvent Name Event -> EventM Name GlobalState () handleEvent :: BrickEvent Name () -> EventM Name GlobalState () handleEvent (VtyEvent Event ev) = do Maybe String excep <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use forall a b. (a -> b) -> a -> b $ Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (Maybe String) exception' FileBrowser Name b <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use forall a b. (a -> b) -> a -> b $ Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (FileBrowser Name) fb case (Maybe String excep, Event ev) of (Just String _, Event _) -> Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (Maybe String) exception' forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> b -> m () .= forall a. Maybe a Nothing (Maybe String _, Event e) -> case Event e of V.EvKey Key V.KEsc [] | Bool -> Bool not (forall n. FileBrowser n -> Bool fileBrowserIsSearching FileBrowser Name b) -> forall (m :: * -> *). MonadState GlobalState m => m () popState V.EvKey (V.KChar Char 'q') [] | Bool -> Bool not (forall n. FileBrowser n -> Bool fileBrowserIsSearching FileBrowser Name b) -> forall (m :: * -> *). MonadState GlobalState m => m () popState V.EvKey (V.KChar Char 'h') [] | Bool -> Bool not (forall n. FileBrowser n -> Bool fileBrowserIsSearching FileBrowser Name b) -> do Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS Bool showHidden forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> (a -> b) -> m () %= Bool -> Bool not Maybe (FileInfo -> Bool) eFilter <- forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> FileInfo -> Bool entryFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS Bool showHidden) Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (FileBrowser Name) fb forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> b -> m () .= forall n. Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n setFileBrowserEntryFilter Maybe (FileInfo -> Bool) eFilter FileBrowser Name b Event _ -> do forall (m :: * -> *) (n :: * -> *) s t c. Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c zoom (Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (FileBrowser Name) fb) forall a b. (a -> b) -> a -> b $ forall n. Ord n => Event -> EventM n (FileBrowser n) () handleFileBrowserEvent Event ev FileBrowser Name b' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use forall a b. (a -> b) -> a -> b $ Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (FileBrowser Name) fb case (Event ev, forall n. FileBrowser n -> [FileInfo] fileBrowserSelection FileBrowser Name b') of (V.EvKey Key V.KEnter [], []) -> forall (m :: * -> *) a. Monad m => a -> m a return () (V.EvKey Key V.KEnter [], [FileInfo fileInfo]) -> do let fp :: String fp = FileInfo -> String fileInfoFilePath FileInfo fileInfo Either IOError String fileOrExc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall e a. Exception e => IO a -> IO (Either e a) try (String -> IO String readFile String fp) :: IO (Either IOError String)) case Either IOError String fileOrExc of Left IOError exc -> Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (Maybe String) exception' forall s (m :: * -> *) a b. MonadState s m => ASetter s s a (Maybe b) -> b -> m () ?= forall e. Exception e => e -> String displayException IOError exc Right String file -> case String -> Either String [Card] parseCards String file of Left String parseError -> Lens' GlobalState FBS fbsforall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' FBS (Maybe String) exception' forall s (m :: * -> *) a b. MonadState s m => ASetter s s a (Maybe b) -> b -> m () ?= String parseError Right [Card] result -> do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ String -> IO () addRecent String fp forall (m :: * -> *) (n :: * -> *) s t c. Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c zoom Lens' GlobalState CSS css forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m () refreshRecents Parameters params <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use Lens' GlobalState Parameters parameters forall (m :: * -> *). MonadState GlobalState m => State -> m () goToState forall a b. (a -> b) -> a -> b $ Parameters -> String -> [Card] -> State parameterState Parameters params String fp [Card] result (V.EvKey Key V.KEnter [], [FileInfo] _) -> forall (m :: * -> *). MonadState GlobalState m => m () popState (Event, [FileInfo]) _ -> forall (m :: * -> *) a. Monad m => a -> m a return () handleEvent BrickEvent Name () _ = forall (m :: * -> *) a. Monad m => a -> m a return ()