{-# 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 :: BrickEvent Name Event -> EventM Name GlobalState ()
handleEvent :: BrickEvent Name () -> EventM Name GlobalState ()
handleEvent (VtyEvent Event
ev) = do
    Maybe String
excep <- Getting (Maybe String) GlobalState (Maybe String)
-> EventM Name GlobalState (Maybe String)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe String) GlobalState (Maybe String)
 -> EventM Name GlobalState (Maybe String))
-> Getting (Maybe String) GlobalState (Maybe String)
-> EventM Name GlobalState (Maybe String)
forall a b. (a -> b) -> a -> b
$ (FBS -> Const (Maybe String) FBS)
-> GlobalState -> Const (Maybe String) GlobalState
Lens' GlobalState FBS
fbs((FBS -> Const (Maybe String) FBS)
 -> GlobalState -> Const (Maybe String) GlobalState)
-> ((Maybe String -> Const (Maybe String) (Maybe String))
    -> FBS -> Const (Maybe String) FBS)
-> Getting (Maybe String) GlobalState (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe String -> Const (Maybe String) (Maybe String))
-> FBS -> Const (Maybe String) FBS
Lens' FBS (Maybe String)
exception'
    FileBrowser Name
b <- Getting (FileBrowser Name) GlobalState (FileBrowser Name)
-> EventM Name GlobalState (FileBrowser Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FileBrowser Name) GlobalState (FileBrowser Name)
 -> EventM Name GlobalState (FileBrowser Name))
-> Getting (FileBrowser Name) GlobalState (FileBrowser Name)
-> EventM Name GlobalState (FileBrowser Name)
forall a b. (a -> b) -> a -> b
$ (FBS -> Const (FileBrowser Name) FBS)
-> GlobalState -> Const (FileBrowser Name) GlobalState
Lens' GlobalState FBS
fbs((FBS -> Const (FileBrowser Name) FBS)
 -> GlobalState -> Const (FileBrowser Name) GlobalState)
-> ((FileBrowser Name
     -> Const (FileBrowser Name) (FileBrowser Name))
    -> FBS -> Const (FileBrowser Name) FBS)
-> Getting (FileBrowser Name) GlobalState (FileBrowser Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FileBrowser Name -> Const (FileBrowser Name) (FileBrowser Name))
-> FBS -> Const (FileBrowser Name) FBS
Lens' FBS (FileBrowser Name)
fb
    case (Maybe String
excep, Event
ev) of
      (Just String
_, Event
_) -> (FBS -> Identity FBS) -> GlobalState -> Identity GlobalState
Lens' GlobalState FBS
fbs((FBS -> Identity FBS) -> GlobalState -> Identity GlobalState)
-> ((Maybe String -> Identity (Maybe String))
    -> FBS -> Identity FBS)
-> (Maybe String -> Identity (Maybe String))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS
Lens' FBS (Maybe String)
exception' ((Maybe String -> Identity (Maybe String))
 -> GlobalState -> Identity GlobalState)
-> Maybe String -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 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) -> EventM Name GlobalState ()
forall (m :: * -> *). MonadState GlobalState m => m ()
popState
        V.EvKey (V.KChar Char
'q') [] | Bool -> Bool
not (FileBrowser Name -> Bool
forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser Name
b) -> EventM Name GlobalState ()
forall (m :: * -> *). MonadState GlobalState m => m ()
popState
        V.EvKey (V.KChar Char
'h') [] | Bool -> Bool
not (FileBrowser Name -> Bool
forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser Name
b) -> do
            (FBS -> Identity FBS) -> GlobalState -> Identity GlobalState
Lens' GlobalState FBS
fbs((FBS -> Identity FBS) -> GlobalState -> Identity GlobalState)
-> ((Bool -> Identity Bool) -> FBS -> Identity FBS)
-> (Bool -> Identity Bool)
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> FBS -> Identity FBS
Lens' FBS Bool
showHidden ((Bool -> Identity Bool) -> GlobalState -> Identity GlobalState)
-> (Bool -> Bool) -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
            Maybe (FileInfo -> Bool)
