{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Serialization.Versions.V1.SElts where

import           Relude

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

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
(FillStyle -> FillStyle -> Bool)
-> (FillStyle -> FillStyle -> Bool) -> Eq FillStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FillStyle -> FillStyle -> Bool
== :: FillStyle -> FillStyle -> Bool
$c/= :: FillStyle -> FillStyle -> Bool
/= :: FillStyle -> FillStyle -> Bool
Eq, (forall x. FillStyle -> Rep FillStyle x)
-> (forall x. Rep FillStyle x -> FillStyle) -> Generic FillStyle
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
$cfrom :: forall x. FillStyle -> Rep FillStyle x
from :: forall x. FillStyle -> Rep FillStyle x
$cto :: forall x. Rep FillStyle x -> FillStyle
to :: forall x. Rep FillStyle x -> FillStyle
Generic, Int -> FillStyle -> ShowS
[FillStyle] -> ShowS
FillStyle -> [Char]
(Int -> FillStyle -> ShowS)
-> (FillStyle -> [Char])
-> ([FillStyle] -> ShowS)
-> Show FillStyle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FillStyle -> ShowS
showsPrec :: Int -> FillStyle -> ShowS
$cshow :: FillStyle -> [Char]
show :: FillStyle -> [Char]
$cshowList :: [FillStyle] -> ShowS
showList :: [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
(SuperStyle -> SuperStyle -> Bool)
-> (SuperStyle -> SuperStyle -> Bool) -> Eq SuperStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SuperStyle -> SuperStyle -> Bool
== :: SuperStyle -> SuperStyle -> Bool
$c/= :: SuperStyle -> SuperStyle -> Bool
/= :: SuperStyle -> SuperStyle -> Bool
Eq, (forall x. SuperStyle -> Rep SuperStyle x)
-> (forall x. Rep SuperStyle x -> SuperStyle) -> Generic SuperStyle
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
$cfrom :: forall x. SuperStyle -> Rep SuperStyle x
from :: forall x. SuperStyle -> Rep SuperStyle x
$cto :: forall x. Rep SuperStyle x -> SuperStyle
to :: forall x. Rep SuperStyle x -> SuperStyle
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 = Char -> MPChar
forall a. a -> Maybe a
Just Char
'╔'
    , _superStyle_tr :: MPChar
_superStyle_tr = Char -> MPChar
forall a. a -> Maybe a
Just Char
'╗'
    , _superStyle_bl :: MPChar
_superStyle_bl = Char -> MPChar
forall a. a -> Maybe a
Just Char
'╚'
    , _superStyle_br :: MPChar
_superStyle_br = Char -> MPChar
forall a. a -> Maybe a
Just Char
'╝'
    , _superStyle_vertical :: MPChar
_superStyle_vertical   = Char -> MPChar
forall a. a -> Maybe a
Just Char
'║'
    , _superStyle_horizontal :: MPChar
_superStyle_horizontal = Char -> MPChar
forall a. a -> Maybe a
Just Char
'═'
    , _superStyle_point :: MPChar
_superStyle_point = Char -> MPChar
forall a. a -> Maybe a
Just Char
'█'
    , _superStyle_fill :: FillStyle
_superStyle_fill = FillStyle
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 = Bool -> SuperStyle -> SuperStyle
forall a. HasCallStack => Bool -> a -> a
assert (Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8) (SuperStyle -> SuperStyle) -> SuperStyle -> SuperStyle
forall a b. (a -> b) -> a -> b
$ SuperStyle
r where
  l :: Int
l = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
chars
  r :: SuperStyle
r = SuperStyle {
    _superStyle_tl :: MPChar
_superStyle_tl = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
0
    , _superStyle_tr :: MPChar
_superStyle_tr = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
1
    , _superStyle_bl :: MPChar
_superStyle_bl = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
2
    , _superStyle_br :: MPChar
_superStyle_br = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
3
    , _superStyle_vertical :: MPChar
_superStyle_vertical   = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
4
    , _superStyle_horizontal :: MPChar
_superStyle_horizontal = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
5
    , _superStyle_point :: MPChar
_superStyle_point = Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ [Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
L.!! Int
6
    , _superStyle_fill :: FillStyle
_superStyle_fill = if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 then FillStyle
FillStyle_Blank else Char -> FillStyle
FillStyle_Simple ([Char]
chars [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` 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_tl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_point :: SuperStyle -> MPChar
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_tl :: MPChar
_superStyle_tr :: MPChar
_superStyle_bl :: MPChar
_superStyle_br :: MPChar
_superStyle_vertical :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_point :: MPChar
_superStyle_fill :: FillStyle
..} = [Char]
r where
  mfill :: [Char]
mfill = case FillStyle
_superStyle_fill of
    FillStyle
FillStyle_Blank    -> []
    FillStyle_Simple Char
c -> [Char
c]
  r :: [Char]
r = [
      Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_tl
      ,Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_tr
      ,Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_bl
      ,Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_br
      ,Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_vertical
      ,Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_horizontal
      ,Char -> MPChar -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' MPChar
_superStyle_point
    ] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
mfill

-- |
data TextAlign = TextAlign_Left | TextAlign_Right | TextAlign_Center deriving (TextAlign -> TextAlign -> Bool
(TextAlign -> TextAlign -> Bool)
-> (TextAlign -> TextAlign -> Bool) -> Eq TextAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAlign -> TextAlign -> Bool
== :: TextAlign -> TextAlign -> Bool
$c/= :: TextAlign -> TextAlign -> Bool
/= :: TextAlign -> TextAlign -> Bool
Eq, (forall x. TextAlign -> Rep TextAlign x)
-> (forall x. Rep TextAlign x -> TextAlign) -> Generic TextAlign
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
$cfrom :: forall x. TextAlign -> Rep TextAlign x
from :: forall x. TextAlign -> Rep TextAlign x
$cto :: forall x. Rep TextAlign x -> TextAlign
to :: forall x. Rep TextAlign x -> TextAlign
Generic, Int -> TextAlign -> ShowS
[TextAlign] -> ShowS
TextAlign -> [Char]
(Int -> TextAlign -> ShowS)
-> (TextAlign -> [Char])
-> ([TextAlign] -> ShowS)
-> Show TextAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextAlign -> ShowS
showsPrec :: Int -> TextAlign -> ShowS
$cshow :: TextAlign -> [Char]
show :: TextAlign -> [Char]
$cshowList :: [TextAlign] -> ShowS
showList :: [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
(TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool) -> Eq TextStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextStyle -> TextStyle -> Bool
== :: TextStyle -> TextStyle -> Bool
$c/= :: TextStyle -> TextStyle -> Bool
/= :: TextStyle -> TextStyle -> Bool
Eq, (forall x. TextStyle -> Rep TextStyle x)
-> (forall x. Rep TextStyle x -> TextStyle) -> Generic TextStyle
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
$cfrom :: forall x. TextStyle -> Rep TextStyle x
from :: forall x. TextStyle -> Rep TextStyle x
$cto :: forall x. Rep TextStyle x -> TextStyle
to :: forall x. Rep TextStyle x -> TextStyle
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 = TextAlign
forall a. Default a => a
def }

instance Show TextStyle where
  show :: TextStyle -> [Char]
show TextStyle {TextAlign
_textStyle_alignment :: TextStyle -> TextAlign
_textStyle_alignment :: TextAlign
..} = TextAlign -> [Char]
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
(AttachmentLocation -> AttachmentLocation -> Bool)
-> (AttachmentLocation -> AttachmentLocation -> Bool)
-> Eq AttachmentLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttachmentLocation -> AttachmentLocation -> Bool
== :: AttachmentLocation -> AttachmentLocation -> Bool
$c/= :: AttachmentLocation -> AttachmentLocation -> Bool
/= :: AttachmentLocation -> AttachmentLocation -> Bool
Eq, (forall x. AttachmentLocation -> Rep AttachmentLocation x)
-> (forall x. Rep AttachmentLocation x -> AttachmentLocation)
-> Generic AttachmentLocation
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
$cfrom :: forall x. AttachmentLocation -> Rep AttachmentLocation x
from :: forall x. AttachmentLocation -> Rep AttachmentLocation x
$cto :: forall x. Rep AttachmentLocation x -> AttachmentLocation
to :: forall x. Rep AttachmentLocation x -> AttachmentLocation
Generic, Int -> AttachmentLocation -> ShowS
[AttachmentLocation] -> ShowS
AttachmentLocation -> [Char]
(Int -> AttachmentLocation -> ShowS)
-> (AttachmentLocation -> [Char])
-> ([AttachmentLocation] -> ShowS)
-> Show AttachmentLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttachmentLocation -> ShowS
showsPrec :: Int -> AttachmentLocation -> ShowS
$cshow :: AttachmentLocation -> [Char]
show :: AttachmentLocation -> [Char]
$cshowList :: [AttachmentLocation] -> ShowS
showList :: [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
(Attachment -> Attachment -> Bool)
-> (Attachment -> Attachment -> Bool) -> Eq Attachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attachment -> Attachment -> Bool
== :: Attachment -> Attachment -> Bool
$c/= :: Attachment -> Attachment -> Bool
/= :: Attachment -> Attachment -> Bool
Eq, (forall x. Attachment -> Rep Attachment x)
-> (forall x. Rep Attachment x -> Attachment) -> Generic Attachment
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
$cfrom :: forall x. Attachment -> Rep Attachment x
from :: forall x. Attachment -> Rep Attachment x
$cto :: forall x. Rep Attachment x -> Attachment
to :: forall x. Rep Attachment x -> Attachment
Generic, Int -> Attachment -> ShowS
[Attachment] -> ShowS
Attachment -> [Char]
(Int -> Attachment -> ShowS)
-> (Attachment -> [Char])
-> ([Attachment] -> ShowS)
-> Show Attachment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attachment -> ShowS
showsPrec :: Int -> Attachment -> ShowS
$cshow :: Attachment -> [Char]
show :: Attachment -> [Char]
$cshowList :: [Attachment] -> ShowS
showList :: [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 Int -> Int -> AttachmentOffsetRatio
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
(SBoxTitle -> SBoxTitle -> Bool)
-> (SBoxTitle -> SBoxTitle -> Bool) -> Eq SBoxTitle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBoxTitle -> SBoxTitle -> Bool
== :: SBoxTitle -> SBoxTitle -> Bool
$c/= :: SBoxTitle -> SBoxTitle -> Bool
/= :: SBoxTitle -> SBoxTitle -> Bool
Eq, (forall x. SBoxTitle -> Rep SBoxTitle x)
-> (forall x. Rep SBoxTitle x -> SBoxTitle) -> Generic SBoxTitle
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
$cfrom :: forall x. SBoxTitle -> Rep SBoxTitle x
from :: forall x. SBoxTitle -> Rep SBoxTitle x
$cto :: forall x. Rep SBoxTitle x -> SBoxTitle
to :: forall x. Rep SBoxTitle x -> SBoxTitle
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 = Maybe Text
forall a. Maybe a
Nothing
      , _sBoxTitle_align :: TextAlign
_sBoxTitle_align = TextAlign
forall a. Default a => a
def
    }

instance Show SBoxTitle where
  show :: SBoxTitle -> [Char]
show SBoxTitle {Maybe Text
TextAlign
_sBoxTitle_title :: SBoxTitle -> Maybe Text
_sBoxTitle_align :: SBoxTitle -> TextAlign
_sBoxTitle_title :: Maybe Text
_sBoxTitle_align :: TextAlign
..} = [Char]
"SBoxTitle: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextAlign -> [Char]
forall b a. (Show a, IsString b) => a -> b
show TextAlign
_sBoxTitle_align [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> [Char]
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
(SBoxText -> SBoxText -> Bool)
-> (SBoxText -> SBoxText -> Bool) -> Eq SBoxText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBoxText -> SBoxText -> Bool
== :: SBoxText -> SBoxText -> Bool
$c/= :: SBoxText -> SBoxText -> Bool
/= :: SBoxText -> SBoxText -> Bool
Eq, (forall x. SBoxText -> Rep SBoxText x)
-> (forall x. Rep SBoxText x -> SBoxText) -> Generic SBoxText
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
$cfrom :: forall x. SBoxText -> Rep SBoxText x
from :: forall x. SBoxText -> Rep SBoxText x
$cto :: forall x. Rep SBoxText x -> SBoxText
to :: forall x. Rep SBoxText x -> SBoxText
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 = TextStyle
forall a. Default a => a
def
    }

instance Show SBoxText where
  show :: SBoxText -> [Char]
show SBoxText {Text
TextStyle
_sBoxText_text :: SBoxText -> Text
_sBoxText_style :: SBoxText -> TextStyle
_sBoxText_text :: Text
_sBoxText_style :: TextStyle
..} = [Char]
"SBoxText: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
_sBoxText_text [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextStyle -> [Char]
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
(SBoxType -> SBoxType -> Bool)
-> (SBoxType -> SBoxType -> Bool) -> Eq SBoxType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBoxType -> SBoxType -> Bool
== :: SBoxType -> SBoxType -> Bool
$c/= :: SBoxType -> SBoxType -> Bool
/= :: SBoxType -> SBoxType -> Bool
Eq, (forall x. SBoxType -> Rep SBoxType x)
-> (forall x. Rep SBoxType x -> SBoxType) -> Generic SBoxType
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
$cfrom :: forall x. SBoxType -> Rep SBoxType x
from :: forall x. SBoxType -> Rep SBoxType x
$cto :: forall x. Rep SBoxType x -> SBoxType
to :: forall x. Rep SBoxType x -> SBoxType
Generic, Int -> SBoxType -> ShowS
[SBoxType] -> ShowS
SBoxType -> [Char]
(Int -> SBoxType -> ShowS)
-> (SBoxType -> [Char]) -> ([SBoxType] -> ShowS) -> Show SBoxType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SBoxType -> ShowS
showsPrec :: Int -> SBoxType -> ShowS
$cshow :: SBoxType -> [Char]
show :: SBoxType -> [Char]
$cshowList :: [SBoxType] -> ShowS
showList :: [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 SBoxType -> SBoxType -> Bool
forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_BoxText Bool -> Bool -> Bool
|| SBoxType
sbt SBoxType -> SBoxType -> Bool
forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_NoBoxText

sBoxType_hasBorder :: SBoxType -> Bool
sBoxType_hasBorder :: SBoxType -> Bool
sBoxType_hasBorder SBoxType
sbt = SBoxType
sbt SBoxType -> SBoxType -> Bool
forall a. Eq a => a -> a -> Bool
== SBoxType
SBoxType_Box Bool -> Bool -> Bool
|| SBoxType
sbt SBoxType -> SBoxType -> Bool
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
(SBox -> SBox -> Bool) -> (SBox -> SBox -> Bool) -> Eq SBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBox -> SBox -> Bool
== :: SBox -> SBox -> Bool
$c/= :: SBox -> SBox -> Bool
/= :: SBox -> SBox -> Bool
Eq, (forall x. SBox -> Rep SBox x)
-> (forall x. Rep SBox x -> SBox) -> Generic SBox
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
$cfrom :: forall x. SBox -> Rep SBox x
from :: forall x. SBox -> Rep SBox x
$cto :: forall x. Rep SBox x -> SBox
to :: forall x. Rep SBox x -> SBox
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     = XY -> XY -> LBox
LBox XY
0 XY
0
      , _sBox_superStyle :: SuperStyle
_sBox_superStyle = SuperStyle
forall a. Default a => a
def
      , _sBox_title :: SBoxTitle
_sBox_title = SBoxTitle
forall a. Default a => a
def
      , _sBox_text :: SBoxText
_sBox_text  = SBoxText
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_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
..} = [Char]
"SBox: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> LBox -> [Char]
forall b a. (Show a, IsString b) => a -> b
show LBox
_sBox_box [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SBoxTitle -> [Char]
forall b a. (Show a, IsString b) => a -> b
show SBoxTitle
_sBox_title [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SBoxText -> [Char]
forall b a. (Show a, IsString b) => a -> b
show SBoxText
_sBox_text [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SBoxType -> [Char]
forall b a. (Show a, IsString b) => a -> b
show SBoxType
_sBox_boxType [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SuperStyle -> [Char]
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
&& (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> (SBox -> Maybe Text) -> SBox -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBoxTitle -> Maybe Text
_sBoxTitle_title (SBoxTitle -> Maybe Text)
-> (SBox -> SBoxTitle) -> SBox -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SBox -> SBoxTitle
_sBox_title (SBox -> Bool) -> SBox -> Bool
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
(LineAutoStyle -> LineAutoStyle -> Bool)
-> (LineAutoStyle -> LineAutoStyle -> Bool) -> Eq LineAutoStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineAutoStyle -> LineAutoStyle -> Bool
== :: LineAutoStyle -> LineAutoStyle -> Bool
$c/= :: LineAutoStyle -> LineAutoStyle -> Bool
/= :: LineAutoStyle -> LineAutoStyle -> Bool
Eq, (forall x. LineAutoStyle -> Rep LineAutoStyle x)
-> (forall x. Rep LineAutoStyle x -> LineAutoStyle)
-> Generic LineAutoStyle
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
$cfrom :: forall x. LineAutoStyle -> Rep LineAutoStyle x
from :: forall x. LineAutoStyle -> Rep LineAutoStyle x
$cto :: forall x. Rep LineAutoStyle x -> LineAutoStyle
to :: forall x. Rep LineAutoStyle x -> LineAutoStyle
Generic, Int -> LineAutoStyle -> ShowS
[LineAutoStyle] -> ShowS
LineAutoStyle -> [Char]
(Int -> LineAutoStyle -> ShowS)
-> (LineAutoStyle -> [Char])
-> ([LineAutoStyle] -> ShowS)
-> Show LineAutoStyle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineAutoStyle -> ShowS
showsPrec :: Int -> LineAutoStyle -> ShowS
$cshow :: LineAutoStyle -> [Char]
show :: LineAutoStyle -> [Char]
$cshowList :: [LineAutoStyle] -> ShowS
showList :: [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
(LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool) -> Eq LineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
/= :: LineStyle -> LineStyle -> Bool
Eq, (forall x. LineStyle -> Rep LineStyle x)
-> (forall x. Rep LineStyle x -> LineStyle) -> Generic LineStyle
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
$cfrom :: forall x. LineStyle -> Rep LineStyle x
from :: forall x. LineStyle -> Rep LineStyle x
$cto :: forall x. Rep LineStyle x -> LineStyle
to :: forall x. Rep LineStyle x -> LineStyle
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_leftArrows :: LineStyle -> Text
_lineStyle_rightArrows :: LineStyle -> Text
_lineStyle_upArrows :: LineStyle -> Text
_lineStyle_downArrows :: LineStyle -> Text
_lineStyle_leftArrows :: Text
_lineStyle_rightArrows :: Text
_lineStyle_upArrows :: Text
_lineStyle_downArrows :: 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: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
a [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
b [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
c [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
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
(SAutoLineConstraint -> SAutoLineConstraint -> Bool)
-> (SAutoLineConstraint -> SAutoLineConstraint -> Bool)
-> Eq SAutoLineConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
== :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
$c/= :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
/= :: SAutoLineConstraint -> SAutoLineConstraint -> Bool
Eq, (forall x. SAutoLineConstraint -> Rep SAutoLineConstraint x)
-> (forall x. Rep SAutoLineConstraint x -> SAutoLineConstraint)
-> Generic SAutoLineConstraint
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
$cfrom :: forall x. SAutoLineConstraint -> Rep SAutoLineConstraint x
from :: forall x. SAutoLineConstraint -> Rep SAutoLineConstraint x
$cto :: forall x. Rep SAutoLineConstraint x -> SAutoLineConstraint
to :: forall x. Rep SAutoLineConstraint x -> SAutoLineConstraint
Generic, Int -> SAutoLineConstraint -> ShowS
[SAutoLineConstraint] -> ShowS
SAutoLineConstraint -> [Char]
(Int -> SAutoLineConstraint -> ShowS)
-> (SAutoLineConstraint -> [Char])
-> ([SAutoLineConstraint] -> ShowS)
-> Show SAutoLineConstraint
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SAutoLineConstraint -> ShowS
showsPrec :: Int -> SAutoLineConstraint -> ShowS
$cshow :: SAutoLineConstraint -> [Char]
show :: SAutoLineConstraint -> [Char]
$cshowList :: [SAutoLineConstraint] -> ShowS
showList :: [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
(SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool)
-> (SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool)
-> Eq SAutoLineLabelPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
== :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
$c/= :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
/= :: SAutoLineLabelPosition -> SAutoLineLabelPosition -> Bool
Eq, (forall x. SAutoLineLabelPosition -> Rep SAutoLineLabelPosition x)
-> (forall x.
    Rep SAutoLineLabelPosition x -> SAutoLineLabelPosition)
-> Generic SAutoLineLabelPosition
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
$cfrom :: forall x. SAutoLineLabelPosition -> Rep SAutoLineLabelPosition x
from :: forall x. SAutoLineLabelPosition -> Rep SAutoLineLabelPosition x
$cto :: forall x. Rep SAutoLineLabelPosition x -> SAutoLineLabelPosition
to :: forall x. Rep SAutoLineLabelPosition x -> SAutoLineLabelPosition
Generic, Int -> SAutoLineLabelPosition -> ShowS
[SAutoLineLabelPosition] -> ShowS
SAutoLineLabelPosition -> [Char]
(Int -> SAutoLineLabelPosition -> ShowS)
-> (SAutoLineLabelPosition -> [Char])
-> ([SAutoLineLabelPosition] -> ShowS)
-> Show SAutoLineLabelPosition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SAutoLineLabelPosition -> ShowS
showsPrec :: Int -> SAutoLineLabelPosition -> ShowS
$cshow :: SAutoLineLabelPosition -> [Char]
show :: SAutoLineLabelPosition -> [Char]
$cshowList :: [SAutoLineLabelPosition] -> ShowS
showList :: [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
(SAutoLineLabel -> SAutoLineLabel -> Bool)
-> (SAutoLineLabel -> SAutoLineLabel -> Bool) -> Eq SAutoLineLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SAutoLineLabel -> SAutoLineLabel -> Bool
== :: SAutoLineLabel -> SAutoLineLabel -> Bool
$c/= :: SAutoLineLabel -> SAutoLineLabel -> Bool
/= :: SAutoLineLabel -> SAutoLineLabel -> Bool
Eq, (forall x. SAutoLineLabel -> Rep SAutoLineLabel x)
-> (forall x. Rep SAutoLineLabel x -> SAutoLineLabel)
-> Generic SAutoLineLabel
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
$cfrom :: forall x. SAutoLineLabel -> Rep SAutoLineLabel x
from :: forall x. SAutoLineLabel -> Rep SAutoLineLabel x
$cto :: forall x. Rep SAutoLineLabel x -> SAutoLineLabel
to :: forall x. Rep SAutoLineLabel x -> SAutoLineLabel
Generic)

instance Show SAutoLineLabel where
  show :: SAutoLineLabel -> [Char]
show SAutoLineLabel {Int
Text
SAutoLineLabelPosition
_sAutoLineLabel_index :: SAutoLineLabel -> Int
_sAutoLineLabel_position :: SAutoLineLabel -> SAutoLineLabelPosition
_sAutoLineLabel_text :: SAutoLineLabel -> Text
_sAutoLineLabel_index :: Int
_sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_text :: Text
..} = [Char]
"SAutoLineLabel: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Int
_sAutoLineLabel_index [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SAutoLineLabelPosition -> [Char]
forall b a. (Show a, IsString b) => a -> b
show SAutoLineLabelPosition
_sAutoLineLabel_position [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
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 -> XY
_sAutoLine_start       :: XY
  , SAutoLine -> XY
_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
(SAutoLine -> SAutoLine -> Bool)
-> (SAutoLine -> SAutoLine -> Bool) -> Eq SAutoLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SAutoLine -> SAutoLine -> Bool
== :: SAutoLine -> SAutoLine -> Bool
$c/= :: SAutoLine -> SAutoLine -> Bool
/= :: SAutoLine -> SAutoLine -> Bool
Eq, (forall x. SAutoLine -> Rep SAutoLine x)
-> (forall x. Rep SAutoLine x -> SAutoLine) -> Generic SAutoLine
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
$cfrom :: forall x. SAutoLine -> Rep SAutoLine x
from :: forall x. SAutoLine -> Rep SAutoLine x
$cto :: forall x. Rep SAutoLine x -> SAutoLine
to :: forall x. Rep SAutoLine x -> SAutoLine
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
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]
..} = [Char]
r where
    start :: [Char]
start = [Char] -> (Attachment -> [Char]) -> Maybe Attachment -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XY -> [Char]
forall b a. (Show a, IsString b) => a -> b
show XY
_sAutoLine_start) Attachment -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
_sAutoLine_attachStart
    end :: [Char]
end = [Char] -> (Attachment -> [Char]) -> Maybe Attachment -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XY -> [Char]
forall b a. (Show a, IsString b) => a -> b
show XY
_sAutoLine_end) Attachment -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
_sAutoLine_attachEnd
    r :: [Char]
r = [Char]
"SAutoLine: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
start [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
end [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SAutoLineConstraint] -> [Char]
forall b a. (Show a, IsString b) => a -> b
show [SAutoLineConstraint]
_sAutoLine_midpoints [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SAutoLineLabel] -> [Char]
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 :: XY
_sAutoLine_start       = XY
0
      , _sAutoLine_end :: XY
_sAutoLine_end       = XY
0
      , _sAutoLine_superStyle :: SuperStyle
_sAutoLine_superStyle     = SuperStyle
forall a. Default a => a
def
      , _sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyle = LineStyle
forall a. Default a => a
def
      , _sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyleEnd = LineStyle
forall a. Default a => a
def
      , _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = Maybe Attachment
forall a. Maybe a
Nothing
      , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = Maybe Attachment
forall a. Maybe a
Nothing
      , _sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = []
      , _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = []
    }
    
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
(STextArea -> STextArea -> Bool)
-> (STextArea -> STextArea -> Bool) -> Eq STextArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: STextArea -> STextArea -> Bool
== :: STextArea -> STextArea -> Bool
$c/= :: STextArea -> STextArea -> Bool
/= :: STextArea -> STextArea -> Bool
Eq, (forall x. STextArea -> Rep STextArea x)
-> (forall x. Rep STextArea x -> STextArea) -> Generic STextArea
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
$cfrom :: forall x. STextArea -> Rep STextArea x
from :: forall x. STextArea -> Rep STextArea x
$cto :: forall x. Rep STextArea x -> STextArea
to :: forall x. Rep STextArea x -> STextArea
Generic, Int -> STextArea -> ShowS
[STextArea] -> ShowS
STextArea -> [Char]
(Int -> STextArea -> ShowS)
-> (STextArea -> [Char])
-> ([STextArea] -> ShowS)
-> Show STextArea
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> STextArea -> ShowS
showsPrec :: Int -> STextArea -> ShowS
$cshow :: STextArea -> [Char]
show :: STextArea -> [Char]
$cshowList :: [STextArea] -> ShowS
showList :: [STextArea] -> ShowS
Show)

instance Default STextArea where
  def :: STextArea
def = STextArea {
      _sTextArea_box :: LBox
_sTextArea_box   =        XY -> XY -> LBox
LBox XY
0 XY
0
      , _sTextArea_text :: TextAreaMapping
_sTextArea_text        = TextAreaMapping
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
(SElt -> SElt -> Bool) -> (SElt -> SElt -> Bool) -> Eq SElt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SElt -> SElt -> Bool
== :: SElt -> SElt -> Bool
$c/= :: SElt -> SElt -> Bool
/= :: SElt -> SElt -> Bool
Eq, (forall x. SElt -> Rep SElt x)
-> (forall x. Rep SElt x -> SElt) -> Generic SElt
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
$cfrom :: forall x. SElt -> Rep SElt x
from :: forall x. SElt -> Rep SElt x
$cto :: forall x. Rep SElt x -> SElt
to :: forall x. Rep SElt x -> SElt
Generic, Int -> SElt -> ShowS
[SElt] -> ShowS
SElt -> [Char]
(Int -> SElt -> ShowS)
-> (SElt -> [Char]) -> ([SElt] -> ShowS) -> Show SElt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SElt -> ShowS
showsPrec :: Int -> SElt -> ShowS
$cshow :: SElt -> [Char]
show :: SElt -> [Char]
$cshowList :: [SElt] -> ShowS
showList :: [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
(SEltLabel -> SEltLabel -> Bool)
-> (SEltLabel -> SEltLabel -> Bool) -> Eq SEltLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SEltLabel -> SEltLabel -> Bool
== :: SEltLabel -> SEltLabel -> Bool
$c/= :: SEltLabel -> SEltLabel -> Bool
/= :: SEltLabel -> SEltLabel -> Bool
Eq, (forall x. SEltLabel -> Rep SEltLabel x)
-> (forall x. Rep SEltLabel x -> SEltLabel) -> Generic SEltLabel
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
$cfrom :: forall x. SEltLabel -> Rep SEltLabel x
from :: forall x. SEltLabel -> Rep SEltLabel x
$cto :: forall x. Rep SEltLabel x -> SEltLabel
to :: forall x. Rep SEltLabel x -> SEltLabel
Generic, Int -> SEltLabel -> ShowS
[SEltLabel] -> ShowS
SEltLabel -> [Char]
(Int -> SEltLabel -> ShowS)
-> (SEltLabel -> [Char])
-> ([SEltLabel] -> ShowS)
-> Show SEltLabel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SEltLabel -> ShowS
showsPrec :: Int -> SEltLabel -> ShowS
$cshow :: SEltLabel -> [Char]
show :: SEltLabel -> [Char]
$cshowList :: [SEltLabel] -> ShowS
showList :: [SEltLabel] -> ShowS
Show)

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