module Chiasma.Ui.Data.RenderableTree where

import Prettyprinter (Doc, Pretty (..), emptyDoc, space, (<+>))

import Chiasma.Data.Axis (Axis)
import Chiasma.Data.TmuxId (PaneId (..))
import Chiasma.Ui.Data.Tree (NNode, NTree)
import Chiasma.Ui.Data.ViewGeometry (ViewGeometry (ViewGeometry))
import Chiasma.Ui.Data.ViewState (ViewState)

data RLayout =
  RLayout {
    RLayout -> RPane
_ref :: RPane,
    RLayout -> Axis
_axis :: Axis
  }
  deriving stock (RLayout -> RLayout -> Bool
(RLayout -> RLayout -> Bool)
-> (RLayout -> RLayout -> Bool) -> Eq RLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLayout -> RLayout -> Bool
$c/= :: RLayout -> RLayout -> Bool
== :: RLayout -> RLayout -> Bool
$c== :: RLayout -> RLayout -> Bool
Eq, Int -> RLayout -> ShowS
[RLayout] -> ShowS
RLayout -> String
(Int -> RLayout -> ShowS)
-> (RLayout -> String) -> ([RLayout] -> ShowS) -> Show RLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLayout] -> ShowS
$cshowList :: [RLayout] -> ShowS
show :: RLayout -> String
$cshow :: RLayout -> String
showsPrec :: Int -> RLayout -> ShowS
$cshowsPrec :: Int -> RLayout -> ShowS
Show)

data RPane =
  RPane {
    RPane -> PaneId
_id :: PaneId,
    RPane -> Int
_top :: Int,
    RPane -> Int
_left :: Int
  }
  deriving stock (RPane -> RPane -> Bool
(RPane -> RPane -> Bool) -> (RPane -> RPane -> Bool) -> Eq RPane
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RPane -> RPane -> Bool
$c/= :: RPane -> RPane -> Bool
== :: RPane -> RPane -> Bool
$c== :: RPane -> RPane -> Bool
Eq, Int -> RPane -> ShowS
[RPane] -> ShowS
RPane -> String
(Int -> RPane -> ShowS)
-> (RPane -> String) -> ([RPane] -> ShowS) -> Show RPane
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RPane] -> ShowS
$cshowList :: [RPane] -> ShowS
show :: RPane -> String
$cshow :: RPane -> String
showsPrec :: Int -> RPane -> ShowS
$cshowsPrec :: Int -> RPane -> ShowS
Show)

data Renderable a =
  Renderable {
    forall a. Renderable a -> ViewState
_state :: ViewState,
    forall a. Renderable a -> ViewGeometry
_geometry :: ViewGeometry,
    forall a. Renderable a -> a
_view :: a
  }
  deriving stock (Renderable a -> Renderable a -> Bool
(Renderable a -> Renderable a -> Bool)
-> (Renderable a -> Renderable a -> Bool) -> Eq (Renderable a)
forall a. Eq a => Renderable a -> Renderable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Renderable a -> Renderable a -> Bool
$c/= :: forall a. Eq a => Renderable a -> Renderable a -> Bool
== :: Renderable a -> Renderable a -> Bool
$c== :: forall a. Eq a => Renderable a -> Renderable a -> Bool
Eq, Int -> Renderable a -> ShowS
[Renderable a] -> ShowS
Renderable a -> String
(Int -> Renderable a -> ShowS)
-> (Renderable a -> String)
-> ([Renderable a] -> ShowS)
-> Show (Renderable a)
forall a. Show a => Int -> Renderable a -> ShowS
forall a. Show a => [Renderable a] -> ShowS
forall a. Show a => Renderable a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Renderable a] -> ShowS
$cshowList :: forall a. Show a => [Renderable a] -> ShowS
show :: Renderable a -> String
$cshow :: forall a. Show a => Renderable a -> String
showsPrec :: Int -> Renderable a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Renderable a -> ShowS
Show)

type RenderableLayout = Renderable RLayout
type RenderablePane = Renderable RPane
type RenderableTree = NTree RenderableLayout RenderablePane
type RenderableNode = NNode RenderableLayout RenderablePane

instance Pretty RLayout where
  pretty :: forall ann. RLayout -> Doc ann
pretty (RLayout (RPane (PaneId Int
refId) Int
_ Int
_) Axis
axis) =
    Doc ann
"l –" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"ref:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
refId Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"pos:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Axis -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Axis
axis

instance Pretty RPane where
  pretty :: forall ann. RPane -> Doc ann
pretty (RPane (PaneId Int
paneId) Int
top Int
left) =
    Doc ann
"p –" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
paneId Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
top Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
left

mayPretty :: Text -> Maybe Float -> Doc a
mayPretty :: forall a. Text -> Maybe Float -> Doc a
mayPretty Text
prefix (Just Float
a) =
  Doc a
forall ann. Doc ann
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Float -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty Float
a
mayPretty Text
_ Maybe Float
Nothing =
  Doc a
forall ann. Doc ann
emptyDoc

instance Pretty a => Pretty (Renderable a) where
  pretty :: forall ann. Renderable a -> Doc ann
pretty (Renderable ViewState
_ (ViewGeometry Maybe Float
minSize Maybe Float
maxSize Maybe Float
fixedSize Maybe Float
_ Maybe Float
_ Maybe Float
_) a
a) =
    a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Float -> Doc ann
forall a. Text -> Maybe Float -> Doc a
mayPretty Text
"min" Maybe Float
minSize Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Float -> Doc ann
forall a. Text -> Maybe Float -> Doc a
mayPretty Text
"max" Maybe Float
maxSize Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Float -> Doc ann
forall a. Text -> Maybe Float -> Doc a
mayPretty Text
"fixed" Maybe Float
fixedSize