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

module Potato.Flow.Controller.Handler where

import           Relude

import           Potato.Flow.BroadPhase
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.OwlLayers
import           Potato.Flow.Controller.Types
import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.Render
import           Potato.Flow.OwlState
import           Potato.Flow.OwlWorkspace
import           Potato.Flow.SElts

import qualified Potato.Data.Text.Zipper          as TZ

import           Data.Default
import qualified Data.IntMap                      as IM
import qualified Data.Sequence                    as Seq
import qualified Data.Text                        as T
import qualified Text.Show

data PotatoHandlerOutput = PotatoHandlerOutput {
    PotatoHandlerOutput -> Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler             :: Maybe SomePotatoHandler
    , PotatoHandlerOutput -> Maybe (Bool, Selection)
_potatoHandlerOutput_select                :: Maybe (Bool, Selection)
    , PotatoHandlerOutput -> Maybe WSEvent
_potatoHandlerOutput_pFEvent               :: Maybe WSEvent
    , PotatoHandlerOutput -> Maybe XY
_potatoHandlerOutput_pan                   :: Maybe XY
    , PotatoHandlerOutput -> Maybe LayersState
_potatoHandlerOutput_layersState           :: Maybe LayersState
    , PotatoHandlerOutput -> SuperOwlChanges
_potatoHandlerOutput_changesFromToggleHide :: SuperOwlChanges
  } deriving (Int -> PotatoHandlerOutput -> ShowS
[PotatoHandlerOutput] -> ShowS
PotatoHandlerOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PotatoHandlerOutput] -> ShowS
$cshowList :: [PotatoHandlerOutput] -> ShowS
show :: PotatoHandlerOutput -> String
$cshow :: PotatoHandlerOutput -> String
showsPrec :: Int -> PotatoHandlerOutput -> ShowS
$cshowsPrec :: Int -> PotatoHandlerOutput -> ShowS
Show)

instance Default PotatoHandlerOutput where
  def :: PotatoHandlerOutput
def = PotatoHandlerOutput {
      _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. Maybe a
Nothing
      , _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. Maybe a
Nothing
      , _potatoHandlerOutput_pan :: Maybe XY
_potatoHandlerOutput_pan = forall a. Maybe a
Nothing
      , _potatoHandlerOutput_select :: Maybe (Bool, Selection)
_potatoHandlerOutput_select = forall a. Maybe a
Nothing
      , _potatoHandlerOutput_layersState :: Maybe LayersState
_potatoHandlerOutput_layersState = forall a. Maybe a
Nothing
      , _potatoHandlerOutput_changesFromToggleHide :: SuperOwlChanges
_potatoHandlerOutput_changesFromToggleHide = forall a. IntMap a
IM.empty
    }

-- TODO replace this with just GoatState
data PotatoHandlerInput = PotatoHandlerInput {
    -- from PFOutput
    PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_pFState                   :: OwlPFState
    , PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
    , PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_broadPhase              :: BroadPhaseState
    , PotatoHandlerInput -> RenderCache
_potatoHandlerInput_renderCache :: RenderCache

    -- from Frontend
    , PotatoHandlerInput -> LayersState
_potatoHandlerInput_layersState             :: LayersState
    , PotatoHandlerInput -> LBox
_potatoHandlerInput_screenRegion            :: LBox


    -- from Backend
    -- basically, handlers are created based on contents of selection, and handlers themselves are expected to use partial methods on selection to get relevant information in order to modify the selection
    -- note that selection is dynamically updated each type a change is made so it always has up to date information during a multi-step manipulate
    -- this is sort of just how it is right now, I wish it weren't so :_(
    , PotatoHandlerInput -> Selection
_potatoHandlerInput_selection               :: Selection
    , PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_canvasSelection         :: CanvasSelection

    -- TODO
    --, _potatoHandlerInput_canvasSelection :: CanvasSelection
    -- superOwlParliament_convertToCanvasSelection
  }

type ColorType = ()
data SimpleBoxHandlerRenderOutput = SimpleBoxHandlerRenderOutput {
    SimpleBoxHandlerRenderOutput -> LBox
_simpleBoxHandlerRenderOutput_box             :: LBox
    , SimpleBoxHandlerRenderOutput -> Maybe PChar
_simpleBoxHandlerRenderOutput_fillText      :: Maybe PChar -- fills the entire box with the same char
    , SimpleBoxHandlerRenderOutput -> ColorType
_simpleBoxHandlerRenderOutput_fillTextColor :: ColorType
    , SimpleBoxHandlerRenderOutput -> ColorType
_simpleBoxHandlerRenderOutput_bgColor       :: ColorType
  }

