{-# Language UndecidableInstances #-}

module Potato.Flow.Vty.PotatoReader where

import           Relude

import Potato.Flow

import Data.Default
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
--import Control.Monad.Morph
import Control.Monad.NodeId
import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
import Control.Monad.Ref
import Control.Monad.Trans (MonadTrans, lift)

import qualified System.FilePath as FP

import qualified Graphics.Vty as V
import Reflex.Host.Class (MonadReflexCreateTrigger)
import           Reflex
import           Reflex.Vty

import Potato.Flow.Vty.Attrs


-- TODO move elsewhere
kTinyToolsFileExtension :: (IsString a) => a
kTinyToolsFileExtension :: forall a. IsString a => a
kTinyToolsFileExtension = a
".potato"

-- TODO move elsewhere
addTinyToolsFileExtensionIfNecessary :: FP.FilePath -> FP.FilePath
addTinyToolsFileExtensionIfNecessary :: String -> String
addTinyToolsFileExtensionIfNecessary String
fp = if String -> String
FP.takeExtension String
fp forall a. Eq a => a -> a -> Bool
== String
""
  then String
fp forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => a
kTinyToolsFileExtension
  else String
fp



data PotatoStyle = PotatoStyle {

  -- TODO you can DELETE this now prob
  PotatoStyle -> Attr
_potatoStyle_canvasCursor :: V.Attr

  , PotatoStyle -> RenderHandleColor -> Attr
_potatoStyle_makeCanvasManipulator :: RenderHandleColor -> V.Attr
  , PotatoStyle -> Attr
_potatoStyle_normal :: V.Attr

  , PotatoStyle -> Attr
_potatoStyle_selected :: V.Attr
  , PotatoStyle -> Attr
_potatoStyle_layers_softSelected :: V.Attr -- color of parent(s) when child is selected
  , PotatoStyle -> Attr
_potatoStyle_canvas_oob :: V.Attr

  , PotatoStyle -> Attr
_potatoStyle_textfield_normal :: V.Attr
  , PotatoStyle -> Attr
_potatoStyle_textfield_modifying :: V.Attr
  , PotatoStyle -> Attr
_potatoStyle_textfield_cursor :: V.Attr
}


instance Default PotatoStyle where
  def :: PotatoStyle
def = PotatoStyle {
      _potatoStyle_normal :: Attr
_potatoStyle_normal = Attr
lg_default

      ,_potatoStyle_canvasCursor :: Attr
_potatoStyle_canvasCursor = Attr
lg_canvas_cursor
      , _potatoStyle_makeCanvasManipulator :: RenderHandleColor -> Attr
_potatoStyle_makeCanvasManipulator = RenderHandleColor -> Attr
lg_make_canvas_cursor
      , _potatoStyle_canvas_oob :: Attr
_potatoStyle_canvas_oob = Attr
lg_canvas_oob

      , _potatoStyle_selected :: Attr
_potatoStyle_selected = Attr
lg_layer_selected
      , _potatoStyle_layers_softSelected :: Attr
_potatoStyle_layers_softSelected = Attr
lg_layer_inheritselect

      , _potatoStyle_textfield_normal :: Attr
_potatoStyle_textfield_normal = Attr
lg_textfield_normal
      , _potatoStyle_textfield_modifying :: Attr
_potatoStyle_textfield_modifying = Attr
lg_textfield_modifying
      , _potatoStyle_textfield_cursor :: Attr
_potatoStyle_textfield_cursor = Attr
lg_textfield_cursor
    }

data PotatoConfig t = PotatoConfig {
  forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style :: Behavior t PotatoStyle

  -- TODO these need to be per document if you ever want MDI
  , forall t. PotatoConfig t -> Behavior t (Maybe String)
_potatoConfig_appCurrentOpenFile :: Behavior t (Maybe FP.FilePath)
  , forall t. PotatoConfig t -> Behavior t String
_potatoConfig_appCurrentDirectory :: Behavior t FP.FilePath
  , forall t. PotatoConfig t -> Behavior t (Maybe String)
_potatoConfig_appPrintFile :: Behavior t (Maybe FP.FilePath)
  -- TODO
  --, _potatoConfig_unsavedChanges :: Behavior t Bool
}

instance (Reflex t) =>  Default (PotatoConfig t) where
  def :: PotatoConfig t
def = PotatoConfig {
      _potatoConfig_style :: Behavior t PotatoStyle
_potatoConfig_style = forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Default a => a
def
      , _potatoConfig_appCurrentOpenFile :: Behavior t (Maybe String)
_potatoConfig_appCurrentOpenFile = forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Maybe a
Nothing
      , _potatoConfig_appPrintFile :: Behavior t (Maybe String)
_potatoConfig_appPrintFile = forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Maybe a
Nothing
    }

-- | A class for things that can dynamically gain and lose focus
class (Reflex t, Monad m) => HasPotato t m | m -> t where
  askPotato :: m (PotatoConfig t)

instance (HasInput t m, Monad m) => HasInput t (ReaderT r m)


-- TODO it's better to do this using
-- default input :: (f m' ~ m, Monad m', MonadTrans f, HasInput t m') => ...
-- inside of HasFocus class
instance (Reflex t, HasFocus t m, Monad m) => HasFocus t (ReaderT r m) where
  makeFocus :: ReaderT r m FocusId
makeFocus = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (t :: k) (m :: * -> *). HasFocus t m => m FocusId
makeFocus
  requestFocus :: Event t Refocus -> ReaderT r m ()
requestFocus = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
Event t Refocus -> m ()
requestFocus
  isFocused :: FocusId -> ReaderT r m (Dynamic t Bool)
isFocused = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
FocusId -> m (Dynamic t Bool)
isFocused
  --subFoci :: m a -> m (a, Dynamic t FocusSet)
  subFoci :: forall a. ReaderT r m a -> ReaderT r m (a, Dynamic t FocusSet)
subFoci ReaderT r m a
x = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall {k} (t :: k) (m :: * -> *) a.
HasFocus t m =>
m a -> m (a, Dynamic t FocusSet)
subFoci (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
x r
r)
  focusedId :: ReaderT r m (Dynamic t (Maybe FocusId))
focusedId = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId


instance HasPotato t m => HasPotato t (ReaderT x m)
instance HasPotato t m => HasPotato t (BehaviorWriterT t x m)
instance HasPotato t m => HasPotato t (DynamicWriterT t x m)
instance HasPotato t m => HasPotato t (EventWriterT t x m)
instance HasPotato t m => HasPotato t (NodeIdT m)
instance HasPotato t m => HasPotato t (Input t m)
instance HasPotato t m => HasPotato t (ImageWriter t m)
instance HasPotato t m => HasPotato t (DisplayRegion t m)
instance HasPotato t m => HasPotato t (FocusReader t m)
instance HasPotato t m => HasPotato t (Focus t m) where
  askPotato :: Focus t m (PotatoConfig t)
askPotato = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato
instance HasPotato t m => HasPotato t (Layout t m) where
  askPotato :: Layout t m (PotatoConfig t)
askPotato = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato


-- | A widget that has access to information about whether it is focused
newtype PotatoReader t m a = PotatoReader
  { forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader :: ReaderT (PotatoConfig t) m a }
  deriving
    ( forall a b. a -> PotatoReader t m b -> PotatoReader t m a
forall a b. (a -> b) -> PotatoReader t m a -> PotatoReader t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> PotatoReader t m b -> PotatoReader t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> PotatoReader t m a -> PotatoReader t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PotatoReader t m b -> PotatoReader t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> PotatoReader t m b -> PotatoReader t m a
fmap :: forall a b. (a -> b) -> PotatoReader t m a -> PotatoReader t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> PotatoReader t m a -> PotatoReader t m b
Functor
    , forall a. a -> PotatoReader t m a
forall a b.
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m a
forall a b.
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
forall a b.
PotatoReader t m (a -> b)
-> PotatoReader t m a -> PotatoReader t m b
forall a b c.
(a -> b -> c)
-> PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m c
forall {t} {m :: * -> *}.
Applicative m =>
Functor (PotatoReader t m)
forall t (m :: * -> *) a. Applicative m => a -> PotatoReader t m a
forall t (m :: * -> *) a b.
Applicative m =>
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m a
forall t (m :: * -> *) a b.
Applicative m =>
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
forall t (m :: * -> *) a b.
Applicative m =>
PotatoReader t m (a -> b)
-> PotatoReader t m a -> PotatoReader t m b
forall t (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m a
$c<* :: forall t (m :: * -> *) a b.
Applicative m =>
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m a
*> :: forall a b.
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
$c*> :: forall t (m :: * -> *) a b.
Applicative m =>
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
liftA2 :: forall a b c.
(a -> b -> c)
-> PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m c
<*> :: forall a b.
PotatoReader t m (a -> b)
-> PotatoReader t m a -> PotatoReader t m b
$c<*> :: forall t (m :: * -> *) a b.
Applicative m =>
PotatoReader t m (a -> b)
-> PotatoReader t m a -> PotatoReader t m b
pure :: forall a. a -> PotatoReader t m a
$cpure :: forall t (m :: * -> *) a. Applicative m => a -> PotatoReader t m a
Applicative
    , forall a. a -> PotatoReader t m a
forall a b.
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
forall a b.
PotatoReader t m a
-> (a -> PotatoReader t m b) -> PotatoReader t m b
forall {t} {m :: * -> *}. Monad m => Applicative (PotatoReader t m)
forall t (m :: * -> *) a. Monad m => a -> PotatoReader t m a
forall t (m :: * -> *) a b.
Monad m =>
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
forall t (m :: * -> *) a b.
Monad m =>
PotatoReader t m a
-> (a -> PotatoReader t m b) -> PotatoReader t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PotatoReader t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> PotatoReader t m a
>> :: forall a b.
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
PotatoReader t m a -> PotatoReader t m b -> PotatoReader t m b
>>= :: forall a b.
PotatoReader t m a
-> (a -> PotatoReader t m b) -> PotatoReader t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
PotatoReader t m a
-> (a -> PotatoReader t m b) -> PotatoReader t m b
Monad
    , forall a. (a -> PotatoReader t m a) -> PotatoReader t m a
forall {t} {m :: * -> *}. MonadFix m => Monad (PotatoReader t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> PotatoReader t m a) -> PotatoReader t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> PotatoReader t m a) -> PotatoReader t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> PotatoReader t m a) -> PotatoReader t m a
MonadFix
    , MonadHold t
    , forall a. IO a -> PotatoReader t m a
forall {t} {m :: * -> *}. MonadIO m => Monad (PotatoReader t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> PotatoReader t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> PotatoReader t m a
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> PotatoReader t m a
MonadIO
    , forall a. a -> PotatoReader t m (Ref (PotatoReader t m) a)
forall a. Ref (PotatoReader t m) a -> PotatoReader t m a
forall a. Ref (PotatoReader t m) a -> a -> PotatoReader t m ()
forall a.
Ref (PotatoReader t m) a -> (a -> a) -> PotatoReader t m ()
forall {t} {m :: * -> *}. MonadRef m => Monad (PotatoReader t m)
forall t (m :: * -> *) a.
MonadRef m =>
a -> PotatoReader t m (Ref (PotatoReader t m) a)
forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> PotatoReader t m a
forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> a -> PotatoReader t m ()
forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> (a -> a) -> PotatoReader t m ()
forall (m :: * -> *).
Monad m
-> (forall a. a -> m (Ref m a))
-> (forall a. Ref m a -> m a)
-> (forall a. Ref m a -> a -> m ())
-> (forall a. Ref m a -> (a -> a) -> m ())
-> (forall a. Ref m a -> (a -> a) -> m ())
-> MonadRef m
modifyRef' :: forall a.
Ref (PotatoReader t m) a -> (a -> a) -> PotatoReader t m ()
$cmodifyRef' :: forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> (a -> a) -> PotatoReader t m ()
modifyRef :: forall a.
Ref (PotatoReader t m) a -> (a -> a) -> PotatoReader t m ()
$cmodifyRef :: forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> (a -> a) -> PotatoReader t m ()
writeRef :: forall a. Ref (PotatoReader t m) a -> a -> PotatoReader t m ()
$cwriteRef :: forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> a -> PotatoReader t m ()
readRef :: forall a. Ref (PotatoReader t m) a -> PotatoReader t m a
$creadRef :: forall t (m :: * -> *) a.
MonadRef m =>
Ref (PotatoReader t m) a -> PotatoReader t m a
newRef :: forall a. a -> PotatoReader t m (Ref (PotatoReader t m) a)
$cnewRef :: forall t (m :: * -> *) a.
MonadRef m =>
a -> PotatoReader t m (Ref (PotatoReader t m) a)
MonadRef
    , MonadSample t
    )

instance (Monad m, Reflex t) => HasPotato t (PotatoReader t m) where
  askPotato :: PotatoReader t m (PotatoConfig t)
askPotato = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall r (m :: * -> *). MonadReader r m => m r
ask

deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (PotatoReader t m)
deriving instance NotReady t m => NotReady t (PotatoReader t m)
deriving instance PerformEvent t m => PerformEvent t (PotatoReader t m)
deriving instance PostBuild t m => PostBuild t (PotatoReader t m)
deriving instance TriggerEvent t m => TriggerEvent t (PotatoReader t m)
deriving instance (HasInput t m, Monad m) => HasInput t (PotatoReader t m)
deriving instance HasFocus t m => HasFocus t (PotatoReader t m)
deriving instance HasFocusReader t m => HasFocusReader t (PotatoReader t m)
deriving instance HasTheme t m => HasTheme t (PotatoReader t m)
deriving instance HasDisplayRegion t m => HasDisplayRegion t (PotatoReader t m)

-- can't seem to include Control.Monad.Morph :(
--instance HasImageWriter t m => HasImageWriter t (PotatoReader t m)
--instance MFunctor (PotatoReader t) where
--  hoist f = PotatoReader . hoist f . unPotatoReader

instance HasImageWriter t m => HasImageWriter t (PotatoReader t m) where
  tellImages :: Behavior t [Image] -> PotatoReader t m ()
tellImages = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages
  mapImages :: forall a.
(Behavior t [Image] -> Behavior t [Image])
-> PotatoReader t m a -> PotatoReader t m a
mapImages Behavior t [Image] -> Behavior t [Image]
f = forall {m :: * -> *} {a} {m :: * -> *} {a} {t}.
(m a -> m a) -> PotatoReader t m a -> PotatoReader t m a
hoistpotato (forall {k} (t :: k) (m :: * -> *) a.
HasImageWriter t m =>
(Behavior t [Image] -> Behavior t [Image]) -> m a -> m a
mapImages Behavior t [Image] -> Behavior t [Image]
f) where
    hoistpotato :: (m a -> m a) -> PotatoReader t m a -> PotatoReader t m a
hoistpotato m a -> m a
g = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {m :: * -> *} {a} {m :: * -> *} {a} {r}.
(m a -> m a) -> ReaderT r m a -> ReaderT r m a
hoist m a -> m a
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader
    hoist :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
hoist m a -> m a
nat ReaderT r m a
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\r
i -> m a -> m a
nat (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
i))

-- TODO it's better to do this using
-- default input :: (f m' ~ m, Monad m', MonadTrans f, HasInput t m') => ...
-- inside of HasLayout class
instance (Reflex t, HasLayout t m) => HasLayout t (PotatoReader t m) where
  axis :: forall a.
Dynamic t Orientation
-> Dynamic t Constraint -> PotatoReader t m a -> PotatoReader t m a
axis Dynamic t Orientation
a Dynamic t Constraint
b PotatoReader t m a
c = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \PotatoConfig t
pcfg -> forall {k} (t :: k) (m :: * -> *) a.
HasLayout t m =>
Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
axis Dynamic t Orientation
a Dynamic t Constraint
b (forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoReader t m a
c PotatoConfig t
pcfg)
  region :: Dynamic t Constraint -> PotatoReader t m (Dynamic t Region)
region = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) (m :: * -> *).
HasLayout t m =>
Dynamic t Constraint -> m (Dynamic t Region)
region
  askOrientation :: PotatoReader t m (Dynamic t Orientation)
askOrientation = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (t :: k) (m :: * -> *).
HasLayout t m =>
m (Dynamic t Orientation)
askOrientation

instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (PotatoReader t m) where
  runWithReplace :: forall a b.
PotatoReader t m a
-> Event t (PotatoReader t m b) -> PotatoReader t m (a, Event t b)
runWithReplace (PotatoReader ReaderT (PotatoConfig t) m a
a) Event t (PotatoReader t m b)
e = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace ReaderT (PotatoConfig t) m a
a forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader Event t (PotatoReader t m b)
e
  traverseIntMapWithKeyWithAdjust :: forall v v'.
(Key -> v -> PotatoReader t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> PotatoReader t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Key -> v -> PotatoReader t m v'
f IntMap v
m Event t (PatchIntMap v)
e = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) v v'.
Adjustable t m =>
(Key -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Key
k v
v -> forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader forall a b. (a -> b) -> a -> b
$ Key -> v -> PotatoReader t m v'
f Key
k v
v) IntMap v
m Event t (PatchIntMap v)
e
  traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> PotatoReader t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> PotatoReader t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> PotatoReader t m (v' a)
f DMap k v
m Event t (PatchDMap k v)
e = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k v a
v -> forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader forall a b. (a -> b) -> a -> b
$ forall a. k a -> v a -> PotatoReader t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMap k v)
e
  traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> PotatoReader t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> PotatoReader t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> PotatoReader t m (v' a)
f DMap k v
m Event t (PatchDMapWithMove k v)
e = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k v a
v -> forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader forall a b. (a -> b) -> a -> b
$ forall a. k a -> v a -> PotatoReader t m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMapWithMove k v)
e

instance MonadTrans (PotatoReader t) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> PotatoReader t m a
lift = forall t (m :: * -> *) a.
ReaderT (PotatoConfig t) m a -> PotatoReader t m a
PotatoReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


instance MonadNodeId m => MonadNodeId (PotatoReader t m)


-- | Run a 'FocusReader' action with the given focus value
-- TODO flip arg order to match ReaderT oops...
runPotatoReader
  :: (Reflex t, Monad m)
  => PotatoReader t m a
  -> PotatoConfig t
  -> m a
runPotatoReader :: forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoReader t m a
a PotatoConfig t
b = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PotatoConfig t
b forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a.
PotatoReader t m a -> ReaderT (PotatoConfig t) m a
unPotatoReader PotatoReader t m a
a