M assets/pantheon.css => assets/pantheon.css +6 -0
@@ 47,6 47,8 @@ blockquote { /* Only being used for code..., though appropriate I'm quoting that
.tok-ident {color: #dc322f; voice-stress: strong;}
.tok-string {color: #859900; voice-pitch: high;}
.tok-comment {color: #839496; voice-volume: soft;}
+.tok-error {color: red; voice-stress: x-strong;}
+.tok-num {color: #d33682; voice-pitch: low;}
@media (prefers-color-scheme: dark) {
body {
@@ 64,3 66,7 @@ blockquote { /* Only being used for code..., though appropriate I'm quoting that
dl > dt {font-weight: bold; text-align: center;}
dl > dd {margin: 0;}
.disclosure {float: right}
+
+dl.tabular {display: grid}
+dl.tabular > dt {grid-column: 1}
+dl.tabular > dd {grid-column: 2}
M src/Main.hs => src/Main.hs +12 -1
@@ 29,6 29,8 @@ import Internal
import Internal.Load as Load
import Internal.Elements as El
import Internal.Forms as Forms
+import Internal.Style as Style
+import Data.CSS.Syntax.Tokens as Style
import Control.Monad.IO.Class (liftIO)
import Control.Monad (forM)
@@ 204,7 206,16 @@ serveEl' uuid session session' el = do
let title = toStrict $ renderMarkup $ contents $ Tpl.xmlNode' $ XC.node el
related <- liftIO $ getRelatedEls session el
elValue <- liftIO $ Forms.readInput' session el
- Tpl.inspector ok title session' $ Tpl.elPage uuid el related elValue
+ let styles = M.toList $ Style.styleCursor session' el
+ Tpl.inspector ok title session' $ \langs -> do
+ Tpl.elPage uuid el related elValue langs
+ H.aside $ H.dl H.! A.class_ "tabular" $ do
+ forM styles $ \(prop, val) -> do
+ H.dt $ do
+ Tpl.identTok $ Txt.pack prop
+ Tpl.symbolTok False ":"
+ H.dd $ Tpl.hlCSSs val
+ return ()
serveElPreview uuid session el = do
nullDir
M src/UI/Templates.hs => src/UI/Templates.hs +47 -1
@@ 1,6 1,6 @@
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module UI.Templates(page, inspector, inspector', sessionForm,
- xmlNode, xmlNode', elSelector, elPage) where
+ xmlNode, xmlNode', elSelector, elPage, hlCSS, hlCSSs, identTok, symbolTok) where
import Happstack.Lite
import Text.Blaze.Html5 as H
@@ 21,6 21,8 @@ import Text.XML.Cursor as XC
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
+import Data.CSS.Syntax.Tokens
+
import Messages
import Happstack.Server.I18N
@@ 160,6 162,50 @@ qualifyTok = token "qualify"
keywordTok = token "keyword"
identTok = token "ident"
stringTok = token "string" . pack
+stringTok' = token "string"
commentTok = token "comment"
+errorTok = token "error"
+numTok = token "num"
token type_ txt = H.span ! class_ (stringValue ("tok-" ++ type_)) $ text txt
+
+--- CSS formatting
+hlCSSs toks = do
+ forM toks $ \tok -> do
+ hlCSS tok
+ text " " -- Because Haskell Stylist stripes Whitespace out from properties.
+ return ()
+hlCSS Whitespace = " " -- Filtered out by caller.
+hlCSS CDO = commentTok "<!--"
+hlCSS CDC = commentTok "-->"
+hlCSS Comma = symbolTok True ","
+hlCSS Colon = symbolTok True ":"
+hlCSS Semicolon = symbolTok True ";"
+hlCSS LeftParen = "("
+hlCSS RightParen = ")"
+hlCSS LeftSquareBracket = "["
+hlCSS RightSquareBracket = "]"
+hlCSS LeftCurlyBracket = "{"
+hlCSS RightCurlyBracket = "}"
+hlCSS SuffixMatch = symbolTok True "$="
+hlCSS SubstringMatch = symbolTok True "*="
+hlCSS PrefixMatch = symbolTok True "^="
+hlCSS DashMatch = symbolTok True "|="
+hlCSS IncludeMatch = symbolTok True "~="
+hlCSS Column = symbolTok True "||"
+hlCSS tok@(String _) = stringTok' $ serialize [tok]
+hlCSS BadString = errorTok "\"\n"
+hlCSS (Number x _) = numTok x
+hlCSS (Percentage x _) = numTok (x `Txt.append` "%")
+hlCSS (Dimension x _ u) = numTok (x `Txt.append` u)
+hlCSS (Url x) = do
+ identTok "url("
+ stringTok' x
+ text ")"
+hlCSS BadUrl = errorTok "url(()"
+hlCSS (Ident x) = keywordTok x
+hlCSS (AtKeyword x) = keywordTok ('@' `Txt.cons` x)
+hlCSS (Function x) = identTok (x `Txt.append` "(")
+hlCSS (Hash HId x) = keywordTok ('#' `Txt.cons` x)
+hlCSS (Hash HUnrestricted x) = stringTok' ('#' `Txt.cons` x)
+hlCSS (Delim x) = symbolTok True $ Txt.pack [x]