-- TODO remove renaming and move it into LayersHandlerRenderEntry
data LayersHandlerRenderEntrySelectedState = LHRESS_ChildSelected | LHRESS_Selected | LHRESS_InheritSelected | LHRESS_None deriving (Int -> LayersHandlerRenderEntrySelectedState -> ShowS
[LayersHandlerRenderEntrySelectedState] -> ShowS
LayersHandlerRenderEntrySelectedState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayersHandlerRenderEntrySelectedState] -> ShowS
$cshowList :: [LayersHandlerRenderEntrySelectedState] -> ShowS
show :: LayersHandlerRenderEntrySelectedState -> String
$cshow :: LayersHandlerRenderEntrySelectedState -> String
showsPrec :: Int -> LayersHandlerRenderEntrySelectedState -> ShowS
$cshowsPrec :: Int -> LayersHandlerRenderEntrySelectedState -> ShowS
Show, LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
$c/= :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
== :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
$c== :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
Eq)

{--instance Eq LayersHandlerRenderEntrySelectedState where
  (==) (LHRESS_Renaming x) (LHRESS_Renaming y) = x == y
  (==) LHRESS_Selected LHRESS_Selected = True
  (==) LHRESS_InheritSelected LHRESS_InheritSelected = True
  (==) LHRESS_None LHRESS_None = True
  (==) LHRESS_ChildSelected LHRESS_ChildSelected = True
  (==) _ _ = False--}

-- depth at which dots are added if any
type LayersHandlerRenderEntryDots = Maybe Int
-- are we renaming this one
type LayersHandlerRenderEntryRenaming = Maybe TZ.TextZipper

data LayersHandlerRenderEntry =
  LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState LayersHandlerRenderEntryDots LayersHandlerRenderEntryRenaming LayerEntry
  | LayersHandlerRenderEntryDummy Int
  deriving (LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
$c/= :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
== :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
$c== :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
Eq, Int -> LayersHandlerRenderEntry -> ShowS
[LayersHandlerRenderEntry] -> ShowS
LayersHandlerRenderEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayersHandlerRenderEntry] -> ShowS
$cshowList :: [LayersHandlerRenderEntry] -> ShowS
show :: LayersHandlerRenderEntry -> String
$cshow :: LayersHandlerRenderEntry -> String
showsPrec :: Int -> LayersHandlerRenderEntry -> ShowS
$cshowsPrec :: Int -> LayersHandlerRenderEntry -> ShowS
Show)

layersHandlerRenderEntry_depth :: LayersHandlerRenderEntry -> Int
layersHandlerRenderEntry_depth :: LayersHandlerRenderEntry -> Int
layersHandlerRenderEntry_depth (LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
_ LayersHandlerRenderEntryDots
_ LayersHandlerRenderEntryRenaming
_ LayerEntry
lentry) = LayerEntry -> Int
layerEntry_depth LayerEntry
lentry
layersHandlerRenderEntry_depth (LayersHandlerRenderEntryDummy Int
i) = Int
i

-- hack to render layers view via HandlerRenderOutput (we could have just as well put this in LayerState I guesss)
data LayersViewHandlerRenderOutput = LayersViewHandlerRenderOutput {
    LayersViewHandlerRenderOutput -> Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry
  } deriving (LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
$c/= :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
== :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
$c== :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
Eq, Int -> LayersViewHandlerRenderOutput -> ShowS
[LayersViewHandlerRenderOutput] -> ShowS
LayersViewHandlerRenderOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayersViewHandlerRenderOutput] -> ShowS
$cshowList :: [LayersViewHandlerRenderOutput] -> ShowS
show :: LayersViewHandlerRenderOutput -> String
$cshow :: LayersViewHandlerRenderOutput -> String
showsPrec :: Int -> LayersViewHandlerRenderOutput -> ShowS
$cshowsPrec :: Int -> LayersViewHandlerRenderOutput -> ShowS
Show)

instance Default LayersViewHandlerRenderOutput where
  def :: LayersViewHandlerRenderOutput
def = LayersViewHandlerRenderOutput {
      _layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries = forall a. Seq a
Seq.empty
    }

