{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Potato.Flow.Types (
  REltIdMap
  , ControllersWithId
  , controllerWithId_isParams
  , AttachmentMap

  -- DELETE
  , LayerPos
  , SuperSEltLabel
  , SEltLabelChanges
  , SEltLabelChangesWithLayerPos
  , LayerPosMap

  -- * controllers
  , CRename(..)
  , CLine(..)
  , CBoxText(..)
  , CBoxType(..)
  , CBoundingBox(..)
  , CTag(..)
  , CTextStyle(..)
  , CSuperStyle(..)
  , CLineStyle(..)
  , CTextAlign(..)
  , CMaybeText(..)
  , CTextArea(..)
  , CTextAreaToggle(..)

  , Controller

  -- * delta types
  , DeltaText
  , DeltaSuperStyle(..)
  , DeltaLineStyle(..)
  , DeltaTextStyle(..)
  , DeltaTextAlign(..)
  , DeltaMaybeText(..)
  , DeltaTextArea(..)
  , DeltaTextAreaToggle(..)

  -- * serialized types
  , SEltTree
  , SCanvas(..)
  , SPotatoFlow(..)
) where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.Serialization.Snake

import           Control.Exception         (assert)
import           Data.Aeson
import           Data.Binary
import           Data.Constraint.Extras.TH
import           Data.Default
import qualified Data.Dependent.Sum        as DS
import qualified Data.IntSet as IS
import           Data.GADT.Compare.TH
import           Data.GADT.Show.TH
import qualified Data.IntMap.Strict        as IM
import qualified Data.Map as Map
import qualified Text.Show



type LayerPos = Int
type REltIdMap a = IM.IntMap a
type SuperSEltLabel = (REltId, LayerPos, SEltLabel)
type AttachmentMap = REltIdMap (IS.IntSet) -- key is target, value is set of things attaching to target

-- TODO ugg, pretty sure this could just be SElt instead of SEltLabel
type SEltLabelChanges = REltIdMap (Maybe SEltLabel)
type SEltLabelChangesWithLayerPos = REltIdMap (Maybe (LayerPos, SEltLabel))
type LayerPosMap = REltIdMap LayerPos


type SEltTree = [(REltId,SEltLabel)]

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

instance Show SCanvas where
  show :: SCanvas -> String
show SCanvas
s = String
"SCanvas " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> LBox -> String
forall b a. (Show a, IsString b) => a -> b
show (SCanvas -> LBox
_sCanvas_box SCanvas
s)

instance FromJSON SCanvas
instance ToJSON SCanvas
instance Binary SCanvas
instance NFData SCanvas

-- TODO serialize PFState instead
data SPotatoFlow = SPotatoFlow {
  SPotatoFlow -> SCanvas
_sPotatoFlow_sCanvas    :: SCanvas
  , SPotatoFlow -> SEltTree
_sPotatoFlow_sEltTree :: SEltTree
} deriving (SPotatoFlow -> SPotatoFlow -> Bool
(SPotatoFlow -> SPotatoFlow -> Bool)
-> (SPotatoFlow -> SPotatoFlow -> Bool) -> Eq SPotatoFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SPotatoFlow -> SPotatoFlow -> Bool
== :: SPotatoFlow -> SPotatoFlow -> Bool
$c/= :: SPotatoFlow -> SPotatoFlow -> Bool
/= :: SPotatoFlow -> SPotatoFlow -> Bool
Eq, (forall x. SPotatoFlow -> Rep SPotatoFlow x)
-> (forall x. Rep SPotatoFlow x -> SPotatoFlow)
-> Generic SPotatoFlow
forall x. Rep SPotatoFlow x -> SPotatoFlow
forall x. SPotatoFlow -> Rep SPotatoFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SPotatoFlow -> Rep SPotatoFlow x
from :: forall x. SPotatoFlow -> Rep SPotatoFlow x
$cto :: forall x. Rep SPotatoFlow x -> SPotatoFlow
to :: forall x. Rep SPotatoFlow x -> SPotatoFlow
Generic, Int -> SPotatoFlow -> ShowS
[SPotatoFlow] -> ShowS
SPotatoFlow -> String
(Int -> SPotatoFlow -> ShowS)
-> (SPotatoFlow -> String)
-> ([SPotatoFlow] -> ShowS)
-> Show SPotatoFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SPotatoFlow -> ShowS
showsPrec :: Int -> SPotatoFlow -> ShowS
$cshow :: SPotatoFlow -> String
show :: SPotatoFlow -> String
$cshowList :: [SPotatoFlow] -> ShowS
showList :: [SPotatoFlow] -> ShowS
Show)

instance FromJSON SPotatoFlow
instance ToJSON SPotatoFlow
instance Binary SPotatoFlow
instance NFData SPotatoFlow










-- TODO DELETE ALL CONTROLLER STUFF

-- | (old text, new text)

type DeltaText = (Text,Text)

{-
-- TODO more efficient to do this with zippers prob?
-- is there a way to make this more generic?
instance Delta Text DeltaText where
  plusDelta s (b, a) = assert (b == s) a
  minusDelta s (b, a) = assert (a == s) b
-}

data DeltaTextAlign = DeltaTextAlign (TextAlign, TextAlign) deriving (DeltaTextAlign -> DeltaTextAlign -> Bool
(DeltaTextAlign -> DeltaTextAlign -> Bool)
-> (DeltaTextAlign -> DeltaTextAlign -> Bool) -> Eq DeltaTextAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaTextAlign -> DeltaTextAlign -> Bool
== :: DeltaTextAlign -> DeltaTextAlign -> Bool
$c/= :: DeltaTextAlign -> DeltaTextAlign -> Bool
/= :: DeltaTextAlign -> DeltaTextAlign -> Bool
Eq, (forall x. DeltaTextAlign -> Rep DeltaTextAlign x)
-> (forall x. Rep DeltaTextAlign x -> DeltaTextAlign)
-> Generic DeltaTextAlign
forall x. Rep DeltaTextAlign x -> DeltaTextAlign
forall x. DeltaTextAlign -> Rep DeltaTextAlign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaTextAlign -> Rep DeltaTextAlign x
from :: forall x. DeltaTextAlign -> Rep DeltaTextAlign x
$cto :: forall x. Rep DeltaTextAlign x -> DeltaTextAlign
to :: forall x. Rep DeltaTextAlign x -> DeltaTextAlign
Generic, Int -> DeltaTextAlign -> ShowS
[DeltaTextAlign] -> ShowS
DeltaTextAlign -> String
(Int -> DeltaTextAlign -> ShowS)
-> (DeltaTextAlign -> String)
-> ([DeltaTextAlign] -> ShowS)
-> Show DeltaTextAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaTextAlign -> ShowS
showsPrec :: Int -> DeltaTextAlign -> ShowS
$cshow :: DeltaTextAlign -> String
show :: DeltaTextAlign -> String
$cshowList :: [DeltaTextAlign] -> ShowS
showList :: [DeltaTextAlign] -> ShowS
Show)
instance NFData DeltaTextAlign
instance Delta TextAlign DeltaTextAlign where
  plusDelta :: TextAlign -> DeltaTextAlign -> TextAlign
plusDelta TextAlign
ta (DeltaTextAlign (TextAlign, TextAlign)
d) = TextAlign -> (TextAlign, TextAlign) -> TextAlign
forall x dx. Delta x dx => x -> dx -> x
plusDelta TextAlign
ta (TextAlign, TextAlign)
d
  minusDelta :: TextAlign -> DeltaTextAlign -> TextAlign
minusDelta TextAlign
ta (DeltaTextAlign (TextAlign, TextAlign)
d) = TextAlign -> (TextAlign, TextAlign) -> TextAlign
forall x dx. Delta x dx => x -> dx -> x
minusDelta TextAlign
ta (TextAlign, TextAlign)
d

data DeltaSuperStyle = DeltaSuperStyle (SuperStyle, SuperStyle) deriving (DeltaSuperStyle -> DeltaSuperStyle -> Bool
(DeltaSuperStyle -> DeltaSuperStyle -> Bool)
-> (DeltaSuperStyle -> DeltaSuperStyle -> Bool)
-> Eq DeltaSuperStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaSuperStyle -> DeltaSuperStyle -> Bool
== :: DeltaSuperStyle -> DeltaSuperStyle -> Bool
$c/= :: DeltaSuperStyle -> DeltaSuperStyle -> Bool
/= :: DeltaSuperStyle -> DeltaSuperStyle -> Bool
Eq, (forall x. DeltaSuperStyle -> Rep DeltaSuperStyle x)
-> (forall x. Rep DeltaSuperStyle x -> DeltaSuperStyle)
-> Generic DeltaSuperStyle
forall x. Rep DeltaSuperStyle x -> DeltaSuperStyle
forall x. DeltaSuperStyle -> Rep DeltaSuperStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaSuperStyle -> Rep DeltaSuperStyle x
from :: forall x. DeltaSuperStyle -> Rep DeltaSuperStyle x
$cto :: forall x. Rep DeltaSuperStyle x -> DeltaSuperStyle
to :: forall x. Rep DeltaSuperStyle x -> DeltaSuperStyle
Generic, Int -> DeltaSuperStyle -> ShowS
[DeltaSuperStyle] -> ShowS
DeltaSuperStyle -> String
(Int -> DeltaSuperStyle -> ShowS)
-> (DeltaSuperStyle -> String)
-> ([DeltaSuperStyle] -> ShowS)
-> Show DeltaSuperStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaSuperStyle -> ShowS
showsPrec :: Int -> DeltaSuperStyle -> ShowS
$cshow :: DeltaSuperStyle -> String
show :: DeltaSuperStyle -> String
$cshowList :: [DeltaSuperStyle] -> ShowS
showList :: [DeltaSuperStyle] -> ShowS
Show)
instance NFData DeltaSuperStyle
instance Delta SuperStyle DeltaSuperStyle where
  plusDelta :: SuperStyle -> DeltaSuperStyle -> SuperStyle
plusDelta SuperStyle
ss (DeltaSuperStyle (SuperStyle, SuperStyle)
d) = SuperStyle -> (SuperStyle, SuperStyle) -> SuperStyle
forall x dx. Delta x dx => x -> dx -> x
plusDelta SuperStyle
ss (SuperStyle, SuperStyle)
d
  minusDelta :: SuperStyle -> DeltaSuperStyle -> SuperStyle
minusDelta SuperStyle
ss (DeltaSuperStyle (SuperStyle, SuperStyle)
d) = SuperStyle -> (SuperStyle, SuperStyle) -> SuperStyle
forall x dx. Delta x dx => x -> dx -> x
minusDelta SuperStyle
ss (SuperStyle, SuperStyle)
d

data DeltaLineStyle = DeltaLineStyle (LineStyle, LineStyle) deriving (DeltaLineStyle -> DeltaLineStyle -> Bool
(DeltaLineStyle -> DeltaLineStyle -> Bool)
-> (DeltaLineStyle -> DeltaLineStyle -> Bool) -> Eq DeltaLineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaLineStyle -> DeltaLineStyle -> Bool
== :: DeltaLineStyle -> DeltaLineStyle -> Bool
$c/= :: DeltaLineStyle -> DeltaLineStyle -> Bool
/= :: DeltaLineStyle -> DeltaLineStyle -> Bool
Eq, (forall x. DeltaLineStyle -> Rep DeltaLineStyle x)
-> (forall x. Rep DeltaLineStyle x -> DeltaLineStyle)
-> Generic DeltaLineStyle
forall x. Rep DeltaLineStyle x -> DeltaLineStyle
forall x. DeltaLineStyle -> Rep DeltaLineStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaLineStyle -> Rep DeltaLineStyle x
from :: forall x. DeltaLineStyle -> Rep DeltaLineStyle x
$cto :: forall x. Rep DeltaLineStyle x -> DeltaLineStyle
to :: forall x. Rep DeltaLineStyle x -> DeltaLineStyle
Generic, Int -> DeltaLineStyle -> ShowS
[DeltaLineStyle] -> ShowS
DeltaLineStyle -> String
(Int -> DeltaLineStyle -> ShowS)
-> (DeltaLineStyle -> String)
-> ([DeltaLineStyle] -> ShowS)
-> Show DeltaLineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaLineStyle -> ShowS
showsPrec :: Int -> DeltaLineStyle -> ShowS
$cshow :: DeltaLineStyle -> String
show :: DeltaLineStyle -> String
$cshowList :: [DeltaLineStyle] -> ShowS
showList :: [DeltaLineStyle] -> ShowS
Show)
instance NFData DeltaLineStyle
instance Delta LineStyle DeltaLineStyle where
  plusDelta :: LineStyle -> DeltaLineStyle -> LineStyle
plusDelta LineStyle
ss (DeltaLineStyle (LineStyle, LineStyle)
d) = LineStyle -> (LineStyle, LineStyle) -> LineStyle
forall x dx. Delta x dx => x -> dx -> x
plusDelta LineStyle
ss (LineStyle, LineStyle)
d
  minusDelta :: LineStyle -> DeltaLineStyle -> LineStyle
minusDelta LineStyle
ss (DeltaLineStyle (LineStyle, LineStyle)
d) = LineStyle -> (LineStyle, LineStyle) -> LineStyle
forall x dx. Delta x dx => x -> dx -> x
minusDelta LineStyle
ss (LineStyle, LineStyle)
d

data DeltaTextStyle = DeltaTextStyle (TextStyle, TextStyle) deriving (DeltaTextStyle -> DeltaTextStyle -> Bool
(DeltaTextStyle -> DeltaTextStyle -> Bool)
-> (DeltaTextStyle -> DeltaTextStyle -> Bool) -> Eq DeltaTextStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaTextStyle -> DeltaTextStyle -> Bool
== :: DeltaTextStyle -> DeltaTextStyle -> Bool
$c/= :: DeltaTextStyle -> DeltaTextStyle -> Bool
/= :: DeltaTextStyle -> DeltaTextStyle -> Bool
Eq, (forall x. DeltaTextStyle -> Rep DeltaTextStyle x)
-> (forall x. Rep DeltaTextStyle x -> DeltaTextStyle)
-> Generic DeltaTextStyle
forall x. Rep DeltaTextStyle x -> DeltaTextStyle
forall x. DeltaTextStyle -> Rep DeltaTextStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaTextStyle -> Rep DeltaTextStyle x
from :: forall x. DeltaTextStyle -> Rep DeltaTextStyle x
$cto :: forall x. Rep DeltaTextStyle x -> DeltaTextStyle
to :: forall x. Rep DeltaTextStyle x -> DeltaTextStyle
Generic, Int -> DeltaTextStyle -> ShowS
[DeltaTextStyle] -> ShowS
DeltaTextStyle -> String
(Int -> DeltaTextStyle -> ShowS)
-> (DeltaTextStyle -> String)
-> ([DeltaTextStyle] -> ShowS)
-> Show DeltaTextStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaTextStyle -> ShowS
showsPrec :: Int -> DeltaTextStyle -> ShowS
$cshow :: DeltaTextStyle -> String
show :: DeltaTextStyle -> String
$cshowList :: [DeltaTextStyle] -> ShowS
showList :: [DeltaTextStyle] -> ShowS
Show)
instance NFData DeltaTextStyle
instance Delta TextStyle DeltaTextStyle where
  plusDelta :: TextStyle -> DeltaTextStyle -> TextStyle
plusDelta TextStyle
ts (DeltaTextStyle (TextStyle, TextStyle)
d) = TextStyle -> (TextStyle, TextStyle) -> TextStyle
forall x dx. Delta x dx => x -> dx -> x
plusDelta TextStyle
ts (TextStyle, TextStyle)
d
  minusDelta :: TextStyle -> DeltaTextStyle -> TextStyle
minusDelta TextStyle
ts (DeltaTextStyle (TextStyle, TextStyle)
d) = TextStyle -> (TextStyle, TextStyle) -> TextStyle
forall x dx. Delta x dx => x -> dx -> x
minusDelta TextStyle
ts (TextStyle, TextStyle)
d

data DeltaMaybeText = DeltaMaybeText (Maybe Text, Maybe Text)  deriving (DeltaMaybeText -> DeltaMaybeText -> Bool
(DeltaMaybeText -> DeltaMaybeText -> Bool)
-> (DeltaMaybeText -> DeltaMaybeText -> Bool) -> Eq DeltaMaybeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaMaybeText -> DeltaMaybeText -> Bool
== :: DeltaMaybeText -> DeltaMaybeText -> Bool
$c/= :: DeltaMaybeText -> DeltaMaybeText -> Bool
/= :: DeltaMaybeText -> DeltaMaybeText -> Bool
Eq, (forall x. DeltaMaybeText -> Rep DeltaMaybeText x)
-> (forall x. Rep DeltaMaybeText x -> DeltaMaybeText)
-> Generic DeltaMaybeText
forall x. Rep DeltaMaybeText x -> DeltaMaybeText
forall x. DeltaMaybeText -> Rep DeltaMaybeText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaMaybeText -> Rep DeltaMaybeText x
from :: forall x. DeltaMaybeText -> Rep DeltaMaybeText x
$cto :: forall x. Rep DeltaMaybeText x -> DeltaMaybeText
to :: forall x. Rep DeltaMaybeText x -> DeltaMaybeText
Generic, Int -> DeltaMaybeText -> ShowS
[DeltaMaybeText] -> ShowS
DeltaMaybeText -> String
(Int -> DeltaMaybeText -> ShowS)
-> (DeltaMaybeText -> String)
-> ([DeltaMaybeText] -> ShowS)
-> Show DeltaMaybeText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaMaybeText -> ShowS
showsPrec :: Int -> DeltaMaybeText -> ShowS
$cshow :: DeltaMaybeText -> String
show :: DeltaMaybeText -> String
$cshowList :: [DeltaMaybeText] -> ShowS
showList :: [DeltaMaybeText] -> ShowS
Show)
instance NFData DeltaMaybeText
instance Delta (Maybe Text) DeltaMaybeText where
  plusDelta :: Maybe Text -> DeltaMaybeText -> Maybe Text
plusDelta Maybe Text
mt (DeltaMaybeText (Maybe Text, Maybe Text)
d) = Maybe Text -> (Maybe Text, Maybe Text) -> Maybe Text
forall x dx. Delta x dx => x -> dx -> x
plusDelta Maybe Text
mt (Maybe Text, Maybe Text)
d
  minusDelta :: Maybe Text -> DeltaMaybeText -> Maybe Text
minusDelta Maybe Text
mt (DeltaMaybeText (Maybe Text, Maybe Text)
d) = Maybe Text -> (Maybe Text, Maybe Text) -> Maybe Text
forall x dx. Delta x dx => x -> dx -> x
minusDelta Maybe Text
mt (Maybe Text, Maybe Text)
d

data DeltaTextArea = DeltaTextArea (Map XY (Maybe PChar, Maybe PChar))   deriving (DeltaTextArea -> DeltaTextArea -> Bool
(DeltaTextArea -> DeltaTextArea -> Bool)
-> (DeltaTextArea -> DeltaTextArea -> Bool) -> Eq DeltaTextArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaTextArea -> DeltaTextArea -> Bool
== :: DeltaTextArea -> DeltaTextArea -> Bool
$c/= :: DeltaTextArea -> DeltaTextArea -> Bool
/= :: DeltaTextArea -> DeltaTextArea -> Bool
Eq, (forall x. DeltaTextArea -> Rep DeltaTextArea x)
-> (forall x. Rep DeltaTextArea x -> DeltaTextArea)
-> Generic DeltaTextArea
forall x. Rep DeltaTextArea x -> DeltaTextArea
forall x. DeltaTextArea -> Rep DeltaTextArea x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaTextArea -> Rep DeltaTextArea x
from :: forall x. DeltaTextArea -> Rep DeltaTextArea x
$cto :: forall x. Rep DeltaTextArea x -> DeltaTextArea
to :: forall x. Rep DeltaTextArea x -> DeltaTextArea
Generic, Int -> DeltaTextArea -> ShowS
[DeltaTextArea] -> ShowS
DeltaTextArea -> String
(Int -> DeltaTextArea -> ShowS)
-> (DeltaTextArea -> String)
-> ([DeltaTextArea] -> ShowS)
-> Show DeltaTextArea
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaTextArea -> ShowS
showsPrec :: Int -> DeltaTextArea -> ShowS
$cshow :: DeltaTextArea -> String
show :: DeltaTextArea -> String
$cshowList :: [DeltaTextArea] -> ShowS
showList :: [DeltaTextArea] -> ShowS
Show)
instance NFData DeltaTextArea
instance Delta TextAreaMapping DeltaTextArea where
  plusDelta :: TextAreaMapping -> DeltaTextArea -> TextAreaMapping
plusDelta TextAreaMapping
tam (DeltaTextArea Map XY (Maybe Char, Maybe Char)
m) = TextAreaMapping
justs TextAreaMapping -> TextAreaMapping -> TextAreaMapping
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` TextAreaMapping
tam TextAreaMapping -> Map XY () -> TextAreaMapping
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map XY ()
empties where
    m' :: Map XY (Maybe Char)
m' = ((Maybe Char, Maybe Char) -> Maybe Char)
-> Map XY (Maybe Char, Maybe Char) -> Map XY (Maybe Char)
forall a b. (a -> b) -> Map XY a -> Map XY b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Char, Maybe Char) -> Maybe Char
forall a b. (a, b) -> b
snd Map XY (Maybe Char, Maybe Char)
m
    justs :: TextAreaMapping
justs = (Maybe Char -> Maybe Char)
-> Map XY (Maybe Char) -> TextAreaMapping
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe Char -> Maybe Char
forall a. a -> a
id Map XY (Maybe Char)
m'
    empties :: Map XY ()
empties = (Maybe Char -> Maybe ()) -> Map XY (Maybe Char) -> Map XY ()
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\Maybe Char
x -> if Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Char
x then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing) Map XY (Maybe Char)
m'
  minusDelta :: TextAreaMapping -> DeltaTextArea -> TextAreaMapping
minusDelta TextAreaMapping
tam (DeltaTextArea Map XY (Maybe Char, Maybe Char)
m) =  TextAreaMapping
justs TextAreaMapping -> TextAreaMapping -> TextAreaMapping
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` TextAreaMapping
tam TextAreaMapping -> Map XY () -> TextAreaMapping
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map XY ()
empties where
    m' :: Map XY (Maybe Char)
m' = ((Maybe Char, Maybe Char) -> Maybe Char)
-> Map XY (Maybe Char, Maybe Char) -> Map XY (Maybe Char)
forall a b. (a -> b) -> Map XY a -> Map XY b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Char, Maybe Char) -> Maybe Char
forall a b. (a, b) -> a
fst Map XY (Maybe Char, Maybe Char)
m
    justs :: TextAreaMapping
