{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Reflex.Vty.Widget.FileExplorer (
  FileExplorerWidgetConfig(..)
  , FileExplorerWidget(..)
  , holdFileExplorerWidget
) where

import           Relude

import           Potato.Flow
import           Potato.Flow.Controller
import           Potato.Flow.Vty.Attrs
import           Potato.Flow.Vty.Input
import           Potato.Reflex.Vty.Helpers
import           Potato.Reflex.Vty.Widget
import Potato.Flow.Vty.PotatoReader
import Potato.Reflex.Vty.Widget.TextInputHelpers
import           Potato.Reflex.Vty.Widget.ScrollBar



import Control.Exception (catch)
import           Control.Monad.Fix
import           Data.Align
import           Data.Dependent.Sum          (DSum ((:=>)))
import qualified Data.IntMap.Strict          as IM
import qualified Data.List                   as L
import qualified Data.Sequence               as Seq
import qualified Data.Text                   as T
import           Data.Text.Zipper
import qualified Data.Text.Zipper            as TZ
import           Data.These
import qualified System.Directory as FP
import qualified System.FilePath as FP

import qualified Graphics.Vty                as V
import           Reflex
import           Reflex.Network
import           Reflex.Potato.Helpers
import           Reflex.Vty


fetchDirectory :: forall t m. (MonadWidget t m) => Event t FP.FilePath -> m (Event t [(Bool, FP.FilePath)])
fetchDirectory :: forall t (m :: * -> *).
MonadWidget t m =>
Event t FilePath -> m (Event t [(Bool, FilePath)])
fetchDirectory Event t FilePath
ev = let
    catchfn :: SomeException -> IO [(Bool, FP.FilePath)]
    catchfn :: SomeException -> IO [(Bool, FilePath)]
catchfn = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [])
  in forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t FilePath
ev forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch SomeException -> IO [(Bool, FilePath)]
catchfn) forall a b. (a -> b) -> a -> b
$ do
    --workingDir <- FP.getCurrentDirectory
    [FilePath]
contents <- FilePath -> IO [FilePath]
FP.getDirectoryContents FilePath
dir
    [(Bool, FilePath)]
contentsWithFolder <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
contents forall a b. (a -> b) -> a -> b
$ \FilePath
d -> FilePath -> IO Bool
FP.doesDirectoryExist (FilePath -> FilePath -> FilePath
FP.combine FilePath
dir FilePath
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,FilePath -> FilePath -> FilePath
FP.combine FilePath
dir FilePath
d)
    let
      sortfn :: (Bool, b) -> (Bool, b) -> Ordering
sortfn (Bool
d1,b
_) (Bool
d2,b
_) = case (Bool
d1,Bool
d2) of
        (Bool
True, Bool
False) -> Ordering
LT
        (Bool
False, Bool
True) -> Ordering
GT
        (Bool, Bool)
_ -> Ordering
EQ
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy forall {b} {b}. (Bool, b) -> (Bool, b) -> Ordering
sortfn) [(Bool, FilePath)]
contentsWithFolder

data FileExplorerWidgetConfig t = FileExplorerWidgetConfig {
  forall t. FileExplorerWidgetConfig t -> Behavior t Attr
_fileExplorerWidgetConfig_clickDownStyle :: Behavior t V.Attr

  -- TODO we don't need full filepath
  , forall t. FileExplorerWidgetConfig t -> FilePath -> Bool
_fileExplorerWidgetConfig_fileFilter :: FP.FilePath -> Bool
  , forall t. FileExplorerWidgetConfig t -> FilePath
_fileExplorerWidgetConfig_initialFile :: FP.FilePath
}

