{-# 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.SElts

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SCanvas -> SCanvas -> Bool
$c/= :: SCanvas -> SCanvas -> Bool
== :: SCanvas -> SCanvas -> Bool
$c== :: SCanvas -> SCanvas -> Bool
Eq, 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
$cto :: forall x. Rep SCanvas x -> SCanvas
$cfrom :: forall x. SCanvas -> Rep SCanvas x
Generic)

instance Show SCanvas where
  show :: SCanvas -> String
show SCanvas
s = String
"SCanvas " forall a. Semigroup a => a -> a -> a
<> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SPotatoFlow -> SPotatoFlow -> Bool
$c/= :: SPotatoFlow -> SPotatoFlow -> Bool
== :: SPotatoFlow -> SPotatoFlow -> Bool
$c== :: SPotatoFlow -> SPotatoFlow -> Bool
Eq, 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
$cto :: forall x. Rep SPotatoFlow x -> SPotatoFlow
$cfrom :: forall x. SPotatoFlow -> Rep SPotatoFlow x
Generic, Int -> SPotatoFlow -> ShowS
[SPotatoFlow] -> ShowS
SPotatoFlow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SPotatoFlow] -> ShowS
$cshowList :: [SPotatoFlow] -> ShowS
show :: SPotatoFlow -> String
$cshow :: SPotatoFlow -> String
showsPrec :: Int -> SPotatoFlow -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaTextAlign -> DeltaTextAlign -> Bool
$c/= :: DeltaTextAlign -> DeltaTextAlign -> Bool
== :: DeltaTextAlign -> DeltaTextAlign -> Bool
$c== :: DeltaTextAlign -> DeltaTextAlign -> Bool
Eq, 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
$cto :: forall x. Rep DeltaTextAlign x -> DeltaTextAlign
$cfrom :: forall x. DeltaTextAlign -> Rep DeltaTextAlign x
Generic, Int -> DeltaTextAlign -> ShowS
[DeltaTextAlign] -> ShowS
DeltaTextAlign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaTextAlign] -> ShowS
$cshowList :: [DeltaTextAlign] -> ShowS
show :: DeltaTextAlign -> String
$cshow :: DeltaTextAlign -> String
showsPrec :: Int -> DeltaTextAlign -> ShowS
$cshowsPrec :: Int -> DeltaTextAlign -> ShowS
Show)
instance NFData DeltaTextAlign
instance Delta TextAlign DeltaTextAlign where
  plusDelta :: TextAlign -> DeltaTextAlign -> TextAlign
plusDelta TextAlign
ta (DeltaTextAlign (TextAlign, TextAlign)
d) = 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) = forall x dx. Delta x dx => x -> dx -> x
minusDelta TextAlign
ta (TextAlign, TextAlign)
d

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

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

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

-- TODO
data DeltaTextAreaToggle = DeltaTextAreaToggle SElt  deriving (DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
$c/= :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
== :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
$c== :: DeltaTextAreaToggle -> DeltaTextAreaToggle -> Bool
Eq, 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
$cto :: forall x. Rep DeltaTextAreaToggle x -> DeltaTextAreaToggle
$cfrom :: forall x. DeltaTextAreaToggle -> Rep DeltaTextAreaToggle x
Generic, Int -> DeltaTextAreaToggle -> ShowS
[DeltaTextAreaToggle] -> ShowS
DeltaTextAreaToggle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaTextAreaToggle] -> ShowS
$cshowList :: [DeltaTextAreaToggle] -> ShowS
show :: DeltaTextAreaToggle -> String
$cshow :: DeltaTextAreaToggle -> String
showsPrec :: Int -> DeltaTextAreaToggle -> ShowS
$cshowsPrec :: Int -> DeltaTextAreaToggle -> ShowS
Show)
instance NFData DeltaTextAreaToggle
instance Delta SElt DeltaTextAreaToggle where
  plusDelta :: SElt -> DeltaTextAreaToggle -> SElt
