{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.SElts where

import           Relude

import           Potato.Flow.Math
import Potato.Data.Text.Unicode

import           Control.Exception (assert)
import           Data.Aeson
import           Data.Binary
import           Data.Default
import qualified Text.Show
import qualified Data.Text as T
import qualified Data.List         as L
import qualified Data.Map as Map
import qualified Potato.Data.Text.Zipper as TZ
import Data.Ratio


type REltId = Int
type PChar = Char
type MPChar = Maybe PChar

getPCharWidth :: Char -> Int8
getPCharWidth :: Char -> Int8
getPCharWidth = Char -> Int8
getCharWidth


data FillStyle = FillStyle_Blank | FillStyle_Simple PChar deriving (FillStyle -> FillStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillStyle -> FillStyle -> Bool
$c/= :: FillStyle -> FillStyle -> Bool
== :: FillStyle -> FillStyle -> Bool
$c== :: FillStyle -> FillStyle -> Bool
Eq, forall x. Rep FillStyle x -> FillStyle
forall x. FillStyle -> Rep FillStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FillStyle x -> FillStyle
$cfrom :: forall x. FillStyle -> Rep FillStyle x
Generic, Int -> FillStyle -> ShowS
[FillStyle] -> ShowS
FillStyle -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FillStyle] -> ShowS
$cshowList :: [FillStyle] -> ShowS
show :: FillStyle -> [Char]
$cshow :: FillStyle -> [Char]
showsPrec :: Int -> FillStyle -> ShowS
$cshowsPrec :: Int -> FillStyle -> ShowS
Show)

instance FromJSON FillStyle
instance ToJSON FillStyle
instance Binary FillStyle
instance NFData FillStyle

instance Default FillStyle where
  def :: FillStyle
def = Char -> FillStyle
FillStyle_Simple Char
' '

-- TODO add line ends?
-- TODO add line thickness?
-- TODO add line fill?
data SuperStyle = SuperStyle {
  SuperStyle -> MPChar
_superStyle_tl           :: MPChar
  , SuperStyle -> MPChar
_superStyle_tr         :: MPChar
  , SuperStyle -> MPChar
_superStyle_bl         :: MPChar
  , SuperStyle -> MPChar
_superStyle_br         :: MPChar
  , SuperStyle -> MPChar
_superStyle_vertical   :: MPChar
  , SuperStyle -> MPChar
_superStyle_horizontal :: MPChar
  , SuperStyle -> MPChar
_superStyle_point      :: MPChar -- used for 1x1 boxes and 1x lines
  , SuperStyle -> FillStyle
_superStyle_fill       :: FillStyle
} deriving (SuperStyle -> SuperStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuperStyle -> SuperStyle -> Bool
$c/= :: SuperStyle -> SuperStyle -> Bool
== :: SuperStyle -> SuperStyle -> Bool
$c== :: SuperStyle -> SuperStyle -> Bool
Eq, forall x. Rep SuperStyle x -> SuperStyle
forall x. SuperStyle -> Rep SuperStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SuperStyle x -> SuperStyle
$cfrom :: forall x. SuperStyle -> Rep SuperStyle x
Generic)

instance FromJSON SuperStyle
instance ToJSON SuperStyle
instance Binary SuperStyle
instance NFData SuperStyle

instance Default SuperStyle where
  def :: SuperStyle
def = SuperStyle {
    _superStyle_tl :: MPChar
_superStyle_tl = forall a. a -> Maybe a
Just Char
'╔'
    , _superStyle_tr :: MPChar
_superStyle_tr = forall a. a -> Maybe a
Just Char
'╗'
    , _superStyle_bl :: MPChar
_superStyle_bl = forall a. a -> Maybe a
Just Char
'╚'
    , _superStyle_br :: MPChar
_superStyle_br = forall a. a -> Maybe a
Just Char
'╝'
    , _superStyle_vertical :: MPChar
_superStyle_vertical   = forall a. a -> Maybe a
Just Char
'║'
    , _superStyle_horizontal :: MPChar
_superStyle_horizontal = forall a. a -> Maybe a
Just Char
'═'
    , _superStyle_point :: MPChar
_superStyle_point = forall a. a -> Maybe a
Just Char
'█'
    , _superStyle_fill :: FillStyle
_superStyle_fill = forall a. Default a => a
def
  }

instance Show SuperStyle where
  show :: SuperStyle -> [Char]
show = SuperStyle -> [Char]
superStyle_toListFormat

superStyle_fromListFormat :: [PChar] -> SuperStyle
superStyle_fromListFormat :: [Char] -> SuperStyle
superStyle_fromListFormat [Char]
chars = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
|| Int
l forall a. Eq a => a -> a -> Bool
== Int
8) forall a b. (a -> b) -> a -> b
$ SuperStyle
r where
  l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
chars
  r :: SuperStyle
