{-# LANGUAGE OverloadedStrings #-}
-- | Infrastructure for parsing & desugaring text related CSS properties.
module Graphics.Layout.Inline.CSS(CSSInline(..), ParagraphBuilder(..),
    buildParagraph, concatParagraph, finalizeParagraph) where

import Data.CSS.Syntax.Tokens (Token(..))
import Stylist (PropertyParser(..))
import qualified Data.Text.Lazy as Lz
import qualified Data.Text as Txt
import Data.Text.Internal (Text(..))
import Data.Text.ParagraphLayout (Span(..), SpanOptions(..), LineHeight(..),
                                Paragraph(..), ParagraphOptions(..))

import Graphics.Layout.CSS.Font (Font'(..), hbScale)
import Data.Char (isSpace)

-- | Document text with Balkón styling options, CSS stylable.
data CSSInline = CSSInline Lz.Text SpanOptions

instance PropertyParser CSSInline where
    temp :: CSSInline
temp = Text -> SpanOptions -> CSSInline
CSSInline "" SpanOptions :: String -> SpanOptions
SpanOptions {
        spanLanguage :: String
spanLanguage = "Zxx"
    }
    inherit :: CSSInline -> CSSInline
inherit (CSSInline _ opts :: SpanOptions
opts) = Text -> SpanOptions -> CSSInline
CSSInline "" SpanOptions
opts

    longhand :: CSSInline -> CSSInline -> Text -> [Token] -> Maybe CSSInline
longhand _ (CSSInline _ opts :: SpanOptions
opts) "content" toks :: [Token]
toks
        | (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isString [Token]
toks =
            CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> SpanOptions -> CSSInline
CSSInline ([Text] -> Text
Lz.concat [Text -> Text
Lz.fromStrict Text
x | String x :: Text
x <- [Token]
toks]) SpanOptions
opts
      where
        isString :: Token -> Bool
isString (String _) = Bool
True
        isString _ = Bool
False
    longhand _ (CSSInline txt :: Text
txt opts :: SpanOptions
opts) "-argo-lang" [String x :: Text
x] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> SpanOptions -> CSSInline
CSSInline Text
txt SpanOptions
opts { spanLanguage :: String
spanLanguage = Text -> String
Txt.unpack Text
x }
    longhand _ _ _ _ = Maybe CSSInline
forall a. Maybe a
Nothing

-- | Helper datastructure for concatenating CSSInlines.
data ParagraphBuilder = ParagraphBuilder Lz.Text [Span]

-- | Convert a CSSInline to a paragraph builder, with a span covering the entire text.
buildParagraph :: CSSInline -> ParagraphBuilder
buildParagraph :: CSSInline -> ParagraphBuilder
buildParagraph (CSSInline txt :: Text
txt opts :: SpanOptions
opts) =
    Text -> [Span] -> ParagraphBuilder
ParagraphBuilder Text
txt [(Int -> SpanOptions -> Span) -> SpanOptions -> Int -> Span
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> SpanOptions -> Span
Span SpanOptions
opts (Int -> Span) -> Int -> Span
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int64
Lz.length Text
txt]
-- | Concatenate two `ParagraphBuilder`s, adjusting the spans appropriately.
concatParagraph :: ParagraphBuilder -> ParagraphBuilder -> ParagraphBuilder
concatParagraph :: ParagraphBuilder -> ParagraphBuilder -> ParagraphBuilder
concatParagraph (ParagraphBuilder aTxt :: Text
aTxt aOpts :: [Span]
aOpts) (ParagraphBuilder bTxt :: Text
bTxt bOps :: [Span]
bOps) =
    Text -> [Span] -> ParagraphBuilder
ParagraphBuilder (Text
aTxt Text -> Text -> Text
`Lz.append` Text
bTxt)
                    ([Span]
aOpts [Span] -> [Span] -> [Span]
forall a. [a] -> [a] -> [a]
++ [Int -> SpanOptions -> Span
Span (Int -> Int
forall a. Enum a => Int -> a
toEnum (Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int64
Lz.length Text
aTxt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off) SpanOptions
opts
                                | Span off :: Int
off opts :: SpanOptions
opts <- [Span]
bOps])
-- | Convert a builder + font to a Balkón paragraph.
finalizeParagraph :: ParagraphBuilder -> Font' -> Maybe Paragraph
finalizeParagraph :: ParagraphBuilder -> Font' -> Maybe Paragraph
finalizeParagraph (ParagraphBuilder txt :: Text
txt _) _ | (Char -> Bool) -> Text -> Bool
Lz.all Char -> Bool
isSpace Text
txt Bool -> Bool -> Bool
|| Text -> Bool
Lz.null Text
txt = Maybe Paragraph
forall a. Maybe a
Nothing
finalizeParagraph (ParagraphBuilder txt :: Text
txt ops :: [Span]
ops) font' :: Font'
font' = Paragraph -> Maybe Paragraph
forall a. a -> Maybe a
Just (Paragraph -> Maybe Paragraph) -> Paragraph -> Maybe Paragraph
forall a b. (a -> b) -> a -> b
$ Array -> Int -> [Span] -> ParagraphOptions -> Paragraph
Paragraph Array
txt' 0 [Span]
ops ParagraphOptions
pOps
    where
        Text txt' :: Array
txt' _ _ = Text -> Text
Lz.toStrict Text
txt
        pOps :: ParagraphOptions
pOps = ParagraphOptions :: Font -> LineHeight -> Int32 -> ParagraphOptions
ParagraphOptions {
            paragraphFont :: Font
paragraphFont = Font' -> Font
hbFont Font'
font',
            paragraphLineHeight :: LineHeight
paragraphLineHeight = Int32 -> LineHeight
Absolute (Int32 -> LineHeight) -> Int32 -> LineHeight
forall a b. (a -> b) -> a -> b
$ Double -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
round (Font' -> Double
lineheight Font'
font' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Font' -> Double
hbScale Font'
font'),
            -- This is what we're computing! Configure to give natural width.
            paragraphMaxWidth :: Int32
paragraphMaxWidth = Int32
forall a. Bounded a => a
maxBound -- i.e. has all the space it needs...
        }