justs = (Maybe Char -> Maybe Char)
-> Map XY (Maybe Char) -> TextAreaMapping
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe Char -> Maybe Char
forall a. a -> a
id Map XY (Maybe Char)
m'
    empties :: Map XY ()
empties = (Maybe Char -> Maybe ()) -> Map XY (Maybe Char) -> Map XY ()
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\Maybe Char
x -> if Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Char
x then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing) Map XY (Maybe Char)
m'

-- TODO
data DeltaTextAreaToggle = DeltaTextAreaToggle SElt  deriving (DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
(DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool)
-> (DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool)
-> Eq DeltaTextAreaToggle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
== :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
$c/= :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
/= :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
Eq, (forall x. DeltaTextAreaToggle -> Rep DeltaTextAreaToggle x)
-> (forall x. Rep DeltaTextAreaToggle x -> DeltaTextAreaToggle)
-> Generic DeltaTextAreaToggle
forall x. Rep DeltaTextAreaToggle x -> DeltaTextAreaToggle
forall x. DeltaTextAreaToggle -> Rep DeltaTextAreaToggle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeltaTextAreaToggle -> Rep DeltaTextAreaToggle x
from :: forall x. DeltaTextAreaToggle -> Rep DeltaTextAreaToggle x
$cto :: forall x. Rep DeltaTextAreaToggle x -> DeltaTextAreaToggle
to :: forall x. Rep DeltaTextAreaToggle x -> DeltaTextAreaToggle
Generic, Int -> DeltaTextAreaToggle -> ShowS
[DeltaTextAreaToggle] -> ShowS
DeltaTextAreaToggle -> String
(Int -> DeltaTextAreaToggle -> ShowS)
-> (DeltaTextAreaToggle -> String)
-> ([DeltaTextAreaToggle] -> ShowS)
-> Show DeltaTextAreaToggle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeltaTextAreaToggle -> ShowS
showsPrec :: Int -> DeltaTextAreaToggle -> ShowS
$cshow :: DeltaTextAreaToggle -> String
show :: DeltaTextAreaToggle -> String
$cshowList :: [DeltaTextAreaToggle] -> ShowS
showList :: [DeltaTextAreaToggle] -> ShowS
Show)
instance NFData DeltaTextAreaToggle
instance Delta SElt DeltaTextAreaToggle where
  plusDelta :: SElt -> DeltaTextAreaToggle -> SElt
