From 9d1b071daa7564775c5f69c41be86b7ab38e1c53 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 2 Jul 2023 15:26:58 +1200
Subject: [PATCH] Integrate text-alignment support!

---
 Graphics/Layout/CSS.hs       |  5 ++---
 Graphics/Layout/CSS/Parse.hs | 37 ++++++++++++++++++++++++++++++++----
 2 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs
index 6ed7919..94409ce 100644
--- a/Graphics/Layout/CSS.hs
+++ b/Graphics/Layout/CSS.hs
@@ -9,8 +9,7 @@ module Graphics.Layout.CSS(CSSBox(..), BoxSizing(..), Display(..),
 import qualified Data.Text as Txt
 import Stylist (PropertyParser(..))
 import Stylist.Tree (StyleTree(..))
-import Data.Text.ParagraphLayout.Rich (constructParagraph,
-        defaultParagraphOptions, defaultBoxOptions,
+import Data.Text.ParagraphLayout.Rich (constructParagraph, defaultBoxOptions,
         LineHeight(..), InnerNode(..), Box(..), RootNode(..))
 
 import Graphics.Layout.Box as B
@@ -109,7 +108,7 @@ finalizeChilds root parent style' childs@(child:childs')
     finalizeParagraph (RootBox (Box [TextSequence _ txt] _))
         | Txt.all isSpace txt = Nothing -- Discard isolated whitespace.
     finalizeParagraph tree =
-        Just $ constructParagraph "" tree "" defaultParagraphOptions
+        Just $ constructParagraph "" tree "" $ paragraphOptions style'
     enumerate = zip $ enumFrom 0
 finalizeChilds _ _ _ [] = []
 
diff --git a/Graphics/Layout/CSS/Parse.hs b/Graphics/Layout/CSS/Parse.hs
index 7cb7efa..67c1118 100644
--- a/Graphics/Layout/CSS/Parse.hs
+++ b/Graphics/Layout/CSS/Parse.hs
@@ -5,7 +5,8 @@ import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 import Stylist (PropertyParser(..), TrivialPropertyParser, parseOperands,
                 parseUnorderedShorthand', parseUnorderedShorthand)
 import Data.Text.ParagraphLayout (PageOptions(..))
-import Data.Text.ParagraphLayout.Rich (textDirection)
+import Data.Text.ParagraphLayout.Rich (textDirection, ParagraphOptions,
+            defaultParagraphOptions, paragraphAlignment, ParagraphAlignment(..))
 import Data.Text.Glyphize (Direction(..))
 
 import Graphics.Layout.Box as B
@@ -42,7 +43,9 @@ data CSSBox a = CSSBox {
     -- | Parsed CSS caption-side.
     captionBelow :: Bool,
     -- | Parsed widows & orphans controlling pagination.
-    pageOptions :: PageOptions
+    pageOptions :: PageOptions,
+    -- | Parsed text-alignment & other options which applies per-paragraph.
+    paragraphOptions :: ParagraphOptions
 }
 -- | Accessor for inlineStyle's `textDirection` attribute.
 direction CSSBox { inlineStyles = CSSInline _ opts _ } = textDirection opts
@@ -81,7 +84,10 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         cellStyles = temp,
         inlineStyles = temp,
         captionBelow = False,
-        pageOptions = PageOptions 0 0 2 2
+        pageOptions = PageOptions 0 0 2 2,
+        paragraphOptions = defaultParagraphOptions {
+            paragraphAlignment = AlignStart
+        }
       }
     inherit parent = CSSBox {
         boxSizing = boxSizing parent,
@@ -94,7 +100,8 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         cellStyles = inherit $ cellStyles parent,
         inlineStyles = inherit $ inlineStyles parent,
         captionBelow = captionBelow parent,
-        pageOptions = pageOptions parent
+        pageOptions = pageOptions parent,
+        paragraphOptions = paragraphOptions parent
       }
     priority self = concat [x font, x font', x gridStyles, x cellStyles, x inner]
       where x getter = priority $ getter self
@@ -274,6 +281,28 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
             }}
       where p x = Numbered x Nothing
 
+    longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "initial"] =
+        Just self { paragraphOptions = o { paragraphAlignment = AlignStart } }
+    longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "start"] =
+        Just self { paragraphOptions = o { paragraphAlignment = AlignStart } }
+    longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "end"] =
+        Just self { paragraphOptions = o { paragraphAlignment = AlignEnd } }
+    longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "left"] =
+        Just self { paragraphOptions = o { paragraphAlignment = AlignLeft } }
+    longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "right"] =
+        Just self { paragraphOptions = o { paragraphAlignment = AlignRight } }
+    longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "center"] =
+        Just self { paragraphOptions = o { paragraphAlignment = AlignCentreH } }
+    -- text-align: justify is unimplemented.
+    longhand p self@CSSBox { paragraphOptions = o } "text-align"
+            [Ident "match-parent"] = case paragraphAlignment$paragraphOptions p of
+        AlignStart | DirLTR <- direction p -> ret AlignLeft
+        AlignStart | DirRTL <- direction p -> ret AlignRight
+        AlignEnd | DirLTR <- direction p -> ret AlignRight
+        AlignEnd | DirRTL <- direction p -> ret AlignLeft
+        x -> ret x
+      where ret x = Just self { paragraphOptions = o { paragraphAlignment = x } }
+
     longhand _ _ _ _ = Nothing
 
     shorthand self "font" toks = case parseOperands toks of
-- 
2.30.2