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

module Potato.Flow.Reflex.GoatWidget (
  GoatWidgetConfig(..)
  , emptyGoatWidgetConfig
  , GoatWidget(..)
  , holdGoatWidget
) where

import           Relude

import           Reflex

import           Potato.Flow.BroadPhase
import           Potato.Flow.Controller.Goat
import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.OwlLayers
import           Potato.Flow.Controller.Types
import           Potato.Flow.Llama
import           Potato.Flow.Math
import           Potato.Flow.OwlState
import           Potato.Flow.OwlWorkspace
import           Potato.Flow.Render
import           Potato.Flow.Types

import           Control.Monad.Fix
import           Data.Default



-- | invariants
-- * TODO mouse input type can only change after a `_lMouseData_isRelease == True`
-- * TODO non-mouse inputs can only happen after a `_lMouseData_isRelease == True` except for cancel
data GoatWidgetConfig t = GoatWidgetConfig {

  -- initialization parameters
  forall t. GoatWidgetConfig t -> (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState     :: (OwlPFState, ControllerMeta)
  , forall t. GoatWidgetConfig t -> Maybe UnicodeWidthFn
_goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn

  -- canvas direct input
  , forall t. GoatWidgetConfig t -> Event t LMouseData
_goatWidgetConfig_mouse          :: Event t LMouseData
  , forall t. GoatWidgetConfig t -> Event t KeyboardData
_goatWidgetConfig_keyboard       :: Event t KeyboardData

  -- other canvas stuff
  , forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_canvasRegionDim     :: Event t XY

  -- command based
  , forall t. GoatWidgetConfig t -> Event t Tool
_goatWidgetConfig_selectTool     :: Event t Tool
  , forall t. GoatWidgetConfig t -> Event t EverythingLoadState
_goatWidgetConfig_load           :: Event t EverythingLoadState
  -- only intended for setting params
  , forall t. GoatWidgetConfig t -> Event t Llama
_goatWidgetConfig_paramsEvent    :: Event t Llama
  , forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_canvasSize     :: Event t XY
  , forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_newFolder :: Event t ()

  -- command based (via new endo style)
  , forall t. GoatWidgetConfig t -> Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
  , forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_markSaved :: Event t ()
  , forall t. GoatWidgetConfig t -> Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea


  -- debugging
  , forall t. GoatWidgetConfig t -> Event t Text
_goatWidgetConfig_setDebugLabel  :: Event t Text
  , forall t. GoatWidgetConfig t -> Event t WSEvent
_goatWidgetConfig_bypassEvent :: Event t WSEvent
}

emptyGoatWidgetConfig :: (Reflex t) => GoatWidgetConfig t
emptyGoatWidgetConfig :: forall t. Reflex t => GoatWidgetConfig t
emptyGoatWidgetConfig = GoatWidgetConfig {
    _goatWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState = (OwlPFState
emptyOwlPFState, ControllerMeta
emptyControllerMeta)
    , _goatWidgetConfig_selectTool :: Event t Tool
_goatWidgetConfig_selectTool  = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_load :: Event t EverythingLoadState
_goatWidgetConfig_load = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_mouse :: Event t LMouseData
_goatWidgetConfig_mouse     = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_keyboard :: Event t KeyboardData
_goatWidgetConfig_keyboard = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_paramsEvent :: Event t Llama
_goatWidgetConfig_paramsEvent = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn
_goatWidgetConfig_unicodeWidthFn = forall a. Maybe a
Nothing
    , _goatWidgetConfig_canvasRegionDim :: Event t XY
_goatWidgetConfig_canvasRegionDim = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_canvasSize :: Event t XY
_goatWidgetConfig_canvasSize = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_newFolder :: Event t ()
_goatWidgetConfig_newFolder = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_markSaved :: Event t ()
_goatWidgetConfig_markSaved = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_setDebugLabel :: Event t Text
_goatWidgetConfig_setDebugLabel = forall {k} (t :: k) a. Reflex t => Event t a
never
    , _goatWidgetConfig_bypassEvent :: Event t WSEvent
_goatWidgetConfig_bypassEvent = forall {k} (t :: k) a. Reflex t => Event t a
never
  }


data GoatWidget t = GoatWidget {
  forall t. GoatWidget t -> Dynamic t Tool
_goatWidget_tool                  :: Dynamic t Tool


  , forall t. GoatWidget t -> Dynamic t Selection
_goatWidget_selection           :: Dynamic t Selection
  , forall t. GoatWidget t -> Dynamic t PotatoDefaultParameters
_goatWidget_potatoDefaultParameters :: Dynamic t PotatoDefaultParameters

  , forall t. GoatWidget t -> Dynamic t LayersState
_goatWidget_layers              :: Dynamic t LayersState -- do I even need this?

  , forall t. GoatWidget t -> Dynamic t XY
_goatWidget_pan                 :: Dynamic t XY
  , forall t. GoatWidget t -> Dynamic t BroadPhaseState
_goatWidget_broadPhase          :: Dynamic t BroadPhaseState
  , forall t. GoatWidget t -> Dynamic t HandlerRenderOutput
_goatWidget_handlerRenderOutput :: Dynamic t HandlerRenderOutput
  , forall t. GoatWidget t -> Dynamic t LayersViewHandlerRenderOutput
_goatWidget_layersHandlerRenderOutput :: Dynamic t LayersViewHandlerRenderOutput
  , forall t. GoatWidget t -> Dynamic t SCanvas
_goatWidget_canvas              :: Dynamic t SCanvas -- TODO DELETE just use OwlPFState
  , forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedCanvas      :: Dynamic t RenderedCanvasRegion
  , forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedSelection      :: Dynamic t RenderedCanvasRegion
  , forall t. GoatWidget t -> Dynamic t Bool
_goatWidget_unsavedChanges     :: Dynamic t Bool

  -- TODO this is no longer debug (or maybe expose just OwlPFState part)
  -- debug stuff prob
  , forall t. GoatWidget t -> Dynamic t GoatState
_goatWidget_DEBUG_goatState     :: Dynamic t GoatState
}

foldGoatCmdSetDefaultParams :: SetPotatoDefaultParameters -> GoatState -> GoatState
foldGoatCmdSetDefaultParams :: SetPotatoDefaultParameters -> GoatState -> GoatState
foldGoatCmdSetDefaultParams SetPotatoDefaultParameters
spdp GoatState
gs = GoatState
gs {
    _goatState_potatoDefaultParameters :: PotatoDefaultParameters
_goatState_potatoDefaultParameters = PotatoDefaultParameters
-> SetPotatoDefaultParameters -> PotatoDefaultParameters
potatoDefaultParameters_set (GoatState -> PotatoDefaultParameters
_goatState_potatoDefaultParameters GoatState
gs) SetPotatoDefaultParameters
spdp
  }

foldGoatCmdMarkSaved :: () -> GoatState -> GoatState
foldGoatCmdMarkSaved :: () -> GoatState -> GoatState
foldGoatCmdMarkSaved ()
_ GoatState
gs = GoatState
gs {
    _goatState_workspace :: OwlPFWorkspace
_goatState_workspace = OwlPFWorkspace -> OwlPFWorkspace
markWorkspaceSaved (GoatState -> OwlPFWorkspace
_goatState_workspace GoatState
gs)
  }


holdGoatWidget :: forall t m. (Adjustable t m, MonadHold t m, MonadFix m)
  => GoatWidgetConfig t
  -> m (GoatWidget t)
holdGoatWidget :: forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m) =>
GoatWidgetConfig t -> m (GoatWidget t)
holdGoatWidget GoatWidgetConfig {Maybe UnicodeWidthFn
(OwlPFState, ControllerMeta)
Event t ()
Event t EverythingLoadState
Event t Text
Event t XY
Event t SetPotatoDefaultParameters
Event t Tool
Event t Llama
Event t WSEvent
Event t LMouseData
Event t KeyboardData
Event t GoatFocusedArea
_goatWidgetConfig_bypassEvent :: Event t WSEvent
_goatWidgetConfig_setDebugLabel :: Event t Text
_goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea
_goatWidgetConfig_markSaved :: Event t ()
_goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
_goatWidgetConfig_newFolder :: Event t ()
_goatWidgetConfig_canvasSize :: Event t XY
_goatWidgetConfig_paramsEvent :: Event t Llama
_goatWidgetConfig_load :: Event t EverythingLoadState
_goatWidgetConfig_selectTool :: Event t Tool
_goatWidgetConfig_canvasRegionDim :: Event t XY
_goatWidgetConfig_keyboard :: Event t KeyboardData
_goatWidgetConfig_mouse :: Event t LMouseData
_goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn
_goatWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_goatWidgetConfig_bypassEvent :: forall t. GoatWidgetConfig t -> Event t WSEvent
_goatWidgetConfig_setDebugLabel :: forall t. GoatWidgetConfig t -> Event t Text
_goatWidgetConfig_setFocusedArea :: forall t. GoatWidgetConfig t -> Event t GoatFocusedArea
_goatWidgetConfig_markSaved :: forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_setPotatoDefaultParameters :: forall t. GoatWidgetConfig t -> Event t SetPotatoDefaultParameters
_goatWidgetConfig_newFolder :: forall t. GoatWidgetConfig t -> Event t ()
_goatWidgetConfig_canvasSize :: forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_paramsEvent :: forall t. GoatWidgetConfig t -> Event t Llama
_goatWidgetConfig_load :: forall t. GoatWidgetConfig t -> Event t EverythingLoadState
_goatWidgetConfig_selectTool :: forall t. GoatWidgetConfig t -> Event t Tool
_goatWidgetConfig_canvasRegionDim :: forall t. GoatWidgetConfig t -> Event t XY
_goatWidgetConfig_keyboard :: forall t. GoatWidgetConfig t -> Event t KeyboardData
_goatWidgetConfig_mouse :: forall t. GoatWidgetConfig t -> Event t LMouseData
_goatWidgetConfig_unicodeWidthFn :: forall t. GoatWidgetConfig t -> Maybe UnicodeWidthFn
_goatWidgetConfig_initialState :: forall t. GoatWidgetConfig t -> (OwlPFState, ControllerMeta)
..} = mdo

  let
    initialscreensize :: XY