plusDelta SElt
s (DeltaTextAreaToggle SElt
s') = Bool -> SElt -> SElt
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SElt
s SElt -> SElt -> Bool
forall a. Eq a => a -> a -> Bool
== SElt
s') (SElt -> SElt) -> SElt -> SElt
forall a b. (a -> b) -> a -> b
$ SElt
forall a. (?callStack::CallStack) => a
undefined -- TODO
  minusDelta :: SElt -> DeltaTextAreaToggle -> SElt
minusDelta SElt
_ (DeltaTextAreaToggle SElt
s') = SElt
s'

data CRename = CRename {
  CRename -> DeltaText
_cRename_deltaLabel :: DeltaText
} deriving (CRename -> CRename -> Bool
(CRename -> CRename -> Bool)
-> (CRename -> CRename -> Bool) -> Eq CRename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CRename -> CRename -> Bool
== :: CRename -> CRename -> Bool
$c/= :: CRename -> CRename -> Bool
/= :: CRename -> CRename -> Bool
Eq, (forall x. CRename -> Rep CRename x)
-> (forall x. Rep CRename x -> CRename) -> Generic CRename
forall x. Rep CRename x -> CRename
forall x. CRename -> Rep CRename x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CRename -> Rep CRename x
from :: forall x. CRename -> Rep CRename x
$cto :: forall x. Rep CRename x -> CRename
to :: forall x. Rep CRename x -> CRename
Generic, Int -> CRename -> ShowS
[CRename] -> ShowS
CRename -> String
(Int -> CRename -> ShowS)
-> (CRename -> String) -> ([CRename] -> ShowS) -> Show CRename
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CRename -> ShowS
showsPrec :: Int -> CRename -> ShowS
$cshow :: CRename -> String
show :: CRename -> String
$cshowList :: [CRename] -> ShowS
showList :: [CRename] -> ShowS
Show)
instance NFData CRename
instance Delta SEltLabel CRename where
  plusDelta :: SEltLabel -> CRename -> SEltLabel
plusDelta (SEltLabel Text
name SElt
selt) CRename {DeltaText
_cRename_deltaLabel :: CRename -> DeltaText
_cRename_deltaLabel :: DeltaText
..} = Text -> SElt -> SEltLabel
SEltLabel (Text -> DeltaText -> Text
forall x dx. Delta x dx => x -> dx -> x
plusDelta Text
name DeltaText
_cRename_deltaLabel) SElt
selt
  minusDelta :: SEltLabel -> CRename -> SEltLabel
minusDelta (SEltLabel Text
name SElt
selt) CRename {DeltaText
_cRename_deltaLabel :: CRename -> DeltaText
_cRename_deltaLabel :: DeltaText
..} = Text -> SElt -> SEltLabel
SEltLabel (Text -> DeltaText -> Text
forall x dx. Delta x dx => x -> dx -> x
minusDelta Text
name DeltaText
_cRename_deltaLabel) SElt
selt

data CLine = CLine {
  CLine -> Maybe DeltaXY
_cLine_deltaStart :: Maybe DeltaXY
  , CLine -> Maybe DeltaXY
_cLine_deltaEnd :: Maybe DeltaXY
  , CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart :: Maybe (Maybe Attachment, Maybe Attachment)
  , CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd :: Maybe (Maybe Attachment, Maybe Attachment)
} deriving (CLine -> CLine -> Bool
(CLine -> CLine -> Bool) -> (CLine -> CLine -> Bool) -> Eq CLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CLine -> CLine -> Bool
== :: CLine -> CLine -> Bool
$c/= :: CLine -> CLine -> Bool
/= :: CLine -> CLine -> Bool
Eq, (forall x. CLine -> Rep CLine x)
-> (forall x. Rep CLine x -> CLine) -> Generic CLine
forall x. Rep CLine x -> CLine
forall x. CLine -> Rep CLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CLine -> Rep CLine x
from :: forall x. CLine -> Rep CLine x
$cto :: forall x. Rep CLine x -> CLine
to :: forall x. Rep CLine x -> CLine
Generic, Int -> CLine -> ShowS
[CLine] -> ShowS
CLine -> String
(Int -> CLine -> ShowS)
-> (CLine -> String) -> ([CLine] -> ShowS) -> Show CLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CLine -> ShowS
showsPrec :: Int -> CLine -> ShowS
$cshow :: CLine -> String
show :: CLine -> String
$cshowList :: [CLine] -> ShowS
showList :: [CLine] -> ShowS
Show)
instance NFData CLine
instance Default CLine where
  def :: CLine
def = Maybe DeltaXY
-> Maybe DeltaXY
-> Maybe (Maybe Attachment, Maybe Attachment)
-> Maybe (Maybe Attachment, Maybe Attachment)
-> CLine
CLine Maybe DeltaXY
forall a. Maybe a
Nothing Maybe DeltaXY
forall a. Maybe a
Nothing Maybe (Maybe Attachment, Maybe Attachment)
forall a. Maybe a
Nothing Maybe (Maybe Attachment, Maybe Attachment)
forall a. Maybe a
Nothing

instance Delta SAutoLine CLine where
  plusDelta :: SAutoLine -> CLine -> SAutoLine
plusDelta sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
..} CLine {Maybe (Maybe Attachment, Maybe Attachment)
Maybe DeltaXY
_cLine_deltaStart :: CLine -> Maybe DeltaXY
_cLine_deltaEnd :: CLine -> Maybe DeltaXY
_cLine_deltaAttachStart :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaStart :: Maybe DeltaXY
_cLine_deltaEnd :: Maybe DeltaXY
_cLine_deltaAttachStart :: Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd :: Maybe (Maybe Attachment, Maybe Attachment)
..} = SAutoLine
sline {
      _sAutoLine_start   = case _cLine_deltaStart of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_start
        Just DeltaXY
d  -> XY -> DeltaXY -> XY
forall x dx. Delta x dx => x -> dx -> x
plusDelta XY
_sAutoLine_start DeltaXY
d
      , _sAutoLine_end   =  case _cLine_deltaEnd of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_end
        Just DeltaXY
d  -> XY -> DeltaXY -> XY
forall x dx. Delta x dx => x -> dx -> x
plusDelta XY
_sAutoLine_end DeltaXY
d
      , _sAutoLine_attachStart = case _cLine_deltaAttachStart of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachStart
        Just (Maybe Attachment, Maybe Attachment)
d  -> Maybe Attachment
-> (Maybe Attachment, Maybe Attachment) -> Maybe Attachment
forall x dx. Delta x dx => x -> dx -> x
plusDelta Maybe Attachment
_sAutoLine_attachStart (Maybe Attachment, Maybe Attachment)
d
      , _sAutoLine_attachEnd = case _cLine_deltaAttachEnd of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachEnd
        Just (Maybe Attachment, Maybe Attachment)
d  -> Maybe Attachment
-> (Maybe Attachment, Maybe Attachment) -> Maybe Attachment
forall x dx. Delta x dx => x -> dx -> x
plusDelta Maybe Attachment
_sAutoLine_attachEnd (Maybe Attachment, Maybe Attachment)
d
    }
  minusDelta :: SAutoLine -> CLine -> SAutoLine
minusDelta sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} CLine {Maybe (Maybe Attachment, Maybe Attachment)
Maybe DeltaXY
_cLine_deltaStart :: CLine -> Maybe DeltaXY
_cLine_deltaEnd :: CLine -> Maybe DeltaXY
_cLine_deltaAttachStart :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaStart :: Maybe DeltaXY
_cLine_deltaEnd :: Maybe DeltaXY
_cLine_deltaAttachStart :: Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd :: Maybe (Maybe Attachment, Maybe Attachment)
..} = SAutoLine
sline {
      _sAutoLine_start   = case _cLine_deltaStart of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_start
        Just DeltaXY
d  -> XY -> DeltaXY -> XY
forall x dx. Delta x dx => x -> dx -> x
minusDelta XY
_sAutoLine_start DeltaXY
d
      , _sAutoLine_end   =  case _cLine_deltaEnd of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_end
        Just DeltaXY
d  -> XY -> DeltaXY -> XY
forall x dx. Delta x dx => x -> dx -> x
minusDelta XY
_sAutoLine_end DeltaXY
d
      , _sAutoLine_attachStart = case _cLine_deltaAttachStart of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachStart
        Just (Maybe Attachment, Maybe Attachment)
d  -> Maybe Attachment
-> (Maybe Attachment, Maybe Attachment) -> Maybe Attachment
forall x dx. Delta x dx => x -> dx -> x
minusDelta Maybe Attachment
_sAutoLine_attachStart (Maybe Attachment, Maybe Attachment)
d
      , _sAutoLine_attachEnd = case _cLine_deltaAttachEnd of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachEnd
        Just (Maybe Attachment, Maybe Attachment)
d  -> Maybe Attachment
-> (Maybe Attachment, Maybe Attachment) -> Maybe Attachment
forall x dx. Delta x dx => x -> dx -> x
minusDelta Maybe Attachment
_sAutoLine_attachEnd (Maybe Attachment, Maybe Attachment)
d
    }