data FileExplorerWidget t = FileExplorerWidget {
  -- the filename in the entry area
  forall t. FileExplorerWidget t -> Behavior t Text
_fileExplorerWidget_filename :: Behavior t Text
  -- the directory <> filename in the entry area
  , forall t. FileExplorerWidget t -> Behavior t FilePath
_fileExplorerWidget_fullfilename :: Behavior t FP.FilePath
  , forall t. FileExplorerWidget t -> Event t FilePath
_fileExplorerWidget_doubleClickFile :: Event t FP.FilePath -- pretty sure this is just single click for now -__-
  , forall t. FileExplorerWidget t -> Dynamic t FilePath
_fileExplorerWidget_directory :: Dynamic t FP.FilePath
  , forall t. FileExplorerWidget t -> Event t ()
_fileExplorerWidget_returnOnfilename :: Event t () -- fires when you hit the "return" key in file name input area
  , forall t. FileExplorerWidget t -> Event t ()
_fileExplorerWidget_doubleClick :: Event t () -- fires when you double click on an existing valid file
}

data FileClick = FileClick {
    FileClick -> Bool
_fileClick_isDouble :: Bool
    , FileClick -> Bool
_fileClick_isFolder :: Bool
    , FileClick -> FilePath
_fileClick_file :: FP.FilePath
  }
-- TODO reduce constraints, don't use HasPotato
holdFileExplorerWidget :: forall t m. (MonadLayoutWidget t m, HasPotato t m)
  => FileExplorerWidgetConfig t
  -> m (FileExplorerWidget t)
holdFileExplorerWidget :: forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
FileExplorerWidgetConfig t -> m (FileExplorerWidget t)
holdFileExplorerWidget FileExplorerWidgetConfig {FilePath
Behavior t Attr
FilePath -> Bool
_fileExplorerWidgetConfig_initialFile :: FilePath
_fileExplorerWidgetConfig_fileFilter :: FilePath -> Bool
_fileExplorerWidgetConfig_clickDownStyle :: Behavior t Attr
_fileExplorerWidgetConfig_initialFile :: forall t. FileExplorerWidgetConfig t -> FilePath
_fileExplorerWidgetConfig_fileFilter :: forall t. FileExplorerWidgetConfig t -> FilePath -> Bool
_fileExplorerWidgetConfig_clickDownStyle :: forall t. FileExplorerWidgetConfig t -> Behavior t Attr
..} = mdo

  Behavior t Attr
baseStyle <- forall {k} (t :: k) (m :: * -> *).
HasTheme t m =>
m (Behavior t Attr)
theme
  Bool
isInitialFileDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
FP.doesDirectoryExist FilePath
_fileExplorerWidgetConfig_initialFile)

  -- select + click is one way to do choose file to save to but double click is prob better...
  --selectedDyn :: Dynamic t (Maybe Int)
  --selectedDyn <- holdDyn Nothing $ leftmost [selectEv, ]

  -- set up directory/filename text field stuff
  Event t ()
pb <- forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  let
    Event t (FilePath, FilePath)
initialDirFileEv :: Event t (FilePath, FilePath) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways Event t ()
pb forall a b. (a -> b) -> a -> b
$ \()
_ -> do
      let
        dir :: FilePath
dir = FilePath -> FilePath
FP.takeDirectory FilePath
_fileExplorerWidgetConfig_initialFile
        file :: FilePath
file = FilePath -> FilePath
FP.takeFileName FilePath
_fileExplorerWidgetConfig_initialFile
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
isInitialFileDir then (FilePath
_fileExplorerWidgetConfig_initialFile, FilePath
"") else (FilePath
dir, FilePath
file)
    foldDirDynFn :: FilePath -> FilePath -> FilePath
foldDirDynFn FilePath
new FilePath
old = case FilePath -> FilePath
FP.takeFileName FilePath
new of
      FilePath
"." -> FilePath
old
      FilePath
".." -> FilePath -> FilePath
FP.takeDirectory FilePath
old
      FilePath
_ -> FilePath
new
  Dynamic t FilePath