r = SuperStyle {
    _superStyle_tl :: MPChar
_superStyle_tl = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
0
    , _superStyle_tr :: MPChar
_superStyle_tr = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
1
    , _superStyle_bl :: MPChar
_superStyle_bl = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
2
    , _superStyle_br :: MPChar
_superStyle_br = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
3
    , _superStyle_vertical :: MPChar
_superStyle_vertical   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
4
    , _superStyle_horizontal :: MPChar
_superStyle_horizontal = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
5
    , _superStyle_point :: MPChar
_superStyle_point = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
chars forall a. [a] -> Int -> a
L.!! Int
6
    , _superStyle_fill :: FillStyle
_superStyle_fill = if Int
l forall a. Eq a => a -> a -> Bool
== Int
7 then FillStyle
FillStyle_Blank else Char -> FillStyle
FillStyle_Simple ([Char]
chars forall a. [a] -> Int -> a
L.!! Int
7)
  }

-- superStyle_fromListFormat "╔╗╚╝║═█" `shouldBe` def
-- empty styles are converted to space character
superStyle_toListFormat :: SuperStyle -> [PChar]
superStyle_toListFormat :: SuperStyle -> [Char]
superStyle_toListFormat SuperStyle {MPChar
FillStyle
_superStyle_fill :: FillStyle
_superStyle_point :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_vertical :: MPChar
_superStyle_br :: MPChar
_superStyle_bl :: MPChar
_superStyle_tr :: MPChar
_superStyle_tl :: MPChar
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_point :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_tl :: SuperStyle -> MPChar
..} = [Char]
r where
  mfill :: [Char]
mfill = case FillStyle
_superStyle_fill of
    FillStyle
FillStyle_Blank    -> []
    FillStyle_Simple Char
c -> [Char
c]
  r :: [Char]
r = [
      forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_tl
      ,forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_tr
      ,forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_bl
      ,forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_br
      ,forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_vertical
      ,forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_horizontal
      ,forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_point
    ] forall a. Semigroup a => a -> a -> a
<> [Char]
mfill

-- |
data TextAlign = TextAlign_Left | TextAlign_Right | TextAlign_Center deriving (TextAlign -> TextAlign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextAlign -> TextAlign -> Bool
$c/= :: TextAlign -> TextAlign -> Bool
== :: TextAlign -> TextAlign -> Bool
$c== :: TextAlign -> TextAlign -> Bool
Eq, forall x. Rep TextAlign x -> TextAlign
forall x. TextAlign -> Rep TextAlign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextAlign x -> TextAlign
$cfrom :: forall x. TextAlign -> Rep TextAlign x
Generic, Int -> TextAlign -> ShowS
[TextAlign] -> ShowS
TextAlign -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TextAlign] -> ShowS
$cshowList :: [TextAlign] -> ShowS
show :: TextAlign -> [Char]
$cshow :: TextAlign -> [Char]
showsPrec :: Int -> TextAlign -> ShowS
$cshowsPrec :: Int -> TextAlign -> ShowS
Show)

instance FromJSON TextAlign
instance ToJSON TextAlign
instance Binary TextAlign
instance NFData TextAlign

instance Default TextAlign where
  def :: TextAlign
def = TextAlign
TextAlign_Left

convertTextAlignToTextZipperTextAlignment :: TextAlign -> TZ.TextAlignment
convertTextAlignToTextZipperTextAlignment :: TextAlign -> TextAlignment
convertTextAlignToTextZipperTextAlignment = \case
  TextAlign
TextAlign_Left -> TextAlignment
TZ.TextAlignment_Left
  TextAlign
TextAlign_Right -> TextAlignment
TZ.TextAlignment_Right
  TextAlign
TextAlign_Center -> TextAlignment
TZ.TextAlignment_Center

-- |
data TextStyle = TextStyle {
  -- margins
  TextStyle -> TextAlign
_textStyle_alignment :: TextAlign
} deriving (TextStyle -> TextStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextStyle -> TextStyle -> Bool
$c/= :: TextStyle -> TextStyle -> Bool
== :: TextStyle -> TextStyle -> Bool
$c== :: TextStyle -> TextStyle -> Bool
Eq, forall x. Rep TextStyle x -> TextStyle
forall x. TextStyle -> Rep TextStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextStyle x -> TextStyle
$cfrom :: forall x. TextStyle -> Rep TextStyle x
Generic)

instance FromJSON TextStyle
instance ToJSON TextStyle
instance Binary TextStyle
instance NFData TextStyle

instance Default TextStyle where
  def :: TextStyle
def = TextStyle { _textStyle_alignment :: TextAlign
_textStyle_alignment = forall a. Default a => a
def }

instance Show TextStyle where
  show :: TextStyle -> [Char]
show TextStyle {TextAlign
_textStyle_alignment :: TextAlign
_textStyle_alignment :: TextStyle -> TextAlign
..} = forall b a. (Show a, IsString b) => a -> b
show TextAlign
_textStyle_alignment