data RenderHandleColor = RHC_Default | RHC_Attachment | RHC_AttachmentHighlight deriving (Int -> RenderHandleColor -> ShowS
[RenderHandleColor] -> ShowS
RenderHandleColor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderHandleColor] -> ShowS
$cshowList :: [RenderHandleColor] -> ShowS
show :: RenderHandleColor -> String
$cshow :: RenderHandleColor -> String
showsPrec :: Int -> RenderHandleColor -> ShowS
$cshowsPrec :: Int -> RenderHandleColor -> ShowS
Show, RenderHandleColor -> RenderHandleColor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderHandleColor -> RenderHandleColor -> Bool
$c/= :: RenderHandleColor -> RenderHandleColor -> Bool
== :: RenderHandleColor -> RenderHandleColor -> Bool
$c== :: RenderHandleColor -> RenderHandleColor -> Bool
Eq)

-- TODO come up with better name
data RenderHandle = RenderHandle {
    RenderHandle -> LBox
_renderHandle_box     :: LBox
    , RenderHandle -> Maybe PChar
_renderHandle_char  :: Maybe PChar
    , RenderHandle -> RenderHandleColor
_renderHandle_color :: RenderHandleColor
  } deriving (Int -> RenderHandle -> ShowS
[RenderHandle] -> ShowS
RenderHandle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderHandle] -> ShowS
$cshowList :: [RenderHandle] -> ShowS
show :: RenderHandle -> String
$cshow :: RenderHandle -> String
showsPrec :: Int -> RenderHandle -> ShowS
$cshowsPrec :: Int -> RenderHandle -> ShowS
Show, RenderHandle -> RenderHandle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderHandle -> RenderHandle -> Bool
$c/= :: RenderHandle -> RenderHandle -> Bool
== :: RenderHandle -> RenderHandle -> Bool
$c== :: RenderHandle -> RenderHandle -> Bool
Eq)

defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle LBox
lbox = LBox -> Maybe PChar -> RenderHandleColor -> RenderHandle
RenderHandle LBox
lbox (forall a. a -> Maybe a
Just PChar
'X') RenderHandleColor
RHC_Default

-- TODO come up with better name
data HandlerRenderOutput = HandlerRenderOutput {
    HandlerRenderOutput -> [RenderHandle]
_handlerRenderOutput_temp :: [RenderHandle] -- list of coordinates where there are handles
  } deriving (HandlerRenderOutput -> HandlerRenderOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
$c/= :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
== :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
$c== :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
Eq)

instance Semigroup HandlerRenderOutput where
  HandlerRenderOutput
a <> :: HandlerRenderOutput -> HandlerRenderOutput -> HandlerRenderOutput
<> HandlerRenderOutput
b = HandlerRenderOutput {
      _handlerRenderOutput_temp :: [RenderHandle]
_handlerRenderOutput_temp = HandlerRenderOutput -> [RenderHandle]
_handlerRenderOutput_temp HandlerRenderOutput
a forall a. Semigroup a => a -> a -> a
<> HandlerRenderOutput -> [RenderHandle]
_handlerRenderOutput_temp HandlerRenderOutput
b
    }

instance Default HandlerRenderOutput where
  def :: HandlerRenderOutput
def = HandlerRenderOutput
emptyHandlerRenderOutput

emptyHandlerRenderOutput :: HandlerRenderOutput
emptyHandlerRenderOutput :: HandlerRenderOutput
emptyHandlerRenderOutput = HandlerRenderOutput { _handlerRenderOutput_temp :: [RenderHandle]
_handlerRenderOutput_temp = [] }


