{-# 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.Serialization.Snake
import qualified Potato.Flow.Preview as Preview

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 HandlerOutputAction = 
  HOA_Nothing
  | HOA_Pan XY 
  | HOA_Select Bool Selection
  | HOA_Layers LayersState SuperOwlChanges
  | HOA_LayersScroll Int
  | HOA_Preview Preview.Preview 
  deriving (Int -> HandlerOutputAction -> ShowS
[HandlerOutputAction] -> ShowS
HandlerOutputAction -> String
(Int -> HandlerOutputAction -> ShowS)
-> (HandlerOutputAction -> String)
-> ([HandlerOutputAction] -> ShowS)
-> Show HandlerOutputAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HandlerOutputAction -> ShowS
showsPrec :: Int -> HandlerOutputAction -> ShowS
$cshow :: HandlerOutputAction -> String
show :: HandlerOutputAction -> String
$cshowList :: [HandlerOutputAction] -> ShowS
showList :: [HandlerOutputAction] -> ShowS
Show)

handlerOutputAction_isNothing :: HandlerOutputAction -> Bool  
handlerOutputAction_isNothing :: HandlerOutputAction -> Bool
handlerOutputAction_isNothing = \case
  HandlerOutputAction
HOA_Nothing -> Bool
True
  HandlerOutputAction
_ -> Bool
False

handlerOutputAction_isSelect :: HandlerOutputAction -> Bool
handlerOutputAction_isSelect :: HandlerOutputAction -> Bool
handlerOutputAction_isSelect = \case
  HOA_Select Bool
_ Selection
_ -> Bool
True
  HandlerOutputAction
_ -> Bool
False

-- TODO split out into mutually exclusive actions
data PotatoHandlerOutput = PotatoHandlerOutput {
    PotatoHandlerOutput -> Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler             :: Maybe SomePotatoHandler

    , PotatoHandlerOutput -> HandlerOutputAction
_potatoHandlerOutput_action                  :: HandlerOutputAction
  } deriving (Int -> PotatoHandlerOutput -> ShowS
[PotatoHandlerOutput] -> ShowS
PotatoHandlerOutput -> String
(Int -> PotatoHandlerOutput -> ShowS)
-> (PotatoHandlerOutput -> String)
-> ([PotatoHandlerOutput] -> ShowS)
-> Show PotatoHandlerOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PotatoHandlerOutput -> ShowS
showsPrec :: Int -> PotatoHandlerOutput -> ShowS
$cshow :: PotatoHandlerOutput -> String
show :: PotatoHandlerOutput -> String
$cshowList :: [PotatoHandlerOutput] -> ShowS
showList :: [PotatoHandlerOutput] -> ShowS
Show)

instance Default PotatoHandlerOutput where
  def :: PotatoHandlerOutput
def = PotatoHandlerOutput {
      _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = Maybe SomePotatoHandler
forall a. Maybe a
Nothing
      , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = HandlerOutputAction
HOA_Nothing
    }

-- 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
(Int -> LayersHandlerRenderEntrySelectedState -> ShowS)
-> (LayersHandlerRenderEntrySelectedState -> String)
-> ([LayersHandlerRenderEntrySelectedState] -> ShowS)
-> Show LayersHandlerRenderEntrySelectedState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayersHandlerRenderEntrySelectedState -> ShowS
showsPrec :: Int -> LayersHandlerRenderEntrySelectedState -> ShowS
$cshow :: LayersHandlerRenderEntrySelectedState -> String
show :: LayersHandlerRenderEntrySelectedState -> String
$cshowList :: [LayersHandlerRenderEntrySelectedState] -> ShowS
showList :: [LayersHandlerRenderEntrySelectedState] -> ShowS
Show, LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
(LayersHandlerRenderEntrySelectedState
 -> LayersHandlerRenderEntrySelectedState -> Bool)
-> (LayersHandlerRenderEntrySelectedState
    -> LayersHandlerRenderEntrySelectedState -> Bool)
-> Eq LayersHandlerRenderEntrySelectedState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
== :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
$c/= :: LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntrySelectedState -> Bool
/= :: 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
(LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool)
-> (LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool)
-> Eq LayersHandlerRenderEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
== :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
$c/= :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
/= :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry -> Bool
Eq, Int -> LayersHandlerRenderEntry -> ShowS
[LayersHandlerRenderEntry] -> ShowS
LayersHandlerRenderEntry -> String
(Int -> LayersHandlerRenderEntry -> ShowS)
-> (LayersHandlerRenderEntry -> String)
-> ([LayersHandlerRenderEntry] -> ShowS)
-> Show LayersHandlerRenderEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayersHandlerRenderEntry -> ShowS
showsPrec :: Int -> LayersHandlerRenderEntry -> ShowS
$cshow :: LayersHandlerRenderEntry -> String
show :: LayersHandlerRenderEntry -> String
$cshowList :: [LayersHandlerRenderEntry] -> ShowS
showList :: [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
(LayersViewHandlerRenderOutput
 -> LayersViewHandlerRenderOutput -> Bool)
-> (LayersViewHandlerRenderOutput
    -> LayersViewHandlerRenderOutput -> Bool)
-> Eq LayersViewHandlerRenderOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
== :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
$c/= :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
/= :: LayersViewHandlerRenderOutput
-> LayersViewHandlerRenderOutput -> Bool
Eq, Int -> LayersViewHandlerRenderOutput -> ShowS
[LayersViewHandlerRenderOutput] -> ShowS
LayersViewHandlerRenderOutput -> String
(Int -> LayersViewHandlerRenderOutput -> ShowS)
-> (LayersViewHandlerRenderOutput -> String)
-> ([LayersViewHandlerRenderOutput] -> ShowS)
-> Show LayersViewHandlerRenderOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayersViewHandlerRenderOutput -> ShowS
showsPrec :: Int -> LayersViewHandlerRenderOutput -> ShowS
$cshow :: LayersViewHandlerRenderOutput -> String
show :: LayersViewHandlerRenderOutput -> String
$cshowList :: [LayersViewHandlerRenderOutput] -> ShowS
showList :: [LayersViewHandlerRenderOutput] -> ShowS
Show)

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

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

defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle :: LBox -> RenderHandle
defaultRenderHandle LBox
lbox = LBox -> Maybe PChar -> RenderHandleColor -> RenderHandle
RenderHandle LBox
lbox (PChar -> Maybe PChar
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
(HandlerRenderOutput -> HandlerRenderOutput -> Bool)
-> (HandlerRenderOutput -> HandlerRenderOutput -> Bool)
-> Eq HandlerRenderOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
== :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
$c/= :: HandlerRenderOutput -> HandlerRenderOutput -> Bool
/= :: 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 [RenderHandle] -> [RenderHandle] -> [RenderHandle]
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 = [] }

data HandlerActiveState = HAS_Active_Mouse | HAS_Active_Keyboard | HAS_Active_Waiting | HAS_Inactive deriving (Int -> HandlerActiveState -> ShowS
[HandlerActiveState] -> ShowS
HandlerActiveState -> String
(Int -> HandlerActiveState -> ShowS)
-> (HandlerActiveState -> String)
-> ([HandlerActiveState] -> ShowS)
-> Show HandlerActiveState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HandlerActiveState -> ShowS
showsPrec :: Int -> HandlerActiveState -> ShowS
$cshow :: HandlerActiveState -> String
show :: HandlerActiveState -> String
$cshowList :: [HandlerActiveState] -> ShowS
showList :: [HandlerActiveState] -> ShowS
Show, HandlerActiveState -> HandlerActiveState -> Bool
(HandlerActiveState -> HandlerActiveState -> Bool)
-> (HandlerActiveState -> HandlerActiveState -> Bool)
-> Eq HandlerActiveState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandlerActiveState -> HandlerActiveState -> Bool
== :: HandlerActiveState -> HandlerActiveState -> Bool
$c/= :: HandlerActiveState -> HandlerActiveState -> Bool
/= :: HandlerActiveState -> HandlerActiveState -> Bool
Eq)

handlerActiveState_isActive :: HandlerActiveState -> Bool
handlerActiveState_isActive :: HandlerActiveState -> Bool
handlerActiveState_isActive = \case
  HandlerActiveState
HAS_Inactive -> Bool
False
  HandlerActiveState
_ -> Bool
True
  

-- 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 = h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerName h
h Text -> Text -> Text
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
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing

  -- return type of Nothing means input is not captured
  pHandleKeyboard :: h -> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
  pHandleKeyboard h
_ PotatoHandlerInput
_ KeyboardData
_ = Maybe PotatoHandlerOutput
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
_ = Maybe SomePotatoHandler
forall a. Maybe a
Nothing

  
  -- TODO change this to an enum so you can capture different notion of activeness
  -- active manipulators will not be overwritten by new handlers via selection from changes
  pIsHandlerActive :: h -> HandlerActiveState
  pIsHandlerActive h
_ = HandlerActiveState
HAS_Inactive

  pRenderHandler :: h -> PotatoHandlerInput -> HandlerRenderOutput
  pRenderHandler h
_ PotatoHandlerInput
_ = HandlerRenderOutput
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
_ = LayersViewHandlerRenderOutput
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_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..}) = case MouseDragState
_mouseDrag_state of
    MouseDragState
