{-# 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