plusDelta SElt
s (DeltaTextAreaToggle SElt
s') = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SElt
s forall a. Eq a => a -> a -> Bool
== SElt
s') forall a b. (a -> b) -> a -> b
$ 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CRename -> CRename -> Bool
$c/= :: CRename -> CRename -> Bool
== :: CRename -> CRename -> Bool
$c== :: CRename -> CRename -> Bool
Eq, 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
$cto :: forall x. Rep CRename x -> CRename
$cfrom :: forall x. CRename -> Rep CRename x
Generic, Int -> CRename -> ShowS
[CRename] -> ShowS
CRename -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CRename] -> ShowS
$cshowList :: [CRename] -> ShowS
show :: CRename -> String
$cshow :: CRename -> String
showsPrec :: Int -> CRename -> ShowS
$cshowsPrec :: Int -> 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 :: DeltaText
_cRename_deltaLabel :: CRename -> DeltaText
..} = Text -> SElt -> SEltLabel
SEltLabel (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 :: DeltaText
_cRename_deltaLabel :: CRename -> DeltaText
..} = Text -> SElt -> SEltLabel
SEltLabel (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CLine -> CLine -> Bool
$c/= :: CLine -> CLine -> Bool
== :: CLine -> CLine -> Bool
$c== :: CLine -> CLine -> Bool
Eq, 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
$cto :: forall x. Rep CLine x -> CLine
$cfrom :: forall x. CLine -> Rep CLine x
Generic, Int -> CLine -> ShowS
[CLine] -> ShowS
CLine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CLine] -> ShowS
$cshowList :: [CLine] -> ShowS
show :: CLine -> String
$cshow :: CLine -> String
showsPrec :: Int -> CLine -> ShowS
$cshowsPrec :: Int -> 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
..} CLine {Maybe (Maybe Attachment, Maybe Attachment)
Maybe DeltaXY
_cLine_deltaAttachEnd :: Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart :: Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaEnd :: Maybe DeltaXY
_cLine_deltaStart :: Maybe DeltaXY
_cLine_deltaAttachEnd :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaEnd :: CLine -> Maybe DeltaXY
_cLine_deltaStart :: CLine -> Maybe DeltaXY
..} = SAutoLine
sline {
      _sAutoLine_start :: XY
_sAutoLine_start   = case Maybe DeltaXY
_cLine_deltaStart of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_start
        Just DeltaXY
d  -> forall x dx. Delta x dx => x -> dx -> x
plusDelta XY
_sAutoLine_start DeltaXY
d
      , _sAutoLine_end :: XY
_sAutoLine_end   =  case Maybe DeltaXY
_cLine_deltaEnd of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_end
        Just DeltaXY
d  -> forall x dx. Delta x dx => x -> dx -> x
plusDelta XY
_sAutoLine_end DeltaXY
d
      , _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = case Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachStart
        Just (Maybe Attachment, Maybe Attachment)
d  -> forall x dx. Delta x dx => x -> dx -> x
plusDelta Maybe Attachment
_sAutoLine_attachStart (Maybe Attachment, Maybe Attachment)
d
      , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = case Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachEnd
        Just (Maybe Attachment, Maybe Attachment)
d  -> 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_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} CLine {Maybe (Maybe Attachment, Maybe Attachment)
Maybe DeltaXY
_cLine_deltaAttachEnd :: Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart :: Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaEnd :: Maybe DeltaXY
_cLine_deltaStart :: Maybe DeltaXY
_cLine_deltaAttachEnd :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart :: CLine -> Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaEnd :: CLine -> Maybe DeltaXY
_cLine_deltaStart :: CLine -> Maybe DeltaXY
..} = SAutoLine
sline {
      _sAutoLine_start :: XY
_sAutoLine_start   = case Maybe DeltaXY
_cLine_deltaStart of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_start
        Just DeltaXY
d  -> forall x dx. Delta x dx => x -> dx -> x
minusDelta XY
_sAutoLine_start DeltaXY
d
      , _sAutoLine_end :: XY
_sAutoLine_end   =  case Maybe DeltaXY
_cLine_deltaEnd of
        Maybe DeltaXY
Nothing -> XY
_sAutoLine_end
        Just DeltaXY
d  -> forall x dx. Delta x dx => x -> dx -> x
minusDelta XY
_sAutoLine_end DeltaXY
d
      , _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = case Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachStart of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachStart
        Just (Maybe Attachment, Maybe Attachment)
d  -> forall x dx. Delta x dx => x -> dx -> x
minusDelta Maybe Attachment
_sAutoLine_attachStart (Maybe Attachment, Maybe Attachment)
d
      , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = case Maybe (Maybe Attachment, Maybe Attachment)
_cLine_deltaAttachEnd of
        Maybe (Maybe Attachment, Maybe Attachment)
Nothing -> Maybe Attachment
_sAutoLine_attachEnd
        Just (Maybe Attachment, Maybe Attachment)
d  -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBoxText -> CBoxText -> Bool
$c/= :: CBoxText -> CBoxText -> Bool
== :: CBoxText -> CBoxText -> Bool
$c== :: CBoxText -> CBoxText -> Bool
Eq, 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
$cto :: forall x. Rep CBoxText x -> CBoxText
$cfrom :: forall x. CBoxText -> Rep CBoxText x
Generic, Int -> CBoxText -> ShowS
[CBoxText] -> ShowS
CBoxText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBoxText] -> ShowS
$cshowList :: [CBoxText] -> ShowS
show :: CBoxText -> String
$cshow :: CBoxText -> String
showsPrec :: Int -> CBoxText -> ShowS
$cshowsPrec :: Int -> 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_boxType :: SBox -> SBoxType
_sBox_text :: SBox -> SBoxText
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_box :: SBox -> LBox
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
..} CBoxText
ctext = SBox
sbox {
      _sBox_text :: SBoxText
_sBox_text   = forall x dx. Delta x dx => x -> dx -> x
plusDelta SBoxText
_sBox_text CBoxText
ctext
    }
  minusDelta :: SBox -> CBoxText -> SBox