dirDyn <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn FilePath -> FilePath -> FilePath
foldDirDynFn FilePath
"" (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Event t (FilePath, FilePath)
initialDirFileEv, Event t FilePath
clickFolderEvent, Event t FilePath
setFolderEvent])
  Event t [(Bool, FilePath)]
fetchDirComplete <- forall t (m :: * -> *).
MonadWidget t m =>
Event t FilePath -> m (Event t [(Bool, FilePath)])
fetchDirectory (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t FilePath
dirDyn)
  Dynamic t [(Bool, FilePath)]
dirContentsDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn [] Event t [(Bool, FilePath)]
fetchDirComplete

  let
    -- set up directory list widget
    dirWidget :: Dynamic t Text -> [(Bool, FilePath)] -> m (Event t FileClick)
dirWidget Dynamic t Text
filenameinentryfielddyn [(Bool, FilePath)]
xs = (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ mdo
      Event t FileClick
r <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
        let 
          scrolledContents :: Dynamic t (m (Event t FileClick))
scrolledContents = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Int
vScrollDyn forall a b. (a -> b) -> a -> b
$ \Int
vscroll -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Int -> [a] -> [a]
drop Int
vscroll [(Bool, FilePath)]
xs) forall a b. (a -> b) -> a -> b
$ \(Bool
isFolder, FilePath
path) -> do
            (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
              let
                clickable :: Bool
clickable = FilePath -> Bool
_fileExplorerWidgetConfig_fileFilter FilePath
path

                -- TODO design proper styling... (maybe prefix folders with > instead of style differently?)

              -- TODO make it so you need to click on the name???
              (Event t SingleClick
singleClick', Dynamic t Bool
downDyn) <- forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t SingleClick, Dynamic t Bool)
singleClickWithDownState Button
V.BLeft
              Event t ()
doubleClick <- forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, PerformEvent t m,
 MonadIO (Performable m), HasInput t m) =>
m (Event t ())
doubleClickSimple 

              -- TODO highlight if matches the file entry box
              let
                styleBeh :: Behavior t Attr
styleBeh = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
filenameinentryfielddyn) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
downDyn) forall a b. (a -> b) -> a -> b
$ \Text
fn Bool
d -> if Bool
d Bool -> Bool -> Bool
|| Text -> FilePath
T.unpack Text
fn forall a. Eq a => a -> a -> Bool
== FilePath
filename then Behavior t Attr
_fileExplorerWidgetConfig_clickDownStyle else Behavior t Attr
baseStyle
                filename :: FilePath
filename = FilePath -> FilePath
FP.takeFileName FilePath
path
                pathtext' :: Text
pathtext' = FilePath -> Text
T.pack FilePath
filename
                pathtext :: Text
pathtext = if Bool
isFolder
                  then Text
"> " forall a. Semigroup a => a -> a -> a
<> Text
pathtext'
                  else if Bool
clickable
                    then Text
" *" forall a. Semigroup a => a -> a -> a
<> Text
pathtext'
                    else Text
"  " forall a. Semigroup a => a -> a -> a
<> Text
pathtext'

              forall {k} (t :: k) (m :: * -> *) a.
HasTheme t m =>
(Behavior t Attr -> Behavior t Attr) -> m a -> m a
localTheme (forall a b. a -> b -> a
const Behavior t Attr
styleBeh) forall a b. (a -> b) -> a -> b
$ do
                forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
 HasTheme t m) =>
Behavior t Text -> m ()
text (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant Text
pathtext)

              let 
                singleClick :: Event t SingleClick
singleClick = forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleClick -> Bool
_singleClick_didDragOff) Event t SingleClick
singleClick'
                makefileclick :: Bool -> FileClick
makefileclick Bool
isdouble = FileClick {
                    _fileClick_isDouble :: Bool
_fileClick_isDouble = Bool
isdouble
                    , _fileClick_isFolder :: Bool
_fileClick_isFolder = Bool
isFolder
                    , _fileClick_file :: FilePath
_fileClick_file = FilePath
path
                  }
                alignWithFn :: These SingleClick () -> FileClick