data CBoxText = CBoxText {
  CBoxText -> DeltaText
_cBoxText_deltaText      :: DeltaText
} deriving (CBoxText -> CBoxText -> Bool
(CBoxText -> CBoxText -> Bool)
-> (CBoxText -> CBoxText -> Bool) -> Eq CBoxText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CBoxText -> CBoxText -> Bool
== :: CBoxText -> CBoxText -> Bool
$c/= :: CBoxText -> CBoxText -> Bool
/= :: CBoxText -> CBoxText -> Bool
Eq, (forall x. CBoxText -> Rep CBoxText x)
-> (forall x. Rep CBoxText x -> CBoxText) -> Generic CBoxText
forall x. Rep CBoxText x -> CBoxText
forall x. CBoxText -> Rep CBoxText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CBoxText -> Rep CBoxText x
from :: forall x. CBoxText -> Rep CBoxText x
$cto :: forall x. Rep CBoxText x -> CBoxText
to :: forall x. Rep CBoxText x -> CBoxText
Generic, Int -> CBoxText -> ShowS
[CBoxText] -> ShowS
CBoxText -> String
(Int -> CBoxText -> ShowS)
-> (CBoxText -> String) -> ([CBoxText] -> ShowS) -> Show CBoxText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CBoxText -> ShowS
showsPrec :: Int -> CBoxText -> ShowS
$cshow :: CBoxText -> String
show :: CBoxText -> String
$cshowList :: [CBoxText] -> ShowS
showList :: [CBoxText] -> ShowS
Show)