initialscreensize = XY
0 -- we can't know this at initialization time without causing an infinite loop so it is expected that the app sends this information immediately after initializing (i.e. during postBuild)
    initialgoat :: GoatState
initialgoat = XY -> (OwlPFState, ControllerMeta) -> GoatState
makeGoatState XY
initialscreensize (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState

    -- old command style
    goatEvent :: [Event t GoatCmd]
goatEvent = [
        Tool -> GoatCmd
GoatCmdTool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Tool
_goatWidgetConfig_selectTool
        , EverythingLoadState -> GoatCmd
GoatCmdLoad forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t EverythingLoadState
_goatWidgetConfig_load
        , LMouseData -> GoatCmd
GoatCmdMouse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t LMouseData
_goatWidgetConfig_mouse
        , KeyboardData -> GoatCmd
GoatCmdKeyboard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t KeyboardData
_goatWidgetConfig_keyboard
        , Text -> GoatCmd
GoatCmdSetDebugLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Text
_goatWidgetConfig_setDebugLabel
        , Text -> GoatCmd
GoatCmdNewFolder Text
"folder" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
_goatWidgetConfig_newFolder
        , forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t WSEvent
_goatWidgetConfig_bypassEvent WSEvent -> GoatCmd
GoatCmdWSEvent
        , forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t XY
_goatWidgetConfig_canvasRegionDim XY -> GoatCmd
GoatCmdSetCanvasRegionDim

        -- these two need to be run before _goatWidgetConfig_mouse because sometimes we want to set params/change focus and input a mouse at the same time (i.e. clicking away from params widget to canvas widget causing params to send an update)
        , forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Llama
_goatWidgetConfig_paramsEvent forall a b. (a -> b) -> a -> b
$ \Llama
llama -> (WSEvent -> GoatCmd
GoatCmdWSEvent ((Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
False, Llama
llama)))
        , forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t XY
_goatWidgetConfig_canvasSize forall a b. (a -> b) -> a -> b
$ \XY
xy -> WSEvent -> GoatCmd
GoatCmdWSEvent (DeltaLBox -> WSEvent
WSEResizeCanvas (XY -> XY -> DeltaLBox
DeltaLBox XY
0 XY
xy))
        , forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea forall a b. (a -> b) -> a -> b
$ \GoatFocusedArea
fa -> GoatFocusedArea -> GoatCmd
GoatCmdSetFocusedArea GoatFocusedArea
fa
      ]

    -- TODO split up foldGoatFn to be endo style
    goatEndoEvent :: [Event t (GoatState -> GoatState)]
goatEndoEvent = GoatCmd -> GoatState -> GoatState
foldGoatFn forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> [Event t GoatCmd]
goatEvent

    -- new Endo folding
    setDefaultParamsEndoEvent :: Event t (GoatState -> GoatState)
setDefaultParamsEndoEvent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SetPotatoDefaultParameters -> GoatState -> GoatState
foldGoatCmdSetDefaultParams Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters
    markSavedEvent :: Event t (GoatState -> GoatState)
markSavedEvent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> GoatState -> GoatState
foldGoatCmdMarkSaved Event t ()
_goatWidgetConfig_markSaved

  -- DELETE
  --goatDyn' :: Dynamic t GoatState <- foldDyn foldGoatFn initialgoat goatEvent

  Dynamic t GoatState
goatDyn' :: Dynamic t GoatState
    <- 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 forall a b. (a -> b) -> a -> b
($) GoatState
initialgoat forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([Event t (GoatState -> GoatState)
setDefaultParamsEndoEvent, Event t (GoatState -> GoatState)
markSavedEvent] forall a. Semigroup a => a -> a -> a
<> [Event t (GoatState -> GoatState)]
goatEndoEvent)

  -- reduces # of calls to foldGoatFn to 2 :\
  let goatDyn :: Dynamic t GoatState
goatDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> a
id Dynamic t GoatState
goatDyn'

  -- TODO make sure holdUniqDyn actually does what you think it does
  -- I think it does, but it will prob still do full equality check after changes in goatDyn :(
  -- TODO maybe you need to have special signals to control firing of each sub event instead
  -- I guess the good news is that you can still do this without changing the interface
  -- i.e. OwlPFStateChangeFlag and have each OwlPFState operation return a change flag as well
  Dynamic t Tool
r_tool <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> Tool
goatState_selectedTool Dynamic t GoatState
goatDyn
  Dynamic t Selection
r_selection <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> Selection
_goatState_selection Dynamic t GoatState
goatDyn
  Dynamic t PotatoDefaultParameters
r_potatoDefaultParams <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> PotatoDefaultParameters
_goatState_potatoDefaultParameters Dynamic t GoatState
goatDyn
  Dynamic t BroadPhaseState
r_broadphase <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> BroadPhaseState
_goatState_broadPhaseState Dynamic t GoatState
goatDyn
  Dynamic t XY
r_pan <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> XY
_goatState_pan Dynamic t GoatState
goatDyn
  Dynamic t LayersState
r_layers <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> LayersState
_goatState_layersState Dynamic t GoatState
goatDyn
  -- TODO flip order of render and holdUniqDyn
  Dynamic t HandlerRenderOutput
r_handlerRenderOutput <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GoatState
gs -> forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (GoatState -> SomePotatoHandler
_goatState_handler GoatState
gs) (GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
gs)) Dynamic t GoatState
goatDyn
  Dynamic t LayersViewHandlerRenderOutput
r_layersHandlerRenderOutput <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GoatState
gs -> forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler (GoatState -> SomePotatoHandler
_goatState_layersHandler GoatState
gs) (GoatState -> PotatoHandlerInput
potatoHandlerInputFromGoatState GoatState
gs)) Dynamic t GoatState
goatDyn
  Dynamic t SCanvas