alignWithFn These SingleClick ()
th = case These SingleClick ()
th of
                  This SingleClick
_ -> Bool -> FileClick
makefileclick Bool
False
                  That ()
_ -> Bool -> FileClick
makefileclick Bool
True
                  These SingleClick
_ ()
_ -> Bool -> FileClick
makefileclick Bool
True
                fileclickev :: Event t FileClick
fileclickev = forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These SingleClick () -> FileClick
alignWithFn Event t SingleClick
singleClick (forall {k} (t :: k) a.
(Reflex t, Show a) =>
FilePath -> Event t a -> Event t a
traceEvent FilePath
"double" Event t ()
doubleClick)

              if Bool
isFolder Bool -> Bool -> Bool
|| Bool
clickable
                then forall (m :: * -> *) a. Monad m => a -> m a
return Event t FileClick
fileclickev
                else forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (t :: k) a. Reflex t => Event t a
never
        forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView forall a b. (a -> b) -> a -> b
$ Dynamic t (m (Event t FileClick))
scrolledContents
      let 
        vScrollWidth :: Int
vScrollWidth = Int
2
      Dynamic t Int
vScrollDyn <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Int
vScrollWidth) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
        forall t (m :: * -> *) a.
MonadWidget t m =>
Int -> Dynamic t Int -> m (Dynamic t Int)
vScrollBar Int
vScrollWidth (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, FilePath)]
xs))
      forall (m :: * -> *) a. Monad m => a -> m a
return Event t FileClick
r

  -- put it all together
  (Event t FileClick
clickEvent, Event t FilePath
setFolderRawEvent, Dynamic t Text
filenameDyn, Event t KeyCombo
enterEv) <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
    -- TODO consider combining filename and directory into one...
    let
      setFileEv :: Event t Text
setFileEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Event t (FilePath, FilePath)
initialDirFileEv, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
FP.takeFileName Event t FilePath
clickFileEvent]


    -- input for filename
    (FocusId
fninputfid, (Dynamic t Text
filenameDyn', Event t KeyCombo
enterEv')) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
      (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
10 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
 HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"filename"
      (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m (FocusId, a)
tile' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Text -> Event t Text -> m (Dynamic t Text)
filenameInput Text
"" Event t Text
setFileEv forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key Key
V.KEnter

    -- focus the filename input
    forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus (Event t ()
pb forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FocusId -> Refocus
Refocus_Id FocusId
fninputfid)

    -- input for directory
    Event t FilePath
setFolderRawEvent' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
      (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
10 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
 HasTheme t m) =>
Behavior t Text -> m ()
text Behavior t Text
"directory"
      (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ do
        let indirev :: Event t Text
indirev = (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack Dynamic t FilePath
dirDyn))
        Dynamic t Text
dirdyn <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Text -> Event t Text -> m (Dynamic t Text)
filenameInput Text
"" Event t Text
indirev
        return $ forall {k} (t :: k) a b.
Reflex t =>
Event t a -> Event t b -> Event t a
difference (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack Dynamic t Text
dirdyn) Event t Text
indirev

    -- click in dir list event
    (Event t FileClick
clickEvent') <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
5 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasInput t m, HasFocusReader t m,
 HasTheme t m) =>
Behavior t BoxStyle -> m a -> m a
box (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant BoxStyle
singleBoxStyle) forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold forall {k} (t :: k) a. Reflex t => Event t a
never) forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView (forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t [(Bool, FilePath)]
dirContentsDyn (Dynamic t Text -> [(Bool, FilePath)] -> m (Event t FileClick)
dirWidget Dynamic t Text
filenameDyn'))

    return (Event t FileClick
clickEvent', Event t FilePath
setFolderRawEvent', Dynamic t Text
filenameDyn', Event t KeyCombo
enterEv')

  -- perform the IO query to get the folder contents
  Event t (Maybe FilePath)
mSetFolderEvent <- forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t FilePath
setFolderRawEvent forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Bool
exists <- FilePath -> IO Bool
FP.doesDirectoryExist FilePath
dir
    if Bool
exists then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FilePath
dir else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  let
    setFolderEvent :: Event t FilePath
setFolderEvent = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. a -> a
id Event t (Maybe FilePath)
mSetFolderEvent

  let
    -- TODO consider using doubleClickEvent (you might want to implement highlight selection in this case)
    maybeClickFolder :: FileClick -> Maybe FilePath
maybeClickFolder FileClick
fc = if FileClick -> Bool
_fileClick_isFolder FileClick
fc Bool -> Bool -> Bool
&& Bool -> Bool
not (FileClick -> Bool
_fileClick_isDouble FileClick
fc) then forall a. a -> Maybe a
Just (FileClick -> FilePath
_fileClick_file FileClick
fc) else forall a. Maybe a
Nothing
    maybeClickFile :: FileClick -> Maybe FilePath
maybeClickFile FileClick
fc = if Bool -> Bool
not (FileClick -> Bool
_fileClick_isFolder FileClick
fc) Bool -> Bool -> Bool
&& Bool -> Bool
not (FileClick -> Bool
_fileClick_isDouble FileClick
fc) then forall a. a -> Maybe a
Just (FileClick -> FilePath
_fileClick_file FileClick
fc) else forall a. Maybe a
Nothing 
    maybeDoubleClickFile :: FileClick -> Maybe FilePath
maybeDoubleClickFile FileClick
fc = if Bool -> Bool
not (FileClick -> Bool
_fileClick_isFolder FileClick
fc) Bool -> Bool -> Bool
&& FileClick -> Bool
_fileClick_isDouble FileClick
fc then forall a. a -> Maybe a
Just (FileClick -> FilePath
_fileClick_file FileClick
fc) else forall a. Maybe a
Nothing

    clickFolderEvent :: Event t FilePath
clickFolderEvent = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe FileClick -> Maybe FilePath
maybeClickFolder Event t FileClick
clickEvent
    clickFileEvent :: Event t FilePath
clickFileEvent = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe FileClick -> Maybe FilePath
maybeClickFile Event t FileClick
clickEvent
    doubleClickFileEvent :: Event t FilePath
doubleClickFileEvent = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe FileClick -> Maybe FilePath
maybeDoubleClickFile Event t FileClick
clickEvent

    fullfilenameDyn :: Dynamic t FilePath
fullfilenameDyn = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t FilePath
dirDyn Dynamic t Text
filenameDyn forall a b. (a -> b) -> a -> b
$ \FilePath
dir Text
fn -> FilePath -> FilePath -> FilePath
FP.combine FilePath
dir (Text -> FilePath
T.unpack Text
fn)

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FileExplorerWidget {
      _fileExplorerWidget_filename :: Behavior t Text
_fileExplorerWidget_filename  = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
filenameDyn
      , _fileExplorerWidget_fullfilename :: Behavior t FilePath
_fileExplorerWidget_fullfilename = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t FilePath
fullfilenameDyn
      , _fileExplorerWidget_doubleClickFile :: Event t FilePath
_fileExplorerWidget_doubleClickFile = Event t FilePath
clickFileEvent
      , _fileExplorerWidget_directory :: Dynamic t FilePath
_fileExplorerWidget_directory = Dynamic t FilePath
dirDyn
      , _fileExplorerWidget_returnOnfilename :: Event t ()
_fileExplorerWidget_returnOnfilename = forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t KeyCombo
enterEv
      , _fileExplorerWidget_doubleClick :: Event t ()
_fileExplorerWidget_doubleClick = forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t FilePath
doubleClickFileEvent
    }