-- TODO you need support for AL_Any and maybe AL_Center
-- TODO lowercase plz
data AttachmentLocation = AL_Top | AL_Bot | AL_Left | AL_Right | AL_Any deriving (AttachmentLocation -> AttachmentLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachmentLocation -> AttachmentLocation -> Bool
$c/= :: AttachmentLocation -> AttachmentLocation -> Bool
== :: AttachmentLocation -> AttachmentLocation -> Bool
$c== :: AttachmentLocation -> AttachmentLocation -> Bool
Eq, forall x. Rep AttachmentLocation x -> AttachmentLocation
forall x. AttachmentLocation -> Rep AttachmentLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachmentLocation x -> AttachmentLocation
$cfrom :: forall x. AttachmentLocation -> Rep AttachmentLocation x
Generic, Int -> AttachmentLocation -> ShowS
[AttachmentLocation] -> ShowS
AttachmentLocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AttachmentLocation] -> ShowS
$cshowList :: [AttachmentLocation] -> ShowS
show :: AttachmentLocation -> [Char]
$cshow :: AttachmentLocation -> [Char]
showsPrec :: Int -> AttachmentLocation -> ShowS
$cshowsPrec :: Int -> AttachmentLocation -> ShowS
Show)

instance FromJSON AttachmentLocation
instance ToJSON AttachmentLocation
instance Binary AttachmentLocation
instance NFData AttachmentLocation

type AttachmentOffsetRatio = Ratio Int

data Attachment = Attachment {
  Attachment -> Int
_attachment_target :: REltId
  , Attachment -> AttachmentLocation
_attachment_location :: AttachmentLocation
  -- you can prob just delete these, don't think we need them.
  -- 1 is right/down most, 0 is left/top most, `1 % 2` is the middle
  , Attachment -> AttachmentOffsetRatio
_attachment_offset_rel :: AttachmentOffsetRatio
} deriving (Attachment -> Attachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attachment -> Attachment -> Bool
$c/= :: Attachment -> Attachment -> Bool
== :: Attachment -> Attachment -> Bool
$c== :: Attachment -> Attachment -> Bool
Eq, forall x. Rep Attachment x -> Attachment
forall x. Attachment -> Rep Attachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attachment x -> Attachment
$cfrom :: forall x. Attachment -> Rep Attachment x
Generic, Int -> Attachment -> ShowS
[Attachment] -> ShowS
Attachment -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Attachment] -> ShowS
$cshowList :: [Attachment] -> ShowS
show :: Attachment -> [Char]
$cshow :: Attachment -> [Char]
showsPrec :: Int -> Attachment -> ShowS
$cshowsPrec :: Int -> Attachment -> ShowS
Show)

instance FromJSON Attachment
instance ToJSON Attachment
instance Binary Attachment
instance NFData Attachment


attachment_offset_rel_default :: Ratio Int
attachment_offset_rel_default :: AttachmentOffsetRatio
attachment_offset_rel_default =  Int
1 forall a. Integral a => a -> a -> Ratio a
% Int
2

attachment_create_default :: REltId -> AttachmentLocation -> Attachment
attachment_create_default :: Int -> AttachmentLocation -> Attachment
attachment_create_default Int
rid AttachmentLocation
al = Attachment {
    _attachment_target :: Int
_attachment_target = Int
rid
    , _attachment_location :: AttachmentLocation
_attachment_location = AttachmentLocation
al
    , _attachment_offset_rel :: AttachmentOffsetRatio
_attachment_offset_rel = AttachmentOffsetRatio
attachment_offset_rel_default
  }

-- |
data SBoxTitle = SBoxTitle {
  SBoxTitle -> Maybe Text
_sBoxTitle_title   :: Maybe Text
  , SBoxTitle -> TextAlign
_sBoxTitle_align :: TextAlign
} deriving (SBoxTitle -> SBoxTitle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SBoxTitle -> SBoxTitle -> Bool
$c/= :: SBoxTitle -> SBoxTitle -> Bool
== :: SBoxTitle -> SBoxTitle -> Bool
$c== :: SBoxTitle -> SBoxTitle -> Bool
Eq, forall x. Rep SBoxTitle x -> SBoxTitle
forall x. SBoxTitle -> Rep SBoxTitle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SBoxTitle x -> SBoxTitle
$cfrom :: forall x. SBoxTitle -> Rep SBoxTitle x
Generic)

instance FromJSON SBoxTitle
instance ToJSON SBoxTitle
instance Binary SBoxTitle
instance NFData SBoxTitle

instance Default SBoxTitle where
  def :: SBoxTitle
def = SBoxTitle {
      _sBoxTitle_title :: Maybe Text
_sBoxTitle_title = forall a. Maybe a
Nothing
      , _sBoxTitle_align :: TextAlign
_sBoxTitle_align = forall a. Default a => a
def
    }

instance Show SBoxTitle where
  show :: SBoxTitle -> [Char]
show SBoxTitle {Maybe Text
TextAlign
_sBoxTitle_align :: TextAlign
_sBoxTitle_title :: Maybe Text
_sBoxTitle_align :: SBoxTitle -> TextAlign
_sBoxTitle_title :: SBoxTitle -> Maybe Text
..} = [Char]
"SBoxTitle: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show TextAlign
_sBoxTitle_align forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Maybe Text
_sBoxTitle_title