instance NFData CBoxText

instance Delta SBox CBoxText where
  plusDelta :: SBox -> CBoxText -> SBox
plusDelta sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_box :: LBox
_sBox_superStyle :: SuperStyle
_sBox_title :: SBoxTitle
_sBox_text :: SBoxText
_sBox_boxType :: SBoxType
_sBox_box :: SBox -> LBox
_sBox_superStyle :: SBox -> SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_text :: SBox -> SBoxText
_sBox_boxType :: SBox -> SBoxType
..} CBoxText
ctext = SBox
sbox {
      _sBox_text   = plusDelta _sBox_text ctext
    }
  minusDelta :: SBox -> CBoxText -> SBox
minusDelta sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_box :: SBox -> LBox
_sBox_superStyle :: SBox -> SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_text :: SBox -> SBoxText
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: LBox
_sBox_superStyle :: SuperStyle
_sBox_title :: SBoxTitle
_sBox_text :: SBoxText
_sBox_boxType :: SBoxType
..} CBoxText
ctext = SBox
sbox {
      _sBox_text   = minusDelta _sBox_text ctext
    }

instance Delta SBoxText CBoxText where
  plusDelta :: SBoxText -> CBoxText -> SBoxText
plusDelta sboxtext :: SBoxText
sboxtext@SBoxText {Text
TextStyle
_sBoxText_text :: Text
_sBoxText_style :: TextStyle
_sBoxText_text :: SBoxText -> Text
_sBoxText_style :: SBoxText -> TextStyle
..} CBoxText {DeltaText
_cBoxText_deltaText :: CBoxText -> DeltaText
_cBoxText_deltaText :: DeltaText
..} = SBoxText
sboxtext {
      _sBoxText_text   = plusDelta _sBoxText_text _cBoxText_deltaText
    }
  minusDelta :: SBoxText -> CBoxText -> SBoxText
