{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Types (
  UnicodeWidthFn(..)
  , Tool(..)
  , tool_isCreate
  , PotatoDefaultParameters(..)
  , SetPotatoDefaultParameters(..)
  , potatoDefaultParameters_set
  , Selection
  , defaultFolderCollapseState
  , LayerMeta(..)
  , LayerMetaMap
  , layerMetaMap_isCollapsed
  , ControllerMeta(..)
  , emptyControllerMeta
  , EverythingLoadState
) where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.Serialization.Snake
import           Potato.Flow.Types

import           Data.Aeson
import           Data.Binary
import           Data.Default
import qualified Data.IntMap       as IM
import qualified Text.Show



-- someday it would be nice to support graphene clusters and RTL 😭
data UnicodeWidthFn = UnicodeWidthFn {
    UnicodeWidthFn -> PChar -> Int
unicodeWidth_wcwidth :: PChar -> Int
  }


-- TODO remove Tool_TextArea
-- TOOL
data Tool = Tool_Select | Tool_Pan | Tool_Box | Tool_Line | Tool_Text | Tool_TextArea deriving (Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
/= :: Tool -> Tool -> Bool
Eq, Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
(Int -> Tool -> ShowS)
-> (Tool -> String) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tool -> ShowS
showsPrec :: Int -> Tool -> ShowS
$cshow :: Tool -> String
show :: Tool -> String
$cshowList :: [Tool] -> ShowS
showList :: [Tool] -> ShowS
Show, Int -> Tool
Tool -> Int
Tool -> [Tool]
Tool -> Tool
Tool -> Tool -> [Tool]
Tool -> Tool -> Tool -> [Tool]
(Tool -> Tool)
-> (Tool -> Tool)
-> (Int -> Tool)
-> (Tool -> Int)
-> (Tool -> [Tool])
-> (Tool -> Tool -> [Tool])
-> (Tool -> Tool -> [Tool])
-> (Tool -> Tool -> Tool -> [Tool])
-> Enum Tool
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Tool -> Tool
succ :: Tool -> Tool
$cpred :: Tool -> Tool
pred :: Tool -> Tool
$ctoEnum :: Int -> Tool
toEnum :: Int -> Tool
$cfromEnum :: Tool -> Int
fromEnum :: Tool -> Int
$cenumFrom :: Tool -> [Tool]
enumFrom :: Tool -> [Tool]
$cenumFromThen :: Tool -> Tool -> [Tool]
enumFromThen :: Tool -> Tool -> [Tool]
$cenumFromTo :: Tool -> Tool -> [Tool]
enumFromTo :: Tool -> Tool -> [Tool]
$cenumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
enumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
Enum)

tool_isCreate :: Tool -> Bool
tool_isCreate :: Tool -> Bool
tool_isCreate = \case
  Tool
Tool_Select -> Bool
False
  Tool
Tool_Pan -> Bool
False
  Tool
_ -> Bool
True

data PotatoDefaultParameters = PotatoDefaultParameters {
  PotatoDefaultParameters -> SBoxType
_potatoDefaultParameters_sBoxType              :: SBoxType -- currently not used as we have Tool_TextArea, consider using this instead
  , PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle          :: SuperStyle
  , PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle           :: LineStyle
  , PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyleEnd        :: LineStyle
  , PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_label_textAlign :: TextAlign
  , PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_text_textAlign  :: TextAlign
} deriving (PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
(PotatoDefaultParameters -> PotatoDefaultParameters -> Bool)
-> (PotatoDefaultParameters -> PotatoDefaultParameters -> Bool)
-> Eq PotatoDefaultParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
== :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
$c/= :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
/= :: PotatoDefaultParameters -> PotatoDefaultParameters -> Bool
Eq, Int -> PotatoDefaultParameters -> ShowS
[PotatoDefaultParameters] -> ShowS
PotatoDefaultParameters -> String
(Int -> PotatoDefaultParameters -> ShowS)
-> (PotatoDefaultParameters -> String)
-> ([PotatoDefaultParameters] -> ShowS)
-> Show PotatoDefaultParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PotatoDefaultParameters -> ShowS
showsPrec :: Int -> PotatoDefaultParameters -> ShowS
$cshow :: PotatoDefaultParameters -> String
show :: PotatoDefaultParameters -> String
$cshowList :: [PotatoDefaultParameters] -> ShowS
showList :: [PotatoDefaultParameters] -> ShowS
Show)


instance Default PotatoDefaultParameters where
  def :: PotatoDefaultParameters
def = PotatoDefaultParameters {
      _potatoDefaultParameters_sBoxType :: SBoxType
_potatoDefaultParameters_sBoxType = SBoxType
forall a. Default a => a
def
      , _potatoDefaultParameters_lineStyle :: LineStyle
_potatoDefaultParameters_lineStyle = LineStyle
forall a. Default a => a
def
      , _potatoDefaultParameters_lineStyleEnd :: LineStyle
_potatoDefaultParameters_lineStyleEnd = LineStyle
forall a. Default a => a
def
      , _potatoDefaultParameters_superStyle :: SuperStyle
_potatoDefaultParameters_superStyle = SuperStyle
forall a. Default a => a
def
      , _potatoDefaultParameters_box_label_textAlign :: TextAlign
_potatoDefaultParameters_box_label_textAlign = TextAlign
forall a. Default a => a
def
      , _potatoDefaultParameters_box_text_textAlign :: TextAlign
_potatoDefaultParameters_box_text_textAlign = TextAlign
forall a. Default a => a
def
    }

-- TODO rename to SetPotatoDefaultStyleParameters or something like that
data SetPotatoDefaultParameters = SetPotatoDefaultParameters {
  SetPotatoDefaultParameters -> Maybe SBoxType
_setPotatoDefaultParameters_sBoxType              :: Maybe SBoxType
  , SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyle           :: Maybe LineStyle
  , SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd        :: Maybe LineStyle
  , SetPotatoDefaultParameters -> Maybe SuperStyle
_setPotatoDefaultParameters_superStyle          :: Maybe SuperStyle
  , SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign
  , SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign  :: Maybe TextAlign
} deriving (SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
(SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool)
-> (SetPotatoDefaultParameters
    -> SetPotatoDefaultParameters -> Bool)
-> Eq SetPotatoDefaultParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
== :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
$c/= :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
/= :: SetPotatoDefaultParameters -> SetPotatoDefaultParameters -> Bool
Eq, Int -> SetPotatoDefaultParameters -> ShowS
[SetPotatoDefaultParameters] -> ShowS
SetPotatoDefaultParameters -> String
(Int -> SetPotatoDefaultParameters -> ShowS)
-> (SetPotatoDefaultParameters -> String)
-> ([SetPotatoDefaultParameters] -> ShowS)
-> Show SetPotatoDefaultParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetPotatoDefaultParameters -> ShowS
showsPrec :: Int -> SetPotatoDefaultParameters -> ShowS
$cshow :: SetPotatoDefaultParameters -> String
show :: SetPotatoDefaultParameters -> String
$cshowList :: [SetPotatoDefaultParameters] -> ShowS
showList :: [SetPotatoDefaultParameters] -> ShowS
Show)

instance Default SetPotatoDefaultParameters where
  def :: SetPotatoDefaultParameters
def = SetPotatoDefaultParameters {
      _setPotatoDefaultParameters_sBoxType :: Maybe SBoxType
_setPotatoDefaultParameters_sBoxType = Maybe SBoxType
forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_lineStyle :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyle = Maybe LineStyle
forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd = Maybe LineStyle
forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_superStyle :: Maybe SuperStyle
_setPotatoDefaultParameters_superStyle = Maybe SuperStyle
forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign = Maybe TextAlign
forall a. Maybe a
Nothing
      , _setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign = Maybe TextAlign
forall a. Maybe a
Nothing
    }

potatoDefaultParameters_set :: PotatoDefaultParameters -> SetPotatoDefaultParameters -> PotatoDefaultParameters
potatoDefaultParameters_set :: PotatoDefaultParameters
-> SetPotatoDefaultParameters -> PotatoDefaultParameters
potatoDefaultParameters_set PotatoDefaultParameters {LineStyle
SBoxType
TextAlign
SuperStyle
_potatoDefaultParameters_sBoxType :: PotatoDefaultParameters -> SBoxType
_potatoDefaultParameters_superStyle :: PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_lineStyle :: PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyleEnd :: PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_box_label_textAlign :: PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_text_textAlign :: PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_sBoxType :: SBoxType
_potatoDefaultParameters_superStyle :: SuperStyle
_potatoDefaultParameters_lineStyle :: LineStyle
_potatoDefaultParameters_lineStyleEnd :: LineStyle
_potatoDefaultParameters_box_label_textAlign :: TextAlign
_potatoDefaultParameters_box_text_textAlign :: TextAlign
..} SetPotatoDefaultParameters {Maybe LineStyle
Maybe SBoxType
Maybe TextAlign
Maybe SuperStyle
_setPotatoDefaultParameters_sBoxType :: SetPotatoDefaultParameters -> Maybe SBoxType
_setPotatoDefaultParameters_lineStyle :: SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd :: SetPotatoDefaultParameters -> Maybe LineStyle
_setPotatoDefaultParameters_superStyle :: SetPotatoDefaultParameters -> Maybe SuperStyle
_setPotatoDefaultParameters_box_label_textAlign :: SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign :: SetPotatoDefaultParameters -> Maybe TextAlign
_setPotatoDefaultParameters_sBoxType :: Maybe SBoxType
_setPotatoDefaultParameters_lineStyle :: Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle
_setPotatoDefaultParameters_superStyle :: Maybe SuperStyle
_setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign
..} = PotatoDefaultParameters {
    _potatoDefaultParameters_sBoxType :: SBoxType
_potatoDefaultParameters_sBoxType = SBoxType -> Maybe SBoxType -> SBoxType
forall a. a -> Maybe a -> a
fromMaybe SBoxType
_potatoDefaultParameters_sBoxType Maybe SBoxType
_setPotatoDefaultParameters_sBoxType
    , _potatoDefaultParameters_lineStyle :: LineStyle
_potatoDefaultParameters_lineStyle = LineStyle -> Maybe LineStyle -> LineStyle
forall a. a -> Maybe a -> a
fromMaybe LineStyle
_potatoDefaultParameters_lineStyle Maybe LineStyle
_setPotatoDefaultParameters_lineStyle
    , _potatoDefaultParameters_lineStyleEnd :: LineStyle
_potatoDefaultParameters_lineStyleEnd = LineStyle -> Maybe LineStyle -> LineStyle
forall a. a -> Maybe a -> a
fromMaybe LineStyle
_potatoDefaultParameters_lineStyleEnd Maybe LineStyle
_setPotatoDefaultParameters_lineStyleEnd
    , _potatoDefaultParameters_superStyle :: SuperStyle
_potatoDefaultParameters_superStyle = SuperStyle -> Maybe SuperStyle -> SuperStyle
forall a. a -> Maybe a -> a
fromMaybe SuperStyle
_potatoDefaultParameters_superStyle Maybe SuperStyle
_setPotatoDefaultParameters_superStyle
    , _potatoDefaultParameters_box_label_textAlign :: TextAlign
_potatoDefaultParameters_box_label_textAlign = TextAlign -> Maybe TextAlign -> TextAlign
forall a. a -> Maybe a -> a
fromMaybe TextAlign
_potatoDefaultParameters_box_label_textAlign Maybe TextAlign
_setPotatoDefaultParameters_box_label_textAlign
    , _potatoDefaultParameters_box_text_textAlign :: TextAlign
_potatoDefaultParameters_box_text_textAlign = TextAlign -> Maybe TextAlign -> TextAlign
forall a. a -> Maybe a -> a
fromMaybe TextAlign
_potatoDefaultParameters_box_text_textAlign Maybe TextAlign
_setPotatoDefaultParameters_box_text_textAlign

  }

type Selection = SuperOwlParliament

data LayerMeta = LayerMeta {
  -- if False, these will inherit from parent
  LayerMeta -> Bool
_layerMeta_isLocked      :: Bool
  , LayerMeta -> Bool
_layerMeta_isHidden    :: Bool
  , LayerMeta -> Bool
_layerMeta_isCollapsed :: Bool

} deriving (LayerMeta -> LayerMeta -> Bool
(LayerMeta -> LayerMeta -> Bool)
-> (LayerMeta -> LayerMeta -> Bool) -> Eq LayerMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayerMeta -> LayerMeta -> Bool
== :: LayerMeta -> LayerMeta -> Bool
$c/= :: LayerMeta -> LayerMeta -> Bool
/= :: LayerMeta -> LayerMeta -> Bool
Eq, (forall x. LayerMeta -> Rep LayerMeta x)
-> (forall x. Rep LayerMeta x -> LayerMeta) -> Generic LayerMeta
forall x. Rep LayerMeta x -> LayerMeta
forall x. LayerMeta -> Rep LayerMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LayerMeta -> Rep LayerMeta x
from :: forall x. LayerMeta -> Rep LayerMeta x
$cto :: forall x. Rep LayerMeta x -> LayerMeta
to :: forall x. Rep LayerMeta x -> LayerMeta
Generic)

instance Show LayerMeta where
  show :: LayerMeta -> String
show LayerMeta {Bool
_layerMeta_isLocked :: LayerMeta -> Bool
_layerMeta_isHidden :: LayerMeta -> Bool
_layerMeta_isCollapsed :: LayerMeta -> Bool
_layerMeta_isLocked :: Bool
_layerMeta_isHidden :: Bool
_layerMeta_isCollapsed :: Bool
..} = String
"LayerMeta (l,h,c): " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall b a. (Show a, IsString b) => a -> b
show Bool
_layerMeta_isLocked String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall b a. (Show a, IsString b) => a -> b
show Bool
_layerMeta_isHidden String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall b a. (Show a, IsString b) => a -> b
show Bool
_layerMeta_isCollapsed

instance FromJSON LayerMeta
instance ToJSON LayerMeta
instance NFData LayerMeta
instance Binary LayerMeta


-- Not sure which way I want to do it, so make it configurable for now.
defaultFolderCollapseState :: Bool
defaultFolderCollapseState :: Bool
defaultFolderCollapseState = Bool
False

instance Default LayerMeta where
  def :: LayerMeta
def = LayerMeta {
      _layerMeta_isLocked :: Bool
_layerMeta_isLocked = Bool
False
      , _layerMeta_isHidden :: Bool
_layerMeta_isHidden = Bool
False
      , _layerMeta_isCollapsed :: Bool
_layerMeta_isCollapsed = Bool
defaultFolderCollapseState
    }

type LayerMetaMap = REltIdMap LayerMeta

layerMetaMap_isCollapsed :: REltId -> LayerMetaMap -> Bool
layerMetaMap_isCollapsed :: Int -> LayerMetaMap -> Bool
layerMetaMap_isCollapsed Int
rid LayerMetaMap
lmm = case Int -> LayerMetaMap -> Maybe LayerMeta
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid LayerMetaMap
lmm of
  Maybe LayerMeta
Nothing -> Bool
True
  Just LayerMeta
lm -> LayerMeta -> Bool
_layerMeta_isCollapsed LayerMeta
lm

{-
-- these aren't very useful because they won't tell you if it has inherited lock/hidden state
layerMetaMap_isHidden :: REltId -> LayerMetaMap -> Bool
layerMetaMap_isHidden rid lmm = case IM.lookup rid lmm of
  Nothing -> False
  Just lm -> _layerMeta_isHidden lm
layerMetaMap_isHiddenOrLocked :: REltId -> LayerMetaMap -> Bool
layerMetaMap_isHiddenOrLocked rid lmm = case IM.lookup rid lmm of
  Nothing -> False
  Just lm -> _layerMeta_isLocked lm || _layerMeta_isHidden lm
-}

data ControllerMeta = ControllerMeta {
  ControllerMeta -> XY
_controllerMeta_pan      :: XY -- do we really want this?
  , ControllerMeta -> LayerMetaMap
_controllerMeta_layers :: LayerMetaMap
} deriving (Int -> ControllerMeta -> ShowS
[ControllerMeta] -> ShowS
ControllerMeta -> String
(Int -> ControllerMeta -> ShowS)
-> (ControllerMeta -> String)
-> ([ControllerMeta] -> ShowS)
-> Show ControllerMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerMeta -> ShowS
showsPrec :: Int -> ControllerMeta -> ShowS
$cshow :: ControllerMeta -> String
show :: ControllerMeta -> String
$cshowList :: [ControllerMeta] -> ShowS
showList :: [ControllerMeta] -> ShowS
Show, ControllerMeta -> ControllerMeta -> Bool
(ControllerMeta -> ControllerMeta -> Bool)
-> (ControllerMeta -> ControllerMeta -> Bool) -> Eq ControllerMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerMeta -> ControllerMeta -> Bool
== :: ControllerMeta -> ControllerMeta -> Bool
$c/= :: ControllerMeta -> ControllerMeta -> Bool
/= :: ControllerMeta -> ControllerMeta -> Bool
Eq, (forall x. ControllerMeta -> Rep ControllerMeta x)
-> (forall x. Rep ControllerMeta x -> ControllerMeta)
-> Generic ControllerMeta
forall x. Rep ControllerMeta x -> ControllerMeta
forall x. ControllerMeta -> Rep ControllerMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ControllerMeta -> Rep ControllerMeta x
from :: forall x. ControllerMeta -> Rep ControllerMeta x
$cto :: forall x. Rep ControllerMeta x -> ControllerMeta
to :: forall x. Rep ControllerMeta x -> ControllerMeta
Generic)

instance FromJSON ControllerMeta
instance ToJSON ControllerMeta
instance NFData ControllerMeta
instance Binary ControllerMeta

emptyControllerMeta :: ControllerMeta
emptyControllerMeta :: ControllerMeta
emptyControllerMeta = XY -> LayerMetaMap -> ControllerMeta
ControllerMeta XY
0 LayerMetaMap
forall a. IntMap a
IM.empty

instance Default ControllerMeta where
  def :: ControllerMeta
def = ControllerMeta
emptyControllerMeta

type EverythingLoadState = (SPotatoFlow, ControllerMeta)