{-# LANGUAGE OverloadedStrings #-}
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)
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
data ParagraphBuilder = ParagraphBuilder Lz.Text [Span]
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]
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])
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'),
paragraphMaxWidth :: Int32
paragraphMaxWidth = Int32
forall a. Bounded a => a
maxBound
}