-- |
data SBoxText = SBoxText {
  SBoxText -> Text
_sBoxText_text    :: Text
  , SBoxText -> TextStyle
_sBoxText_style :: TextStyle
} deriving (SBoxText -> SBoxText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SBoxText -> SBoxText -> Bool
$c/= :: SBoxText -> SBoxText -> Bool
== :: SBoxText -> SBoxText -> Bool
$c== :: SBoxText -> SBoxText -> Bool
Eq, forall x. Rep SBoxText x -> SBoxText
forall x. SBoxText -> Rep SBoxText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SBoxText x -> SBoxText
$cfrom :: forall x. SBoxText -> Rep SBoxText x
Generic)

instance FromJSON SBoxText
instance ToJSON SBoxText
instance Binary SBoxText
instance NFData SBoxText

instance Default SBoxText where
  def :: SBoxText
def = SBoxText {
      _sBoxText_text :: Text
_sBoxText_text = Text
""
      , _sBoxText_style :: TextStyle
_sBoxText_style = forall a. Default a => a
def
    }

instance Show SBoxText where
  show :: SBoxText -> [Char]
show SBoxText {Text
TextStyle
_sBoxText_style :: TextStyle
_sBoxText_text :: Text
_sBoxText_style :: SBoxText -> TextStyle
_sBoxText_text :: SBoxText -> Text
..} = [Char]
"SBoxText: " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
_sBoxText_text forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show TextStyle
_sBoxText_style


data SBoxType = SBoxType_Box | SBoxType_NoBox | SBoxType_BoxText | SBoxType_NoBoxText deriving (SBoxType -> SBoxType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SBoxType -> SBoxType -> Bool
$c/= :: SBoxType -> SBoxType -> Bool
== :: SBoxType -> SBoxType -> Bool
$c== :: SBoxType -> SBoxType -> Bool
Eq, forall x. Rep SBoxType x -> SBoxType
forall x. SBoxType -> Rep SBoxType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SBoxType x -> SBoxType
$cfrom :: forall x. SBoxType -> Rep SBoxType x
Generic, Int -> SBoxType -> ShowS
[SBoxType] -> ShowS
SBoxType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SBoxType] -> ShowS
$cshowList :: [SBoxType] -> ShowS
show :: SBoxType -> [Char]
$cshow :: SBoxType -> [Char]
showsPrec :: Int -> SBoxType -> ShowS
$cshowsPrec :: Int -> SBoxType -> ShowS
Show)

instance FromJSON SBoxType
instance ToJSON SBoxType
instance Binary SBoxType
instance NFData SBoxType

instance Default SBoxType where
  def :: SBoxType
def = SBoxType
SBoxType_Box

sBoxType_isText :: SBoxType -> Bool
sBoxType_isText :: SBoxType -> Bool
sBoxType_isText SBoxType
sbt = SBoxType
sbt forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_BoxText Bool -> Bool -> Bool
|| SBoxType
sbt forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_NoBoxText

sBoxType_hasBorder :: SBoxType -> Bool
sBoxType_hasBorder :: SBoxType -> Bool
sBoxType_hasBorder SBoxType
sbt = SBoxType
sbt forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_Box Bool -> Bool -> Bool
|| SBoxType
sbt forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_BoxText

make_sBoxType :: Bool -> Bool -> SBoxType
make_sBoxType :: Bool -> Bool -> SBoxType
make_sBoxType Bool
border Bool
text = if Bool
border
  then if Bool
text
    then SBoxType
SBoxType_BoxText
    else SBoxType
SBoxType_Box
  else if Bool
text
    then SBoxType
SBoxType_NoBoxText
    else SBoxType
SBoxType_NoBox

-- |
data SBox = SBox {
  SBox -> LBox
_sBox_box       :: LBox
  , SBox -> SuperStyle
_sBox_superStyle   :: SuperStyle
  , SBox -> SBoxTitle
_sBox_title   :: SBoxTitle
  , SBox -> SBoxText
_sBox_text    :: SBoxText
  , SBox -> SBoxType
_sBox_boxType :: SBoxType
} deriving (SBox -> SBox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SBox -> SBox -> Bool
$c/= :: SBox -> SBox -> Bool
== :: SBox -> SBox -> Bool
$c== :: SBox -> SBox -> Bool
Eq, forall x. Rep SBox x -> SBox
forall x. SBox -> Rep SBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SBox x -> SBox
$cfrom :: forall x. SBox -> Rep SBox x
Generic)

instance FromJSON SBox
instance ToJSON SBox
instance Binary SBox
instance NFData SBox

instance Default SBox where
  def :: SBox