-- we check handler name for debug reasons so it's useful to have constants
-- there should be no non-test code that depends on comparing pHandlerName
handlerName_box :: Text
handlerName_box :: Text
handlerName_box = Text
"BoxHandler"
handlerName_simpleLine :: Text
handlerName_simpleLine :: Text
handlerName_simpleLine = Text
"AutoLineHandler"
handlerName_simpleLine_endPoint :: Text
handlerName_simpleLine_endPoint :: Text
handlerName_simpleLine_endPoint = Text
"AutoLineEndPointHandler"
handlerName_simpleLine_midPoint :: Text
handlerName_simpleLine_midPoint :: Text
handlerName_simpleLine_midPoint = Text
"AutoLineMidPointHandler"
handlerName_simpleLine_textLabel :: Text
handlerName_simpleLine_textLabel :: Text
handlerName_simpleLine_textLabel = Text
"AutoLineLabelHandler"
handlerName_simpleLine_textLabelMover :: Text
handlerName_simpleLine_textLabelMover :: Text
handlerName_simpleLine_textLabelMover = Text
"AutoLineLabelMoverHandler"
handlerName_layers :: Text
handlerName_layers :: Text
handlerName_layers = Text
"LayersHandler"
handlerName_layersRename :: Text
handlerName_layersRename :: Text
handlerName_layersRename = Text
"LayersRenameHandler"
handlerName_cartesianLine :: Text
handlerName_cartesianLine :: Text
handlerName_cartesianLine = Text
"CartesianLineHandler"
handlerName_boxText :: Text
handlerName_boxText :: Text
handlerName_boxText = Text
"BoxTextHandler"
handlerName_boxLabel :: Text
handlerName_boxLabel :: Text
handlerName_boxLabel = Text
"BoxLabelHandler"
handlerName_textArea :: Text
handlerName_textArea :: Text
handlerName_textArea = Text
"TextAreaHandler"
handlerName_pan :: Text
handlerName_pan :: Text
handlerName_pan = Text
"PanHandler"
handlerName_select :: Text
handlerName_select :: Text
handlerName_select = Text
"SelectHandler"
handlerName_empty :: Text
handlerName_empty :: Text
handlerName_empty = Text
"EmptyHandler"


-- TODO prob replace this with 'data PotatoHandler' rather than typeclass
-- TODO rename methods in here..
-- TODO rename to Manipulator XD
class PotatoHandler h where
  pHandlerName :: h -> Text

  -- TODO do the generic thing where (Show h) whatever (I guess this only works when you use deriving or something though?)
  pHandlerDebugShow :: h -> Text
  pHandlerDebugShow h
h = forall h. PotatoHandler h => h -> Text
pHandlerName h
h forall a. Semigroup a => a -> a -> a
<> Text
" <no debug info>"

  -- TODO consider removing Selection from input args since it should be static through lifetime of handler and therefore passed in during construction
  -- i.e. invariant is selection changed -> new handler

  -- TODO need to add broadphase to args as it's used for finding new selections..
  -- TODO maybe split into handleLayerMouse (MouseDrag) and handleCanvasMouse (RelMosueDrag)?
  -- NOTE, MouseDragState_Cancelled will never be passed into this
  -- return type of Nothing means input is not captured
  pHandleMouse :: h -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
  pHandleMouse h
_ PotatoHandlerInput
_ RelMouseDrag
_ = forall a. Maybe a
Nothing

  -- return type of Nothing means input is not captured
  pHandleKeyboard :: h -> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
  pHandleKeyboard h
_ PotatoHandlerInput
_ KeyboardData
_ = forall a. Maybe a
Nothing

  -- reset handler if an event came in in between (e.g. due to undo, redo)
  -- returns Nothing if the handler no longer exists after refreshing
  --
  -- FOR NOW we expect this to only be called if handler is not active
  -- FOR NOW this is only allowed to return the existing handler
  -- when we have multi-user, this may return actions (to undo some inprogress state I guess?), and may happen when a handler is active
  --
  pRefreshHandler :: h -> PotatoHandlerInput -> Maybe SomePotatoHandler
  pRefreshHandler h
_ PotatoHandlerInput
_ = forall a. Maybe a
Nothing

  -- active manipulators will not be overwritten by new handlers via selection from changes
  pIsHandlerActive :: h -> Bool
  pIsHandlerActive h
_ = Bool
False

  pRenderHandler :: h -> PotatoHandlerInput -> HandlerRenderOutput
  pRenderHandler h
_ PotatoHandlerInput
_ = forall a. Default a => a
def

  -- ad-hoc render function just for layers
  -- note that this renders layers even when there is no drop location to be rendered (which is owned by the LayersHandler)
  -- a bit of a hack but it's easier this way, the other way to do it would have been to put drop location inside of LayersState
  -- layers are different because when rendering drop location, it's not a strict overlay so normal render/handler render (drop location) are combined
  pRenderLayersHandler :: h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
  pRenderLayersHandler h
_ PotatoHandlerInput
_ = forall a. Default a => a
def

  -- helper method used to check that we aren't feeding invalid mouse states
  pValidateMouse :: h -> RelMouseDrag -> Bool
  -- default version that ensures mouse state is valid when handler is active
  pValidateMouse h
h (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..}) = case MouseDragState
_mouseDrag_state of
    MouseDragState
