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