def = SBox {
      _sBox_box :: LBox
_sBox_box     = V2 Int -> V2 Int -> LBox
LBox V2 Int
0 V2 Int
0
      , _sBox_superStyle :: SuperStyle
_sBox_superStyle = forall a. Default a => a
def
      , _sBox_title :: SBoxTitle
_sBox_title = forall a. Default a => a
def
      , _sBox_text :: SBoxText
_sBox_text  = forall a. Default a => a
def
      , _sBox_boxType :: SBoxType
_sBox_boxType = SBoxType
SBoxType_Box
    }

instance Show SBox where
  show :: SBox -> [Char]
show 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
..} = [Char]
"SBox: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show LBox
_sBox_box forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SBoxTitle
_sBox_title forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SBoxText
_sBox_text forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SBoxType
_sBox_boxType forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SuperStyle
_sBox_superStyle

sBox_hasLabel :: SBox -> Bool
sBox_hasLabel :: SBox -> Bool
sBox_hasLabel SBox
sbox = SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox) Bool -> Bool -> Bool
&& (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxTitle -> Maybe Text
_sBoxTitle_title forall b c a. (b -> c) -> (a -> b) -> a -> c
.SBox -> SBoxTitle
_sBox_title forall a b. (a -> b) -> a -> b
$ SBox
sbox)

-- TODO DELETE no longer used with SAutoLine
data LineAutoStyle =
  LineAutoStyle_Auto
  | LineAutoStyle_AutoStraight
  | LineAutoStyle_StraightAlwaysHorizontal
  | LineAutoStyle_StraightAlwaysVertical
  deriving (LineAutoStyle -> LineAutoStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineAutoStyle -> LineAutoStyle -> Bool
$c/= :: LineAutoStyle -> LineAutoStyle -> Bool
== :: LineAutoStyle -> LineAutoStyle -> Bool
$c== :: LineAutoStyle -> LineAutoStyle -> Bool
Eq, forall x. Rep LineAutoStyle x -> LineAutoStyle
forall x. LineAutoStyle -> Rep LineAutoStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineAutoStyle x -> LineAutoStyle
$cfrom :: forall x. LineAutoStyle -> Rep LineAutoStyle x
Generic, Int -> LineAutoStyle -> ShowS
[LineAutoStyle] -> ShowS
LineAutoStyle -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LineAutoStyle] -> ShowS
$cshowList :: [LineAutoStyle] -> ShowS
show :: LineAutoStyle -> [Char]
$cshow :: LineAutoStyle -> [Char]
showsPrec :: Int -> LineAutoStyle -> ShowS
$cshowsPrec :: Int -> LineAutoStyle -> ShowS
Show)

instance FromJSON LineAutoStyle
instance ToJSON LineAutoStyle
instance Binary LineAutoStyle
instance NFData LineAutoStyle

instance Default LineAutoStyle where
  def :: LineAutoStyle
def = LineAutoStyle
LineAutoStyle_AutoStraight


data LineStyle = LineStyle {
  LineStyle -> Text
_lineStyle_leftArrows    :: Text
  , LineStyle -> Text
_lineStyle_rightArrows :: Text
  , LineStyle -> Text
_lineStyle_upArrows    :: Text
  , LineStyle -> Text
_lineStyle_downArrows  :: Text
} deriving (LineStyle -> LineStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c== :: LineStyle -> LineStyle -> Bool
Eq, forall x. Rep LineStyle x -> LineStyle
forall x. LineStyle -> Rep LineStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineStyle x -> LineStyle
$cfrom :: forall x. LineStyle -> Rep LineStyle x
Generic)

instance FromJSON LineStyle
instance ToJSON LineStyle
instance Binary LineStyle
instance NFData LineStyle

instance Default LineStyle where
  def :: LineStyle
def = LineStyle {
      _lineStyle_leftArrows :: Text
_lineStyle_leftArrows    = Text
"<"
      , _lineStyle_rightArrows :: Text
_lineStyle_rightArrows = Text
">"
      , _lineStyle_upArrows :: Text
_lineStyle_upArrows    = Text
"^"
      , _lineStyle_downArrows :: Text
_lineStyle_downArrows  = Text
"v"
    }

lineStyle_fromListFormat :: ([PChar], [PChar], [PChar], [PChar]) -> LineStyle
lineStyle_fromListFormat :: ([Char], [Char], [Char], [Char]) -> LineStyle
lineStyle_fromListFormat ([Char]
l,[Char]
r,[Char]
u,[Char]
d) = LineStyle {
    _lineStyle_leftArrows :: Text
_lineStyle_leftArrows    = [Char] -> Text
T.pack [Char]
l
    , _lineStyle_rightArrows :: Text
_lineStyle_rightArrows = [Char] -> Text
T.pack [Char]
r
    , _lineStyle_upArrows :: Text
_lineStyle_upArrows    = [Char] -> Text
T.pack [Char]
u
    , _lineStyle_downArrows :: Text
_lineStyle_downArrows  = [Char] -> Text
T.pack [Char]
d
  }