minusDelta sboxtext :: SBoxText
sboxtext@SBoxText {Text
TextStyle
_sBoxText_text :: SBoxText -> Text
_sBoxText_style :: SBoxText -> TextStyle
_sBoxText_text :: Text
_sBoxText_style :: TextStyle
..} CBoxText {DeltaText
_cBoxText_deltaText :: CBoxText -> DeltaText
_cBoxText_deltaText :: DeltaText
..} = SBoxText
sboxtext {
      _sBoxText_text   = minusDelta _sBoxText_text _cBoxText_deltaText
    }

data CBoxType = CBoxType (SBoxType, SBoxType) deriving (CBoxType -> CBoxType -> Bool
(CBoxType -> CBoxType -> Bool)
-> (CBoxType -> CBoxType -> Bool) -> Eq CBoxType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CBoxType -> CBoxType -> Bool
== :: CBoxType -> CBoxType -> Bool
$c/= :: CBoxType -> CBoxType -> Bool
/= :: CBoxType -> CBoxType -> Bool
Eq, (forall x. CBoxType -> Rep CBoxType x)
-> (forall x. Rep CBoxType x -> CBoxType) -> Generic CBoxType
forall x. Rep CBoxType x -> CBoxType
forall x. CBoxType -> Rep CBoxType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CBoxType -> Rep CBoxType x
from :: forall x. CBoxType -> Rep CBoxType x
$cto :: forall x. Rep CBoxType x -> CBoxType
to :: forall x. Rep CBoxType x -> CBoxType
Generic, Int -> CBoxType -> ShowS
[CBoxType] -> ShowS
CBoxType -> String
(Int -> CBoxType -> ShowS)
-> (CBoxType -> String) -> ([CBoxType] -> ShowS) -> Show CBoxType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CBoxType -> ShowS
showsPrec :: Int -> CBoxType -> ShowS
$cshow :: CBoxType -> String
show :: CBoxType -> String
$cshowList :: [CBoxType] -> ShowS
showList :: [CBoxType] -> ShowS
Show)

instance NFData CBoxType

instance Delta SBox CBoxType where
  plusDelta :: SBox -> CBoxType -> SBox
plusDelta sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_box :: SBox -> LBox
_sBox_superStyle :: SBox -> SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_text :: SBox -> SBoxText
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: LBox
_sBox_superStyle :: SuperStyle
_sBox_title :: SBoxTitle
_sBox_text :: SBoxText
_sBox_boxType :: SBoxType
..} (CBoxType (SBoxType, SBoxType)
deltatype) = SBox
sbox {
      _sBox_boxType   = plusDelta _sBox_boxType deltatype
    }
  minusDelta :: SBox -> CBoxType -> SBox
minusDelta sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_box :: SBox -> LBox
_sBox_superStyle :: SBox -> SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_text :: SBox -> SBoxText
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: LBox
_sBox_superStyle :: SuperStyle
_sBox_title :: SBoxTitle
_sBox_text :: SBoxText
_sBox_boxType :: SBoxType
..} (CBoxType (SBoxType, SBoxType)
deltatype) = SBox
sbox {
      _sBox_boxType   = minusDelta _sBox_boxType deltatype
    }

data CBoundingBox = CBoundingBox {
  CBoundingBox -> DeltaLBox
_cBoundingBox_deltaBox    :: DeltaLBox
} deriving (CBoundingBox -> CBoundingBox -> Bool
(CBoundingBox -> CBoundingBox -> Bool)
-> (CBoundingBox -> CBoundingBox -> Bool) -> Eq CBoundingBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CBoundingBox -> CBoundingBox -> Bool
== :: CBoundingBox -> CBoundingBox -> Bool
$c/= :: CBoundingBox -> CBoundingBox -> Bool
/= :: CBoundingBox -> CBoundingBox -> Bool
Eq, (forall x. CBoundingBox -> Rep CBoundingBox x)
-> (forall x. Rep CBoundingBox x -> CBoundingBox)
-> Generic CBoundingBox
forall x. Rep CBoundingBox x -> CBoundingBox
forall x. CBoundingBox -> Rep CBoundingBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CBoundingBox -> Rep CBoundingBox x
from :: forall x. CBoundingBox -> Rep CBoundingBox x
$cto :: forall x. Rep CBoundingBox x -> CBoundingBox
to :: forall x. Rep CBoundingBox x -> CBoundingBox
Generic, Int -> CBoundingBox -> ShowS
[CBoundingBox] -> ShowS
CBoundingBox -> String
(Int -> CBoundingBox -> ShowS)
-> (CBoundingBox -> String)
-> ([CBoundingBox] -> ShowS)
-> Show CBoundingBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CBoundingBox -> ShowS
showsPrec :: Int -> CBoundingBox -> ShowS
$cshow :: CBoundingBox -> String
show :: CBoundingBox -> String
$cshowList :: [CBoundingBox] -> ShowS
showList :: [CBoundingBox] -> ShowS
Show)
instance NFData CBoundingBox