eFilter <- (FileInfo -> Bool) -> Maybe (FileInfo -> Bool)
forall a. a -> Maybe a
Just ((FileInfo -> Bool) -> Maybe (FileInfo -> Bool))
-> (Bool -> FileInfo -> Bool) -> Bool -> Maybe (FileInfo -> Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FileInfo -> Bool
entryFilter (Bool -> Maybe (FileInfo -> Bool))
-> EventM Name GlobalState Bool
-> EventM Name GlobalState (Maybe (FileInfo -> Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Bool GlobalState Bool -> EventM Name GlobalState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FBS -> Const Bool FBS) -> GlobalState -> Const Bool GlobalState
Lens' GlobalState FBS
fbs((FBS -> Const Bool FBS) -> GlobalState -> Const Bool GlobalState)
-> ((Bool -> Const Bool Bool) -> FBS -> Const Bool FBS)
-> Getting Bool GlobalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> FBS -> Const Bool FBS
Lens' FBS Bool
showHidden)
            (FBS -> Identity FBS) -> GlobalState -> Identity GlobalState
Lens' GlobalState FBS
fbs((FBS -> Identity FBS) -> GlobalState -> Identity GlobalState)
-> ((FileBrowser Name -> Identity (FileBrowser Name))
    -> FBS -> Identity FBS)
-> (FileBrowser Name -> Identity (FileBrowser Name))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FileBrowser Name -> Identity (FileBrowser Name))
-> FBS -> Identity FBS
Lens' FBS (FileBrowser Name)
fb ((FileBrowser Name -> Identity (FileBrowser Name))
 -> GlobalState -> Identity GlobalState)
-> FileBrowser Name -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (FileInfo -> Bool) -> FileBrowser Name -> FileBrowser Name
forall n.
Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter Maybe (FileInfo -> Bool)
eFilter FileBrowser Name
b
        Event
_ -> do
            LensLike'
  (Zoomed (EventM Name (FileBrowser Name)) ())
  GlobalState
  (FileBrowser Name)
-> EventM Name (FileBrowser Name) () -> EventM Name GlobalState ()
forall c.
LensLike'
  (Zoomed (EventM Name (FileBrowser Name)) c)
  GlobalState
  (FileBrowser Name)
-> EventM Name (FileBrowser Name) c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((FBS -> Focusing (StateT (EventState Name) IO) () FBS)
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
Lens' GlobalState FBS
fbs((FBS -> Focusing (StateT (EventState Name) IO) () FBS)
 -> GlobalState
 -> Focusing (StateT (EventState Name) IO) () GlobalState)
-> ((FileBrowser Name
     -> Focusing (StateT (EventState Name) IO) () (FileBrowser Name))
    -> FBS -> Focusing (StateT (EventState Name) IO) () FBS)
-> (FileBrowser Name
    -> Focusing (StateT (EventState Name) IO) () (FileBrowser Name))
-> GlobalState
-> Focusing (StateT (EventState Name) IO) () GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FileBrowser Name
 -> Focusing (StateT (EventState Name) IO) () (FileBrowser Name))
-> FBS -> Focusing (StateT (EventState Name) IO) () FBS
Lens' FBS (FileBrowser Name)
fb) (EventM Name (FileBrowser Name) () -> EventM Name GlobalState ())
-> EventM Name (FileBrowser Name) () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name (FileBrowser Name) ()
forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEvent Event
ev
            FileBrowser Name
b' <- Getting (FileBrowser Name) GlobalState (FileBrowser Name)
-> EventM Name GlobalState (FileBrowser Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FileBrowser Name) GlobalState (FileBrowser Name)
 -> EventM Name GlobalState (FileBrowser Name))