MouseDragState_Cancelled -> Bool
False
    MouseDragState
MouseDragState_Down      -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> Bool
pIsHandlerActive h
h
    MouseDragState
_                        -> Bool
True

  -- determine which selected tool to show
  pHandlerTool :: h -> Maybe Tool
  pHandlerTool h
_ = forall a. Maybe a
Nothing

data SomePotatoHandler = forall h . PotatoHandler h  => SomePotatoHandler h

instance PotatoHandler SomePotatoHandler where
  pHandlerName :: SomePotatoHandler -> Text
pHandlerName (SomePotatoHandler h
h) = forall h. PotatoHandler h => h -> Text
pHandlerName h
h
  pHandlerDebugShow :: SomePotatoHandler -> Text
pHandlerDebugShow (SomePotatoHandler h
h) = forall h. PotatoHandler h => h -> Text
pHandlerDebugShow h
h
  pHandleMouse :: SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler h
h) = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
h
  pHandleKeyboard :: SomePotatoHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard (SomePotatoHandler h
h) = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard h
h
  pIsHandlerActive :: SomePotatoHandler -> Bool
pIsHandlerActive (SomePotatoHandler h
h) = forall h. PotatoHandler h => h -> Bool
pIsHandlerActive h
h
  pRefreshHandler :: SomePotatoHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler (SomePotatoHandler h
h) = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler h
h
  pRenderHandler :: SomePotatoHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (SomePotatoHandler h
h) = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler h
h
  pRenderLayersHandler :: SomePotatoHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler (SomePotatoHandler h
h) = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler h
h
  pValidateMouse :: SomePotatoHandler -> RelMouseDrag -> Bool
pValidateMouse (SomePotatoHandler h
h) = forall h. PotatoHandler h => h -> RelMouseDrag -> Bool
pValidateMouse h
h
  pHandlerTool :: SomePotatoHandler -> Maybe Tool
pHandlerTool (SomePotatoHandler h
h) = forall h. PotatoHandler h => h -> Maybe Tool
pHandlerTool h
h

captureWithNoChange :: (PotatoHandler h) => h -> PotatoHandlerOutput
captureWithNoChange :: forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange h
h = forall a. Default a => a
def {
    _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler h
h
  }

setHandlerOnly :: (PotatoHandler h) => h -> PotatoHandlerOutput
setHandlerOnly :: forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly = forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange

instance Show SomePotatoHandler where
  show :: SomePotatoHandler -> String
show (SomePotatoHandler h
h) = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"SomePotatoHandler " forall a. Semigroup a => a -> a -> a
<> forall h. PotatoHandler h => h -> Text
pHandlerName h
h forall a. Semigroup a => a -> a -> a
<> Text
" active: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (forall h. PotatoHandler h => h -> Bool
pIsHandlerActive h
h)

testHandleMouse :: SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse :: SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse (SomePotatoHandler h
h) PotatoHandlerInput
phi RelMouseDrag
rmd = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
h PotatoHandlerInput
phi RelMouseDrag
rmd


data EmptyHandler = EmptyHandler

instance PotatoHandler EmptyHandler where
  pHandlerName :: EmptyHandler -> Text
pHandlerName EmptyHandler
_ = Text
"EmptyHandler"
  pHandleMouse :: EmptyHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse EmptyHandler
_ PotatoHandlerInput
_ RelMouseDrag
_ = forall a. Maybe a
Nothing
  pHandleKeyboard :: EmptyHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard EmptyHandler
_ PotatoHandlerInput
_ KeyboardData
_ = forall a. Maybe a
Nothing
  pRenderHandler :: EmptyHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler EmptyHandler
_ PotatoHandlerInput
_ = forall a. Default a => a
def
  pValidateMouse :: EmptyHandler -> RelMouseDrag -> Bool
pValidateMouse EmptyHandler
_ RelMouseDrag
_ = Bool
True


{--
-- you can do something like the below to have handlers share some functionality
-- unfortuantely, the design below is not very composable, although maybe this isn't really something that can be composed
data ActiveHandlerState s = ActiveHandlerState {
    _activeHandlerState_isActive :: Bool
    _activeHandlerState_userState :: s
  }

data ActiveHandler s = ActiveHandler {
  _activeHandler_pHandleMouse :: s -> PotatoHandlerInput -> RelMouseDrag -> (Bool, Maybe PotatoHandlerOutput)
  -- ...
}
--}