lineStyle_toListFormat :: LineStyle -> ([PChar], [PChar], [PChar], [PChar])
lineStyle_toListFormat :: LineStyle -> ([Char], [Char], [Char], [Char])
lineStyle_toListFormat LineStyle {Text
_lineStyle_downArrows :: Text
_lineStyle_upArrows :: Text
_lineStyle_rightArrows :: Text
_lineStyle_leftArrows :: Text
_lineStyle_downArrows :: LineStyle -> Text
_lineStyle_upArrows :: LineStyle -> Text
_lineStyle_rightArrows :: LineStyle -> Text
_lineStyle_leftArrows :: LineStyle -> Text
..} = (Text -> [Char]
T.unpack Text
_lineStyle_leftArrows, Text -> [Char]
T.unpack Text
_lineStyle_rightArrows, Text -> [Char]
T.unpack Text
_lineStyle_upArrows, Text -> [Char]
T.unpack Text
_lineStyle_downArrows)


instance Show LineStyle where
  show :: LineStyle -> [Char]
show LineStyle
ls = [Char]
r where
    ([Char]
a, [Char]
b, [Char]
c, [Char]
d) = LineStyle -> ([Char], [Char], [Char], [Char])
lineStyle_toListFormat LineStyle
ls
    r :: [Char]
r = [Char]
"LineStyle: " forall a. Semigroup a => a -> a -> a
<> [Char]
a forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [Char]
b forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [Char]
c forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [Char]
d

-- someday we might have more than one constraint...
data SAutoLineConstraint = SAutoLineConstraintFixed XY deriving (SAutoLineConstraint -> SAutoLineConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
$c/= :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
== :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
$c== :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
Eq, forall x. Rep SAutoLineConstraint x -> SAutoLineConstraint
forall x. SAutoLineConstraint -> Rep SAutoLineConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SAutoLineConstraint x -> SAutoLineConstraint
$cfrom :: forall x. SAutoLineConstraint -> Rep SAutoLineConstraint x
Generic, Int -> SAutoLineConstraint -> ShowS
[SAutoLineConstraint] -> ShowS
SAutoLineConstraint -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SAutoLineConstraint] -> ShowS
$cshowList :: [SAutoLineConstraint] -> ShowS
show :: SAutoLineConstraint -> [Char]
$cshow :: SAutoLineConstraint -> [Char]
showsPrec :: Int -> SAutoLineConstraint -> ShowS
$cshowsPrec :: Int -> SAutoLineConstraint -> ShowS
Show)

instance FromJSON SAutoLineConstraint
instance ToJSON SAutoLineConstraint
instance Binary SAutoLineConstraint
instance NFData SAutoLineConstraint

-- TODO provide absolute and relative positioning args
data SAutoLineLabelPosition =
  SAutoLineLabelPositionRelative Float -- 0 is at "left" anchor point and 1 is at "right" anchor point
  deriving (SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
$c/= :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
== :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
$c== :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
Eq, forall x. Rep SAutoLineLabelPosition x -> SAutoLineLabelPosition
forall x. SAutoLineLabelPosition -> Rep SAutoLineLabelPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SAutoLineLabelPosition x -> SAutoLineLabelPosition
$cfrom :: forall x. SAutoLineLabelPosition -> Rep SAutoLineLabelPosition x
Generic, Int -> SAutoLineLabelPosition -> ShowS
[SAutoLineLabelPosition] -> ShowS
SAutoLineLabelPosition -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SAutoLineLabelPosition] -> ShowS
$cshowList :: [SAutoLineLabelPosition] -> ShowS
show :: SAutoLineLabelPosition -> [Char]
$cshow :: SAutoLineLabelPosition -> [Char]
showsPrec :: Int -> SAutoLineLabelPosition -> ShowS
$cshowsPrec :: Int -> SAutoLineLabelPosition -> ShowS
Show)

instance FromJSON SAutoLineLabelPosition
instance ToJSON SAutoLineLabelPosition
instance Binary SAutoLineLabelPosition
instance NFData SAutoLineLabelPosition

data SAutoLineLabel = SAutoLineLabel {
  SAutoLineLabel -> Int
_sAutoLineLabel_index :: Int -- index relative to _sAutoLine_midpoints for where the midpoint lives
  , SAutoLineLabel -> SAutoLineLabelPosition
_sAutoLineLabel_position :: SAutoLineLabelPosition
  , SAutoLineLabel -> Text
_sAutoLineLabel_text :: Text
  --, _sAutoLineLabel_vertical :: Bool -- WIP true if vertically oriented
} deriving (SAutoLineLabel -> SAutoLineLabel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SAutoLineLabel -> SAutoLineLabel -> Bool
$c/= :: SAutoLineLabel -> SAutoLineLabel -> Bool
== :: SAutoLineLabel -> SAutoLineLabel -> Bool
$c== :: SAutoLineLabel -> SAutoLineLabel -> Bool
Eq, forall x. Rep SAutoLineLabel x -> SAutoLineLabel
forall x. SAutoLineLabel -> Rep SAutoLineLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SAutoLineLabel x -> SAutoLineLabel
$cfrom :: forall x. SAutoLineLabel -> Rep SAutoLineLabel x
Generic)