data CSuperStyle = CSuperStyle DeltaSuperStyle deriving (CSuperStyle -> CSuperStyle -> Bool
(CSuperStyle -> CSuperStyle -> Bool)
-> (CSuperStyle -> CSuperStyle -> Bool) -> Eq CSuperStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CSuperStyle -> CSuperStyle -> Bool
== :: CSuperStyle -> CSuperStyle -> Bool
$c/= :: CSuperStyle -> CSuperStyle -> Bool
/= :: CSuperStyle -> CSuperStyle -> Bool
Eq, (forall x. CSuperStyle -> Rep CSuperStyle x)
-> (forall x. Rep CSuperStyle x -> CSuperStyle)
-> Generic CSuperStyle
forall x. Rep CSuperStyle x -> CSuperStyle
forall x. CSuperStyle -> Rep CSuperStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CSuperStyle -> Rep CSuperStyle x
from :: forall x. CSuperStyle -> Rep CSuperStyle x
$cto :: forall x. Rep CSuperStyle x -> CSuperStyle
to :: forall x. Rep CSuperStyle x -> CSuperStyle
Generic, Int -> CSuperStyle -> ShowS
[CSuperStyle] -> ShowS
CSuperStyle -> String
(Int -> CSuperStyle -> ShowS)
-> (CSuperStyle -> String)
-> ([CSuperStyle] -> ShowS)
-> Show CSuperStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSuperStyle -> ShowS
showsPrec :: Int -> CSuperStyle -> ShowS
$cshow :: CSuperStyle -> String
show :: CSuperStyle -> String
$cshowList :: [CSuperStyle] -> ShowS
showList :: [CSuperStyle] -> ShowS
Show)
instance NFData CSuperStyle

data CLineStyle = CLineStyle DeltaLineStyle deriving (CLineStyle -> CLineStyle -> Bool
(CLineStyle -> CLineStyle -> Bool)
-> (CLineStyle -> CLineStyle -> Bool) -> Eq CLineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CLineStyle -> CLineStyle -> Bool
== :: CLineStyle -> CLineStyle -> Bool
$c/= :: CLineStyle -> CLineStyle -> Bool
/= :: CLineStyle -> CLineStyle -> Bool
Eq, (forall x. CLineStyle -> Rep CLineStyle x)
-> (forall x. Rep CLineStyle x -> CLineStyle) -> Generic CLineStyle
forall x. Rep CLineStyle x -> CLineStyle
forall x. CLineStyle -> Rep CLineStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CLineStyle -> Rep CLineStyle x
from :: forall x. CLineStyle -> Rep CLineStyle x
$cto :: forall x. Rep CLineStyle x -> CLineStyle
to :: forall x. Rep CLineStyle x -> CLineStyle
Generic, Int -> CLineStyle -> ShowS
[CLineStyle] -> ShowS
CLineStyle -> String
(Int -> CLineStyle -> ShowS)
-> (CLineStyle -> String)
-> ([CLineStyle] -> ShowS)
-> Show CLineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CLineStyle -> ShowS
showsPrec :: Int -> CLineStyle -> ShowS
$cshow :: CLineStyle -> String
show :: CLineStyle -> String
$cshowList :: [CLineStyle] -> ShowS
showList :: [CLineStyle] -> ShowS
Show)
instance NFData CLineStyle

data CTextStyle = CTextStyle DeltaTextStyle deriving (CTextStyle -> CTextStyle -> Bool
(CTextStyle -> CTextStyle -> Bool)
-> (CTextStyle -> CTextStyle -> Bool) -> Eq CTextStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTextStyle -> CTextStyle -> Bool
== :: CTextStyle -> CTextStyle -> Bool
$c/= :: CTextStyle -> CTextStyle -> Bool
/= :: CTextStyle -> CTextStyle -> Bool
Eq, (forall x. CTextStyle -> Rep CTextStyle x)
-> (forall x. Rep CTextStyle x -> CTextStyle) -> Generic CTextStyle
forall x. Rep CTextStyle x -> CTextStyle
forall x. CTextStyle -> Rep CTextStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CTextStyle -> Rep CTextStyle x
from :: forall x. CTextStyle -> Rep CTextStyle x
$cto :: forall x. Rep CTextStyle x -> CTextStyle
to :: forall x. Rep CTextStyle x -> CTextStyle
Generic, Int -> CTextStyle -> ShowS
[CTextStyle] -> ShowS
CTextStyle -> String
(Int -> CTextStyle -> ShowS)
-> (CTextStyle -> String)
-> ([CTextStyle] -> ShowS)
-> Show CTextStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CTextStyle -> ShowS
showsPrec :: Int -> CTextStyle -> ShowS
$cshow :: CTextStyle -> String
show :: CTextStyle -> String
$cshowList :: [CTextStyle] -> ShowS
showList :: [CTextStyle] -> ShowS
Show)
instance NFData CTextStyle

data CTextAlign = CTextAlign DeltaTextAlign deriving (CTextAlign -> CTextAlign -> Bool
(CTextAlign -> CTextAlign -> Bool)
-> (CTextAlign -> CTextAlign -> Bool) -> Eq CTextAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTextAlign -> CTextAlign -> Bool
== :: CTextAlign -> CTextAlign -> Bool
$c/= :: CTextAlign -> CTextAlign -> Bool
/= :: CTextAlign -> CTextAlign -> Bool
Eq, (forall x. CTextAlign -> Rep CTextAlign x)
-> (forall x. Rep CTextAlign x -> CTextAlign) -> Generic CTextAlign
forall x. Rep CTextAlign x -> CTextAlign
forall x. CTextAlign -> Rep CTextAlign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CTextAlign -> Rep CTextAlign x
from :: forall x. CTextAlign -> Rep CTextAlign x
$cto :: forall x. Rep CTextAlign x -> CTextAlign
to :: forall x. Rep CTextAlign x -> CTextAlign
Generic, Int -> CTextAlign -> ShowS
[CTextAlign] -> ShowS
CTextAlign -> String
(Int -> CTextAlign -> ShowS)
-> (CTextAlign -> String)
-> ([CTextAlign] -> ShowS)
-> Show CTextAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CTextAlign -> ShowS
showsPrec :: Int -> CTextAlign -> ShowS
$cshow :: CTextAlign -> String
show :: CTextAlign -> String
$cshowList :: [CTextAlign] -> ShowS
showList :: [CTextAlign] -> ShowS
Show)
instance NFData CTextAlign

