{-# 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
[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
, forall t. FileExplorerWidgetConfig t -> FilePath -> Bool
_fileExplorerWidgetConfig_fileFilter :: FP.FilePath -> Bool
, forall t. FileExplorerWidgetConfig t -> FilePath
_fileExplorerWidgetConfig_initialFile :: FP.FilePath
}
data FileExplorerWidget t = FileExplorerWidget {
forall t. FileExplorerWidget t -> Behavior t Text
_fileExplorerWidget_filename :: Behavior t Text
, 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
, forall t. FileExplorerWidget t -> Dynamic t FilePath
_fileExplorerWidget_directory :: Dynamic t FP.FilePath
, forall t. FileExplorerWidget t -> Event t ()
_fileExplorerWidget_returnOnfilename :: Event t ()
, forall t. FileExplorerWidget t -> Event t ()
_fileExplorerWidget_doubleClick :: Event t ()
}
data FileClick = FileClick {
FileClick -> Bool
_fileClick_isDouble :: Bool
, FileClick -> Bool
_fileClick_isFolder :: Bool
, FileClick -> FilePath
_fileClick_file :: FP.FilePath
}
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)
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
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
(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
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
(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
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]
(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
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)
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
(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')
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
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
}