instance Show SAutoLineLabel where
  show :: SAutoLineLabel -> [Char]
show SAutoLineLabel {Int
Text
SAutoLineLabelPosition
_sAutoLineLabel_text :: Text
_sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_index :: Int
_sAutoLineLabel_text :: SAutoLineLabel -> Text
_sAutoLineLabel_position :: SAutoLineLabel -> SAutoLineLabelPosition
_sAutoLineLabel_index :: SAutoLineLabel -> Int
..} = [Char]
"SAutoLineLabel: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
_sAutoLineLabel_index forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SAutoLineLabelPosition
_sAutoLineLabel_position forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
_sAutoLineLabel_text

instance FromJSON SAutoLineLabel
instance ToJSON SAutoLineLabel
instance Binary SAutoLineLabel
instance NFData SAutoLineLabel

instance Default SAutoLineLabel where
  def :: SAutoLineLabel
def = SAutoLineLabel {
      -- anchor index, text shows AFTER index
      _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = Int
0
      , _sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_position = Float -> SAutoLineLabelPosition
SAutoLineLabelPositionRelative Float
0
      , _sAutoLineLabel_text :: Text
_sAutoLineLabel_text = Text
""
      --, _sAutoLineLabel_vertical = False
    }


-- |
data SAutoLine = SAutoLine {
  SAutoLine -> V2 Int
_sAutoLine_start       :: XY
  , SAutoLine -> V2 Int
_sAutoLine_end       :: XY
  , SAutoLine -> SuperStyle
_sAutoLine_superStyle     :: SuperStyle

  -- TODO you need one for start/end of line (LineStyle, LineStyle)
  , SAutoLine -> LineStyle
_sAutoLine_lineStyle :: LineStyle
  , SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: LineStyle

  -- NOTE attachments currently are not guaranteed to exist
  -- in particular, if you copy a line, delete its target and paste, it will be attached to something that doesn't exist
  -- tinytools will attempt to correct attachment in some cases but don't get too cozy about it!
  , SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
  , SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment

  , SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints :: [SAutoLineConstraint]
  , SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels :: [SAutoLineLabel] -- WIP currently does nothing
} deriving (SAutoLine -> SAutoLine -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SAutoLine -> SAutoLine -> Bool
$c/= :: SAutoLine -> SAutoLine -> Bool
== :: SAutoLine -> SAutoLine -> Bool
$c== :: SAutoLine -> SAutoLine -> Bool
Eq, forall x. Rep SAutoLine x -> SAutoLine
forall x. SAutoLine -> Rep SAutoLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SAutoLine x -> SAutoLine
$cfrom :: forall x. SAutoLine -> Rep SAutoLine x
Generic)

instance FromJSON SAutoLine
instance ToJSON SAutoLine
instance Binary SAutoLine
instance NFData SAutoLine

instance Show SAutoLine where
  show :: SAutoLine -> [Char]
show SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
V2 Int
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 :: V2 Int
_sAutoLine_start :: V2 Int
_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 -> V2 Int
_sAutoLine_start :: SAutoLine -> V2 Int
..} = [Char]
r where
    start :: [Char]
start = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall b a. (Show a, IsString b) => a -> b
show V2 Int
_sAutoLine_start) forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
_sAutoLine_attachStart
    end :: [Char]
end = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall b a. (Show a, IsString b) => a -> b
show V2 Int
_sAutoLine_end) forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
_sAutoLine_attachEnd
    r :: [Char]
r = [Char]
"SAutoLine: " forall a. Semigroup a => a -> a -> a
<> [Char]
start forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [Char]
end forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [SAutoLineConstraint]
_sAutoLine_midpoints forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [SAutoLineLabel]
_sAutoLine_labels

-- makes writing tests easier...
instance Default SAutoLine where
  def :: SAutoLine
def = SAutoLine {
      _sAutoLine_start :: V2 Int
_sAutoLine_start       = V2 Int
0
      , _sAutoLine_end :: V2 Int
_sAutoLine_end       = V2 Int
0
      , _sAutoLine_superStyle :: SuperStyle
_sAutoLine_superStyle     = forall a. Default a => a
def
      , _sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyle = forall a. Default a => a
def
      , _sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyleEnd = forall a. Default a => a
def
      , _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = forall a. Maybe a
Nothing
      , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = forall a. Maybe a
Nothing
      , _sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = []
      , _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = []
    }