MouseDragState_Cancelled -> Bool
False
    MouseDragState
MouseDragState_Down      -> Bool -> Bool
not (Bool -> Bool)
-> (HandlerActiveState -> Bool) -> HandlerActiveState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerActiveState -> Bool
handlerActiveState_isActive (HandlerActiveState -> Bool) -> HandlerActiveState -> Bool
forall a b. (a -> b) -> a -> b
$ h -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive h
h
    MouseDragState
_                        -> Bool
True

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


  -- whether to commit or cancel the Preview operation when replacing the handler or not
  -- True is commit, False is cancel
  --pCommitOrCancelOnReplace :: h -> Bool
  --pCommitOrCancelOnReplace _ = True

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

instance PotatoHandler SomePotatoHandler where
  pHandlerName :: SomePotatoHandler -> Text
pHandlerName (SomePotatoHandler h
h) = h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerName h
h
  pHandlerDebugShow :: SomePotatoHandler -> Text
pHandlerDebugShow (SomePotatoHandler h
h) = h -> Text
forall h. PotatoHandler h => h -> Text
pHandlerDebugShow h
h
  pHandleMouse :: SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler h
h) = h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse h
h
  pHandleKeyboard :: SomePotatoHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard (SomePotatoHandler h
h) = h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard h
h
  pIsHandlerActive :: SomePotatoHandler -> HandlerActiveState