minusDelta sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_boxType :: SBox -> SBoxType
_sBox_text :: SBox -> SBoxText
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_box :: SBox -> LBox
..} CBoxText
ctext = SBox
sbox {
      _sBox_text :: SBoxText
_sBox_text   = forall x dx. Delta x dx => x -> dx -> x
minusDelta SBoxText
_sBox_text CBoxText
ctext
    }

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

data CBoxType = CBoxType (SBoxType, SBoxType) deriving (CBoxType -> CBoxType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBoxType -> CBoxType -> Bool
$c/= :: CBoxType -> CBoxType -> Bool
== :: CBoxType -> CBoxType -> Bool
$c== :: CBoxType -> CBoxType -> Bool
Eq, 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
$cto :: forall x. Rep CBoxType x -> CBoxType
$cfrom :: forall x. CBoxType -> Rep CBoxType x
Generic, Int -> CBoxType -> ShowS
[CBoxType] -> ShowS
CBoxType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBoxType] -> ShowS
$cshowList :: [CBoxType] -> ShowS
show :: CBoxType -> String
$cshow :: CBoxType -> String
showsPrec :: Int -> CBoxType -> ShowS
$cshowsPrec :: Int -> 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_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_boxType :: SBox -> SBoxType
_sBox_text :: SBox -> SBoxText
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_box :: SBox -> LBox
..} (CBoxType (SBoxType, SBoxType)
deltatype) = SBox
sbox {
      _sBox_boxType :: SBoxType
_sBox_boxType   = forall x dx. Delta x dx => x -> dx -> x
plusDelta SBoxType
_sBox_boxType (SBoxType, SBoxType)
deltatype
    }
  minusDelta :: SBox -> CBoxType -> SBox
minusDelta sbox :: SBox
sbox@SBox {LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_boxType :: SBox -> SBoxType
_sBox_text :: SBox -> SBoxText
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_box :: SBox -> LBox
..} (CBoxType (SBoxType, SBoxType)
deltatype) = SBox
sbox {
      _sBox_boxType :: SBoxType
_sBox_boxType   = forall x dx. Delta x dx => x -> dx -> x
minusDelta SBoxType
_sBox_boxType (SBoxType, SBoxType)
deltatype
    }

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

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

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

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

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

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

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

data CTextAreaToggle = CTextAreaToggle DeltaTextAreaToggle deriving (CTextAreaToggle -> CTextAreaToggle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTextAreaToggle -> CTextAreaToggle -> Bool
$c/= :: CTextAreaToggle -> CTextAreaToggle -> Bool
== :: CTextAreaToggle -> CTextAreaToggle -> Bool
$c== :: CTextAreaToggle -> CTextAreaToggle -> Bool
Eq, 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
$cto :: forall x. Rep CTextAreaToggle x -> CTextAreaToggle
$cfrom :: forall x. CTextAreaToggle -> Rep CTextAreaToggle x
Generic, Int -> CTextAreaToggle -> ShowS
[CTextAreaToggle] -> ShowS
CTextAreaToggle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTextAreaToggle] -> ShowS
$cshowList :: [CTextAreaToggle] -> ShowS
show :: CTextAreaToggle -> String
$cshow :: CTextAreaToggle -> String
showsPrec :: Int -> CTextAreaToggle -> ShowS
$cshowsPrec :: Int -> 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
  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)       = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagLine DS.:=> Identity a
a)         = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxText DS.:=> Identity a
a)      = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxType DS.:=> Identity a
a)      = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoundingBox DS.:=> Identity a
a)  = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagSuperStyle DS.:=> Identity a
a)   = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagLineStyle DS.:=> Identity a
a)   = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxTextStyle DS.:=> Identity a
a) = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxLabelAlignment DS.:=> Identity a
a) = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagBoxLabelText DS.:=> Identity a
a) = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagTextArea DS.:=> Identity a
a) = forall a. NFData a => a -> ()
rnf a
a
  rnf (CTag a
CTagTextAreaToggle DS.:=> Identity 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Controller -> Bool
controller_isParams