r_canvas <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlPFState -> SCanvas
_owlPFState_canvas forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFWorkspace
_goatState_workspace) Dynamic t GoatState
goatDyn
  Dynamic t Bool
r_unsavedChanges <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GoatState -> Bool
goatState_hasUnsavedChanges) Dynamic t GoatState
goatDyn

  {- this causes 4 calls to foldGoatFn per tick :(
  let
    r_selection = fmap _goatState_selection goatDyn
    r_selection_converted = fmap (\gs -> superOwlParliament_convertToCanvasSelection (_owlPFState_owlTree . _owlPFWorkspace_owlPFState . _goatState_workspace $ gs) (const True) (_goatState_selection gs)) goatDyn
    r_broadphase = fmap _goatState_broadPhaseState goatDyn
    r_pan = fmap _goatState_pan goatDyn
    r_layers = fmap _goatState_layersState goatDyn
    -- TODO flip order of render and holdUniqDyn
    r_handlerRenderOutput = fmap (\gs -> pRenderHandler (_goatState_handler gs) (potatoHandlerInputFromGoatState gs)) goatDyn
    r_layersHandlerRenderOutput = fmap (\gs -> pRenderLayersHandler (_goatState_layersHandler gs) (potatoHandlerInputFromGoatState gs)) goatDyn
    r_canvas = fmap (_owlPFState_canvas . _owlPFWorkspace_owlPFState . _goatState_workspace) goatDyn
  -}

  let
    --why is this not holdUniqDyn? Is this why I'm getting extra ticks?
    r_renderedCanvas :: Dynamic t RenderedCanvasRegion
r_renderedCanvas = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> RenderedCanvasRegion
_goatState_renderedCanvas Dynamic t GoatState
goatDyn
    r_renderedSelection :: Dynamic t RenderedCanvasRegion
r_renderedSelection = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> RenderedCanvasRegion
_goatState_renderedSelection Dynamic t GoatState
goatDyn

  forall (m :: * -> *) a. Monad m => a -> m a
return GoatWidget
    {
      _goatWidget_tool :: Dynamic t Tool
_goatWidget_tool           = Dynamic t Tool
r_tool
      , _goatWidget_selection :: Dynamic t Selection
_goatWidget_selection    = Dynamic t Selection
r_selection
      , _goatWidget_potatoDefaultParameters :: Dynamic t PotatoDefaultParameters
_goatWidget_potatoDefaultParameters = Dynamic t PotatoDefaultParameters
r_potatoDefaultParams
      , _goatWidget_layers :: Dynamic t LayersState
_goatWidget_layers       = Dynamic t LayersState
r_layers
      , _goatWidget_pan :: Dynamic t XY
_goatWidget_pan          = Dynamic t XY
r_pan
      , _goatWidget_broadPhase :: Dynamic t BroadPhaseState
_goatWidget_broadPhase   = Dynamic t BroadPhaseState
r_broadphase
      , _goatWidget_canvas :: Dynamic t SCanvas
_goatWidget_canvas = Dynamic t SCanvas
r_canvas
      , _goatWidget_renderedCanvas :: Dynamic t RenderedCanvasRegion
_goatWidget_renderedCanvas = Dynamic t RenderedCanvasRegion
r_renderedCanvas
      , _goatWidget_renderedSelection :: Dynamic t RenderedCanvasRegion
_goatWidget_renderedSelection = Dynamic t RenderedCanvasRegion
r_renderedSelection
      , _goatWidget_handlerRenderOutput :: Dynamic t HandlerRenderOutput
_goatWidget_handlerRenderOutput =  Dynamic t HandlerRenderOutput
r_handlerRenderOutput
      , _goatWidget_layersHandlerRenderOutput :: Dynamic t LayersViewHandlerRenderOutput
_goatWidget_layersHandlerRenderOutput = Dynamic t LayersViewHandlerRenderOutput
r_layersHandlerRenderOutput
      , _goatWidget_unsavedChanges :: Dynamic t Bool
_goatWidget_unsavedChanges = Dynamic t Bool
r_unsavedChanges
      , _goatWidget_DEBUG_goatState :: Dynamic t GoatState
_goatWidget_DEBUG_goatState = Dynamic t GoatState
goatDyn
    }