pIsHandlerActive (SomePotatoHandler h
h) = h -> HandlerActiveState
forall h. PotatoHandler h => h -> HandlerActiveState
pIsHandlerActive h
h
  pRefreshHandler :: SomePotatoHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler (SomePotatoHandler h
h) = h -> PotatoHandlerInput -> Maybe SomePotatoHandler
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler h
h
  pRenderHandler :: SomePotatoHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler (SomePotatoHandler h
h) = h -> PotatoHandlerInput -> HandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler h
h
  pRenderLayersHandler :: SomePotatoHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler (SomePotatoHandler h
h) = h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler h
h
  pValidateMouse :: SomePotatoHandler -> RelMouseDrag -> Bool
pValidateMouse (SomePotatoHandler h
h) = h -> RelMouseDrag -> Bool
forall h. PotatoHandler h => h -> RelMouseDrag -> Bool
pValidateMouse h
h
  pHandlerTool :: SomePotatoHandler -> Maybe Tool
pHandlerTool (SomePotatoHandler h
h) = h -> Maybe Tool
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 = PotatoHandlerOutput
forall a. Default a => a
def {
    _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h
  }

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

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

testHandleMouse :: SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse :: SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
testHandleMouse (SomePotatoHandler h
h) PotatoHandlerInput
phi RelMouseDrag
rmd = h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
  pHandleKeyboard :: EmptyHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard EmptyHandler
_ PotatoHandlerInput
_ KeyboardData
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
  pRenderHandler :: EmptyHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler EmptyHandler
_ PotatoHandlerInput
_ = HandlerRenderOutput
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)
  -- ...
}
--}