-- TODO DELETE
-- |
data SCartLines = SCartLines {
  SCartLines -> V2 Int
_sCartLines_start   :: XY
  , SCartLines -> NonEmpty (Either Int Int)
_sCartLines_ends  :: NonEmpty (Either Int Int)
  , SCartLines -> SuperStyle
_sCartLines_style :: SuperStyle
} deriving (SCartLines -> SCartLines -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SCartLines -> SCartLines -> Bool
$c/= :: SCartLines -> SCartLines -> Bool
== :: SCartLines -> SCartLines -> Bool
$c== :: SCartLines -> SCartLines -> Bool
Eq, forall x. Rep SCartLines x -> SCartLines
forall x. SCartLines -> Rep SCartLines x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SCartLines x -> SCartLines
$cfrom :: forall x. SCartLines -> Rep SCartLines x
Generic, Int -> SCartLines -> ShowS
[SCartLines] -> ShowS
SCartLines -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SCartLines] -> ShowS
$cshowList :: [SCartLines] -> ShowS
show :: SCartLines -> [Char]
$cshow :: SCartLines -> [Char]
showsPrec :: Int -> SCartLines -> ShowS
$cshowsPrec :: Int -> SCartLines -> ShowS
Show)

instance FromJSON SCartLines
instance ToJSON SCartLines
instance Binary SCartLines
instance NFData SCartLines

type TextAreaMapping = Map XY PChar

-- | abitrary text confined to a box
data STextArea = STextArea {
  STextArea -> LBox
_sTextArea_box           :: LBox
  , STextArea -> TextAreaMapping
_sTextArea_text        :: TextAreaMapping
  -- TODO consider using SuperStyle here instead and using Fill property only
  , STextArea -> Bool
_sTextArea_transparent :: Bool
} deriving (STextArea -> STextArea -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: STextArea -> STextArea -> Bool
$c/= :: STextArea -> STextArea -> Bool
== :: STextArea -> STextArea -> Bool
$c== :: STextArea -> STextArea -> Bool
Eq, forall x. Rep STextArea x -> STextArea
forall x. STextArea -> Rep STextArea x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep STextArea x -> STextArea
$cfrom :: forall x. STextArea -> Rep STextArea x
Generic, Int -> STextArea -> ShowS
[STextArea] -> ShowS
STextArea -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [STextArea] -> ShowS
$cshowList :: [STextArea] -> ShowS
show :: STextArea -> [Char]
$cshow :: STextArea -> [Char]
showsPrec :: Int -> STextArea -> ShowS
$cshowsPrec :: Int -> STextArea -> ShowS
Show)

instance Default STextArea where
  def :: STextArea
def = STextArea {
      _sTextArea_box :: LBox
_sTextArea_box   =        V2 Int -> V2 Int -> LBox
LBox V2 Int
0 V2 Int
0
      , _sTextArea_text :: TextAreaMapping
_sTextArea_text        = forall k a. Map k a
Map.empty
      , _sTextArea_transparent :: Bool
_sTextArea_transparent = Bool
True
    }

instance FromJSON STextArea
instance ToJSON STextArea
instance Binary STextArea
instance NFData STextArea

-- TODO consider removing this all together and serializing Owl stuff directly
data SElt =
  SEltNone
  | SEltFolderStart
  | SEltFolderEnd
  | SEltBox SBox
  | SEltLine SAutoLine
  | SEltTextArea STextArea
  deriving (SElt -> SElt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SElt -> SElt -> Bool
$c/= :: SElt -> SElt -> Bool
== :: SElt -> SElt -> Bool
$c== :: SElt -> SElt -> Bool
Eq, forall x. Rep SElt x -> SElt
forall x. SElt -> Rep SElt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SElt x -> SElt
$cfrom :: forall x. SElt -> Rep SElt x
Generic, Int -> SElt -> ShowS
[SElt] -> ShowS
SElt -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SElt] -> ShowS
$cshowList :: [SElt] -> ShowS
show :: SElt -> [Char]
$cshow :: SElt -> [Char]
showsPrec :: Int -> SElt -> ShowS
$cshowsPrec :: Int -> SElt -> ShowS
Show)

instance FromJSON SElt
instance ToJSON SElt
instance Binary SElt
instance NFData SElt

-- TODO consider removing this all together and serializing Owl stuff directly
data SEltLabel = SEltLabel {
 SEltLabel -> Text
_sEltLabel_name   :: Text
 , SEltLabel -> SElt
_sEltLabel_sElt :: SElt
} deriving (SEltLabel -> SEltLabel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SEltLabel -> SEltLabel -> Bool
$c/= :: SEltLabel -> SEltLabel -> Bool
== :: SEltLabel -> SEltLabel -> Bool
$c== :: SEltLabel -> SEltLabel -> Bool
Eq, forall x. Rep SEltLabel x -> SEltLabel
forall x. SEltLabel -> Rep SEltLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SEltLabel x -> SEltLabel
$cfrom :: forall x. SEltLabel -> Rep SEltLabel x
Generic, Int -> SEltLabel -> ShowS
[SEltLabel] -> ShowS
SEltLabel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SEltLabel] -> ShowS
$cshowList :: [SEltLabel] -> ShowS
show :: SEltLabel -> [Char]
$cshow :: SEltLabel -> [Char]
showsPrec :: Int -> SEltLabel -> ShowS
$cshowsPrec :: Int -> SEltLabel -> ShowS
Show)

instance FromJSON SEltLabel
instance ToJSON SEltLabel
instance Binary SEltLabel
instance NFData SEltLabel