-> Getting (FileBrowser Name) GlobalState (FileBrowser Name)
-> EventM Name GlobalState (FileBrowser Name)
forall a b. (a -> b) -> a -> b
$ (FBS -> Const (FileBrowser Name) FBS)
-> GlobalState -> Const (FileBrowser Name) GlobalState
Lens' GlobalState FBS
fbs((FBS -> Const (FileBrowser Name) FBS)
 -> GlobalState -> Const (FileBrowser Name) GlobalState)
-> ((FileBrowser Name
     -> Const (FileBrowser Name) (FileBrowser Name))
    -> FBS -> Const (FileBrowser Name) FBS)
-> Getting (FileBrowser Name) GlobalState (FileBrowser Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FileBrowser Name -> Const (FileBrowser Name) (FileBrowser Name))
-> FBS -> Const (FileBrowser Name) FBS
Lens' FBS (FileBrowser Name)
fb
            case (Event
ev, FileBrowser Name -> [FileInfo]
forall n. FileBrowser n -> [FileInfo]
fileBrowserSelection FileBrowser Name
b') of
                (V.EvKey Key
V.KEnter [], []) -> () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
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 <- IO (Either IOError String)
-> EventM Name GlobalState (Either IOError String)
forall a. IO a -> EventM Name GlobalState a
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 -> Identity FBS) -> GlobalState -> Identity GlobalState
Lens' GlobalState FBS
fbs((FBS -> Identity FBS) -> GlobalState -> Identity GlobalState)
-> ((Maybe String -> Identity (Maybe String))
    -> FBS -> Identity FBS)
-> (Maybe String -> Identity (Maybe String))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS
Lens' FBS (Maybe String)
exception' ((Maybe String -> Identity (Maybe String))
 -> GlobalState -> Identity GlobalState)
-> String -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= 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 -> Identity FBS) -> GlobalState -> Identity GlobalState
Lens' GlobalState FBS
fbs((FBS -> Identity FBS) -> GlobalState -> Identity GlobalState)
-> ((Maybe String -> Identity (Maybe String))
    -> FBS -> Identity FBS)
-> (Maybe String -> Identity (Maybe String))
-> GlobalState
-> Identity GlobalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe String -> Identity (Maybe String)) -> FBS -> Identity FBS
Lens' FBS (Maybe String)
exception' ((Maybe String -> Identity (Maybe String))
 -> GlobalState -> Identity GlobalState)
-> String -> EventM Name GlobalState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= String
parseError
                            Right [Card]
result -> do
                                    IO () -> EventM Name GlobalState ()
forall a. IO a -> EventM Name GlobalState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name GlobalState ())
-> IO () -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
addRecent String
fp
                                    LensLike' (Zoomed (EventM Name CSS) ()) GlobalState CSS
-> EventM Name CSS () -> EventM Name GlobalState ()
forall c.
LensLike' (Zoomed (EventM Name CSS) c) GlobalState CSS
-> EventM Name CSS c -> EventM Name GlobalState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (EventM Name CSS) ()) GlobalState CSS
Lens' GlobalState CSS
css EventM Name CSS ()
forall (m :: * -> *). (MonadState CSS m, MonadIO m) => m ()
refreshRecents
                                    Parameters
params <- Getting Parameters GlobalState Parameters
-> EventM Name GlobalState Parameters
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Parameters GlobalState Parameters
Lens' GlobalState Parameters
parameters
                                    State -> EventM Name GlobalState ()
forall (m :: * -> *). MonadState GlobalState m => State -> m ()
goToState (State -> EventM Name GlobalState ())
-> State -> EventM Name GlobalState ()
forall a b. (a -> b) -> a -> b
$ Parameters -> String -> [Card] -> State
parameterState Parameters
params String
fp [Card]
result
                (V.EvKey Key
V.KEnter [], [FileInfo]
_) -> EventM Name GlobalState ()
forall (m :: * -> *). MonadState GlobalState m => m ()
popState
                (Event, [FileInfo])
_ -> () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleEvent BrickEvent Name ()
_ = () -> EventM Name GlobalState ()
forall a. a -> EventM Name GlobalState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()