data CMaybeText = CMaybeText DeltaMaybeText deriving (CMaybeText -> CMaybeText -> Bool
(CMaybeText -> CMaybeText -> Bool)
-> (CMaybeText -> CMaybeText -> Bool) -> Eq CMaybeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CMaybeText -> CMaybeText -> Bool
== :: CMaybeText -> CMaybeText -> Bool
$c/= :: CMaybeText -> CMaybeText -> Bool
/= :: CMaybeText -> CMaybeText -> Bool
Eq, (forall x. CMaybeText -> Rep CMaybeText x)
-> (forall x. Rep CMaybeText x -> CMaybeText) -> Generic CMaybeText
forall x. Rep CMaybeText x -> CMaybeText
forall x. CMaybeText -> Rep CMaybeText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CMaybeText -> Rep CMaybeText x
from :: forall x. CMaybeText -> Rep CMaybeText x
$cto :: forall x. Rep CMaybeText x -> CMaybeText
to :: forall x. Rep CMaybeText x -> CMaybeText
Generic, Int -> CMaybeText -> ShowS
[CMaybeText] -> ShowS
CMaybeText -> String
(Int -> CMaybeText -> ShowS)
-> (CMaybeText -> String)
-> ([CMaybeText] -> ShowS)
-> Show CMaybeText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CMaybeText -> ShowS
showsPrec :: Int -> CMaybeText -> ShowS
$cshow :: CMaybeText -> String
show :: CMaybeText -> String
$cshowList :: [CMaybeText] -> ShowS
showList :: [CMaybeText] -> ShowS
Show)
instance NFData CMaybeText

data CTextArea = CTextArea DeltaTextArea deriving (CTextArea -> CTextArea -> Bool
(CTextArea -> CTextArea -> Bool)
-> (CTextArea -> CTextArea -> Bool) -> Eq CTextArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTextArea -> CTextArea -> Bool
== :: CTextArea -> CTextArea -> Bool
$c/= :: CTextArea -> CTextArea -> Bool
/= :: CTextArea -> CTextArea -> Bool
Eq, (forall x. CTextArea -> Rep CTextArea x)
-> (forall x. Rep CTextArea x -> CTextArea) -> Generic CTextArea
forall x. Rep CTextArea x -> CTextArea
forall x. CTextArea -> Rep CTextArea x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CTextArea -> Rep CTextArea x
from :: forall x. CTextArea -> Rep CTextArea x
$cto :: forall x. Rep CTextArea x -> CTextArea
to :: forall x. Rep CTextArea x -> CTextArea
Generic, Int -> CTextArea -> ShowS
[CTextArea] -> ShowS
CTextArea -> String
(Int -> CTextArea -> ShowS)
-> (CTextArea -> String)
-> ([CTextArea] -> ShowS)
-> Show CTextArea
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CTextArea -> ShowS
showsPrec :: Int -> CTextArea -> ShowS
$cshow :: CTextArea -> String
show :: CTextArea -> String
$cshowList :: [CTextArea] -> ShowS
showList :: [CTextArea] -> ShowS
Show)
instance NFData CTextArea

data CTextAreaToggle = CTextAreaToggle DeltaTextAreaToggle deriving (CTextAreaToggle -> CTextAreaToggle -> Bool
(CTextAreaToggle -> CTextAreaToggle -> Bool)
-> (CTextAreaToggle -> CTextAreaToggle -> Bool)
-> Eq CTextAreaToggle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTextAreaToggle -> CTextAreaToggle -> Bool
== :: CTextAreaToggle -> CTextAreaToggle -> Bool
$c/= :: CTextAreaToggle -> CTextAreaToggle -> Bool
/= :: CTextAreaToggle -> CTextAreaToggle -> Bool
Eq, (forall x. CTextAreaToggle -> Rep CTextAreaToggle x)
-> (forall x. Rep CTextAreaToggle x -> CTextAreaToggle)
-> Generic CTextAreaToggle
forall x. Rep CTextAreaToggle x -> CTextAreaToggle
forall x. CTextAreaToggle -> Rep CTextAreaToggle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CTextAreaToggle -> Rep CTextAreaToggle x
from :: forall x. CTextAreaToggle -> Rep CTextAreaToggle x
$cto :: forall x. Rep CTextAreaToggle x -> CTextAreaToggle
to :: forall x. Rep CTextAreaToggle x -> CTextAreaToggle
Generic, Int -> CTextAreaToggle -> ShowS
[CTextAreaToggle] -> ShowS
CTextAreaToggle -> String
(Int -> CTextAreaToggle -> ShowS)
-> (CTextAreaToggle -> String)
-> ([CTextAreaToggle] -> ShowS)
-> Show CTextAreaToggle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CTextAreaToggle -> ShowS
showsPrec :: Int -> CTextAreaToggle -> ShowS
$cshow :: CTextAreaToggle -> String
show :: CTextAreaToggle -> String
$cshowList :: [CTextAreaToggle] -> ShowS
showList :: [CTextAreaToggle] -> ShowS
Show)
instance NFData CTextAreaToggle

-- NOTE, in some previous (very flawed) design, these were fanned out in a Reflex event hence the `DSum CTag` thing
-- we don't do this anymore, but DSum is still a nice alternative to using an ADT so we keep it.
data CTag a where
  CTagRename :: CTag CRename

  CTagLine :: CTag CLine

  CTagBoxText :: CTag CBoxText
  CTagBoxType :: CTag CBoxType
  CTagBoxTextStyle :: CTag CTextStyle

  CTagBoxLabelAlignment :: CTag CTextAlign
  CTagBoxLabelText :: CTag CMaybeText

  CTagTextArea :: CTag CTextArea

  -- TODO DELETE ME, replaced by Llama, you never finished implementing me anyways
  CTagTextAreaToggle :: CTag CTextAreaToggle

  CTagSuperStyle :: CTag CSuperStyle
  CTagLineStyle :: CTag CLineStyle
  CTagBoundingBox :: CTag CBoundingBox


deriveGEq      ''CTag
deriveGCompare ''CTag
deriveGShow ''CTag
deriveArgDict ''CTag

-- | Controllers represent changes to SElts
type Controller = DS.DSum CTag Identity

instance NFData Controller where
  rnf :: Controller -> ()
rnf (CTag a
CTagRename DS.:=> Identity a
a)       = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagLine DS.:=> Identity a
a)         = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxText DS.:=> Identity a
a)      = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxType DS.:=> Identity a
a)      = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoundingBox DS.:=> Identity a
a)  = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagSuperStyle DS.:=> Identity a
a)   = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagLineStyle DS.:=> Identity a
a)   = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxTextStyle DS.:=> Identity a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxLabelAlignment DS.:=> Identity a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxLabelText DS.:=> Identity a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagTextArea DS.:=> Identity a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagTextAreaToggle DS.:=> Identity a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

-- | indexed my REltId
type ControllersWithId = IntMap Controller

controller_isParams :: Controller -> Bool
controller_isParams :: Controller -> Bool
controller_isParams (CTag a
CTagBoxType DS.:=> Identity a
_)      = Bool
True
controller_isParams (CTag a
CTagSuperStyle DS.:=> Identity a
_)   = Bool
True
controller_isParams (CTag a
CTagLineStyle DS.:=> Identity a
_)   = Bool
True
controller_isParams (CTag a
CTagBoxTextStyle DS.:=> Identity a
_) = Bool
True
controller_isParams (CTag a
CTagBoxLabelAlignment DS.:=> Identity a
_) = Bool
True
controller_isParams Controller
_                                    = Bool
False

controllerWithId_isParams :: ControllersWithId -> Bool
controllerWithId_isParams :: ControllersWithId -> Bool
controllerWithId_isParams = (Controller -> Bool) -> ControllersWithId -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Controller -> Bool
controller_isParams