{-# 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} = [Maybe String -> Widget Name forall n. Maybe String -> Widget n drawException Maybe String exc, Widget Name -> Widget Name forall n. Widget n -> Widget n center (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Widget Name ui Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n <=> Widget Name forall n. Widget n help] where ui :: Widget Name ui = Widget Name -> Widget Name forall n. Widget n -> Widget n hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Int -> Widget Name -> Widget Name forall n. Int -> Widget n -> Widget n vLimit Int 15 (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Int -> Widget Name -> Widget Name forall n. Int -> Widget n -> Widget n hLimit Int 50 (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n borderWithLabel (Text -> Widget Name forall n. Text -> Widget n txt Text "Choose a file") (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Bool -> FileBrowser Name -> Widget Name forall n. (Show n, Ord n) => Bool -> FileBrowser n -> Widget n renderFileBrowser Bool True FileBrowser Name b help :: Widget n help = Padding -> Widget n -> Widget n forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ [Widget n] -> Widget n forall n. [Widget n] -> Widget n vBox [ Widget n -> Widget n forall n. Widget n -> Widget n hCenter (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt Text "Up/Down: select, h: toggle show hidden files" , Widget n -> Widget n forall n. Widget n -> Widget n hCenter (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt Text "/: search, Ctrl-C or Esc: cancel search" , Widget n -> Widget n forall n. Widget n -> Widget n hCenter (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt Text "Enter: change directory or select file" , Widget n -> Widget n forall n. Widget n -> Widget n hCenter (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt Text "Esc or q: quit" ] handleEvent :: GlobalState -> FBS -> BrickEvent Name Event -> EventM Name (Next GlobalState) handleEvent :: GlobalState -> FBS -> BrickEvent Name Event -> EventM Name (Next GlobalState) handleEvent GlobalState gs s :: FBS s@FBS{_fb :: FBS -> FileBrowser Name _fb=FileBrowser Name b, _exception' :: FBS -> Maybe String _exception'=Maybe String excep} (VtyEvent Event ev) = let update :: FBS -> GlobalState update = GlobalState -> FBS -> GlobalState updateFBS GlobalState gs continue' :: FBS -> EventM n (Next GlobalState) continue' = GlobalState -> EventM n (Next GlobalState) forall s n. s -> EventM n (Next s) continue (GlobalState -> EventM n (Next GlobalState)) -> (FBS -> GlobalState) -> FBS -> EventM n (Next GlobalState) forall b c a. (b -> c) -> (a -> b) -> a -> c . FBS -> GlobalState update halt' :: GlobalState -> EventM n (Next GlobalState) halt' = GlobalState -> EventM n (Next GlobalState) forall s n. s -> EventM n (Next s) continue (GlobalState -> EventM n (Next GlobalState)) -> (GlobalState -> GlobalState) -> GlobalState -> EventM n (Next GlobalState) forall b c a. (b -> c) -> (a -> b) -> a -> c . GlobalState -> GlobalState popState in case (Maybe String excep, Event ev) of (Just String _, Event _) -> FBS -> EventM Name (Next GlobalState) forall n. FBS -> EventM n (Next GlobalState) continue' (FBS -> EventM Name (Next GlobalState)) -> FBS -> EventM Name (Next GlobalState) forall a b. (a -> b) -> a -> b $ FBS s FBS -> (FBS -> FBS) -> FBS forall a b. a -> (a -> b) -> b & (Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS Lens' FBS (Maybe String) exception' ((Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS) -> Maybe String -> FBS -> FBS forall s t a b. ASetter s t a b -> b -> s -> t .~ Maybe String forall a. Maybe a Nothing (Maybe String _, Event e) -> case Event e of V.EvKey Key V.KEsc [] | Bool -> Bool not (FileBrowser Name -> Bool forall n. FileBrowser n -> Bool fileBrowserIsSearching FileBrowser Name b) -> GlobalState -> EventM Name (Next GlobalState) forall n. GlobalState -> EventM n (Next GlobalState) halt' GlobalState gs V.EvKey (V.KChar Char 'q') [] | Bool -> Bool not (FileBrowser Name -> Bool forall n. FileBrowser n -> Bool fileBrowserIsSearching FileBrowser Name b) -> GlobalState -> EventM Name (Next GlobalState) forall n. GlobalState -> EventM n (Next GlobalState) halt' GlobalState gs V.EvKey (V.KChar Char 'h') [] | Bool -> Bool not (FileBrowser Name -> Bool forall n. FileBrowser n -> Bool fileBrowserIsSearching FileBrowser Name b) -> let s' :: FBS s' = FBS s FBS -> (FBS -> FBS) -> FBS forall a b. a -> (a -> b) -> b & (Bool -> Identity Bool) -> FBS -> Identity FBS Lens' FBS Bool showHidden ((Bool -> Identity Bool) -> FBS -> Identity FBS) -> (Bool -> Bool) -> FBS -> FBS forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ Bool -> Bool not in FBS -> EventM Name (Next GlobalState) forall n. FBS -> EventM n (Next GlobalState) continue' (FBS -> EventM Name (Next GlobalState)) -> FBS -> EventM Name (Next GlobalState) forall a b. (a -> b) -> a -> b $ FBS s' FBS -> (FBS -> FBS) -> FBS forall a b. a -> (a -> b) -> b & (FileBrowser Name -> Identity (FileBrowser Name)) -> FBS -> Identity FBS Lens' FBS (FileBrowser Name) fb ((FileBrowser Name -> Identity (FileBrowser Name)) -> FBS -> Identity FBS) -> FileBrowser Name -> FBS -> FBS forall s t a b. ASetter s t a b -> b -> s -> t .~ Maybe (FileInfo -> Bool) -> FileBrowser Name -> FileBrowser Name forall n. Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n setFileBrowserEntryFilter ((FileInfo -> Bool) -> Maybe (FileInfo -> Bool) forall a. a -> Maybe a Just (Bool -> FileInfo -> Bool entryFilter (FBS s' FBS -> Getting Bool FBS Bool -> Bool forall s a. s -> Getting a s a -> a ^. Getting Bool FBS Bool Lens' FBS Bool showHidden))) FileBrowser Name b Event _ -> do FileBrowser Name b' <- Event -> FileBrowser Name -> EventM Name (FileBrowser Name) forall n. Ord n => Event -> FileBrowser n -> EventM n (FileBrowser n) handleFileBrowserEvent Event ev FileBrowser Name b let s' :: FBS s' = FBS s FBS -> (FBS -> FBS) -> FBS forall a b. a -> (a -> b) -> b & (FileBrowser Name -> Identity (FileBrowser Name)) -> FBS -> Identity FBS Lens' FBS (FileBrowser Name) fb ((FileBrowser Name -> Identity (FileBrowser Name)) -> FBS -> Identity FBS) -> FileBrowser Name -> FBS -> FBS forall s t a b. ASetter s t a b -> b -> s -> t .~ FileBrowser Name b' case Event ev of V.EvKey Key V.KEnter [] -> case FileBrowser Name -> [FileInfo] forall n. FileBrowser n -> [FileInfo] fileBrowserSelection FileBrowser Name b' of [] -> FBS -> EventM Name (Next GlobalState) forall n. FBS -> EventM n (Next GlobalState) continue' FBS s' [FileInfo fileInfo] -> do let fp :: String fp = FileInfo -> String fileInfoFilePath FileInfo fileInfo Either IOError String fileOrExc <- IO (Either IOError String) -> EventM Name (Either IOError String) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO String -> IO (Either IOError String) 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 -> FBS -> EventM Name (Next GlobalState) forall n. FBS -> EventM n (Next GlobalState) continue' (FBS s' FBS -> (FBS -> FBS) -> FBS forall a b. a -> (a -> b) -> b & (Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS Lens' FBS (Maybe String) exception' ((Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS) -> String -> FBS -> FBS forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ IOError -> String forall e. Exception e => e -> String displayException IOError exc) Right String file -> case String -> Either String [Card] parseCards String file of Left String parseError -> FBS -> EventM Name (Next GlobalState) forall n. FBS -> EventM n (Next GlobalState) continue' (FBS s FBS -> (FBS -> FBS) -> FBS forall a b. a -> (a -> b) -> b & (Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS Lens' FBS (Maybe String) exception' ((Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS) -> String -> FBS -> FBS forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ String parseError) Right [Card] result -> GlobalState -> EventM Name (Next GlobalState) forall s n. s -> EventM n (Next s) continue (GlobalState -> EventM Name (Next GlobalState)) -> EventM Name GlobalState -> EventM Name (Next GlobalState) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO GlobalState -> EventM Name GlobalState forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (do String -> IO Event addRecent String fp GlobalState gs' <- GlobalState -> IO GlobalState refreshRecents' GlobalState gs GlobalState -> IO GlobalState forall (m :: * -> *) a. Monad m => a -> m a return (GlobalState gs' GlobalState -> State -> GlobalState `goToState` Parameters -> String -> [Card] -> State parameterState (GlobalState gs'GlobalState -> Getting Parameters GlobalState Parameters -> Parameters forall s a. s -> Getting a s a -> a ^.Getting Parameters GlobalState Parameters Lens' GlobalState Parameters parameters) String fp [Card] result)) [FileInfo] _ -> GlobalState -> EventM Name (Next GlobalState) forall n. GlobalState -> EventM n (Next GlobalState) halt' GlobalState gs Event _ -> FBS -> EventM Name (Next GlobalState) forall n. FBS -> EventM n (Next GlobalState) continue' FBS s' handleEvent GlobalState gs FBS _ BrickEvent Name Event _ = GlobalState -> EventM Name (Next GlobalState) forall s n. s -> EventM n (Next s) continue GlobalState gs