-- | Css2.1 syntax -- -- haskell translation of css 2.1 grammar. -- -- See and module Language.Css.Syntax ( -- * Stylesheet StyleSheet(..), StyleBody(..), -- * AtRule AtCharSet(..), AtImport(..), ImportHead(..), AtMedia(..), AtPage(..), PseudoPage, AtFontFace(..), -- * RuleSet RuleSet(..), Decl(..), Prop, Prio(..), Expr(..), -- * Selectors Sel(..), SimpleSel(..), SubSel(..), Element, Attr(..), Class, Id, AttrIdent, AttrVal, PseudoVal(..), -- * Values Value(..), -- * Primitives Ident(..), Func(..), Deg(..), Rad(..), Grad(..), Color(..), Hz(..), KHz(..), Em(..), Ex(..), Px(..), In(..), Cm(..), Mm(..), Pc(..), Pt(..), Percentage(..), Ms(..), S(..), Uri(..) ) where import Text.PrettyPrint data Ident = Ident String deriving (Eq) -------------------------------------------------------- -- Stylesheet data StyleSheet = StyleSheet (Maybe AtCharSet) [AtImport] [StyleBody] deriving (Eq) data StyleBody = SRuleSet RuleSet | SAtMedia AtMedia | SAtPage AtPage | SAtFontFace AtFontFace deriving (Eq) --------------------------------------------------------- -- AtRules -- | \@charset data AtCharSet = AtCharSet String deriving (Eq) -- | \@import data AtImport = AtImport ImportHead [Ident] deriving (Eq) data ImportHead = IStr String | IUri Uri deriving (Eq) -- | \@media data AtMedia = AtMedia [Ident] [RuleSet] deriving (Eq) -- | \@page data AtPage = AtPage (Maybe Ident) (Maybe PseudoPage) [Decl] deriving (Eq) type PseudoPage = Ident -- | \@font-face data AtFontFace = AtFontFace [Decl] deriving (Eq) --------------------------------------------------------- -- Rules data RuleSet = RuleSet [Sel] [Decl] deriving (Eq) -- | Declaration data Decl = Decl (Maybe Prio) Prop Expr deriving (Eq) -- | Property type Prop = Ident -- | sets @!important@ declaration data Prio = Important deriving (Eq) --------------------------------------------------------- -- Selectors -- | Selector data Sel = SSel SimpleSel -- ^ single selector | DescendSel Sel Sel -- ^ ' ' | ChildSel Sel Sel -- ^ \'>\' | AdjSel Sel Sel -- ^ \'+\' deriving (Eq) -- | Simple selector data SimpleSel = UnivSel [SubSel] -- ^ Universal selector | TypeSel Element [SubSel] -- ^ Type selector deriving (Eq) data SubSel = AttrSel Attr -- ^ attribute selector | ClassSel Class -- ^ \'.\' | IdSel Id -- ^ \'#\' | PseudoSel PseudoVal -- ^ pseudo classes/elements deriving (Eq) -- | attribute selector data Attr = Attr AttrIdent | AttrIs AttrIdent AttrVal -- ^ \'=\' | AttrIncl AttrIdent AttrVal -- ^ \'~=\' | AttrBegins AttrIdent AttrVal -- ^ \'|=\' deriving (Eq) type Element = String type Class = String type Id = String type AttrIdent = String type AttrVal = String data PseudoVal = PIdent Ident | PFunc Func deriving (Eq) ------------------------------------------------------------------- -- Values data Expr = EVal Value -- ^ single value | SlashSep Expr Expr -- ^ slash separated expressions | CommaSep Expr Expr -- ^ comma separated expressions | SpaceSep Expr Expr -- ^ space separated expressions deriving (Eq) data Value = VDeg Deg | VRad Rad | VGrad Grad | VColor Color | VHz Hz | VKHz KHz | VFunc Func | VIdent Ident | VInt Int | VEm Em | VEx Ex | VPx Px | VIn In | VCm Cm | VMm Mm | VPc Pc | VPt Pt | VDouble Double | VPercentage Percentage | VString String | VMs Ms | VS S | VUri Uri deriving (Eq) data Func = Func Ident Expr deriving (Eq) -- | \ data Deg = Deg Double deriving (Eq) -- | \ data Rad = Rad Double deriving (Eq) -- | \ data Grad = Grad Double deriving (Eq) -- | \ data Color = Cword String | Crgb Int Int Int deriving (Eq) -- | \ data Hz = Hz Double deriving (Eq) -- | \ data KHz = KHz Double deriving (Eq) -- | \ data Em = Em Double deriving (Eq) -- | \ data Ex = Ex Double deriving (Eq) -- | \ data Px = Px Int deriving (Eq) -- | \ data In = In Double deriving (Eq) -- | \ data Cm = Cm Double deriving (Eq) -- | \ data Mm = Mm Double deriving (Eq) -- | \ data Pc = Pc Double deriving (Eq) -- | \ data Pt = Pt Int deriving (Eq) -- | \ data Percentage = Percentage Double deriving (Eq) -- | \ data Ms = Ms Double deriving (Eq) -- | \ data S = S Double deriving (Eq) -- | \ data Uri = Uri String deriving (Eq) ------------------------------------------------- -- Show instances ppMaybe :: Show a => Maybe a -> Doc ppMaybe = maybe empty (text . show) punctuateShows :: Show a => Doc -> [a] -> Doc punctuateShows sep = hcat . punctuate sep . map (text . show) vsep = vcat . punctuate (text "\n") -- StyleSheet instance Show StyleSheet where show (StyleSheet ch imp body) = show $ ppMaybe ch $$ (vsep $ map (text . show) imp) $$ (vsep $ map (text . show) body) instance Show StyleBody where show x = case x of SRuleSet x -> show x SAtMedia x -> show x SAtPage x -> show x SAtFontFace x -> show x -- AtRules -- @charset instance Show AtCharSet where show (AtCharSet str) = "@charset " ++ str ++ " ;" -- @import instance Show AtImport where show (AtImport head ms) = show $ text "@import" <+> (text $ show head) <+> punctuateShows comma ms <+> semi instance Show ImportHead where show x = case x of IStr x -> x IUri x -> show x -- @page instance Show AtPage where show (AtPage id pp ds) = show $ text "@page" <+> ppMaybe id <+> ppMaybe pp <+> (braces $ punctuateShows semi ds) -- @media instance Show AtMedia where show (AtMedia ms rs) = show $ text "@media" <+> punctuateShows comma ms <+> punctuateShows comma rs -- @font-face instance Show AtFontFace where show (AtFontFace ds) = show $ text "@font-face" <+> (braces $ punctuateShows semi ds) -- RuleSets instance Show RuleSet where show (RuleSet sels decls) = show $ (vcat $ punctuate comma $ map (text . show) sels) <+> lbrace $$ (nest 4 $ vcat $ punctuate semi $ map (text . show)decls) <+> rbrace -- Declarations instance Show Decl where show (Decl prio p v) = case prio of Just x -> decl ++ " " ++ show x Nothing -> decl where decl = show p ++ " : " ++ show v instance Show Prio where show = const "!important" -- Selectors instance Show Sel where show x = case x of SSel x -> show x DescendSel x xs -> show x ++ " " ++ show xs ChildSel x xs -> show x ++ " > " ++ show xs AdjSel x xs -> show x ++ " + " ++ show xs instance Show SimpleSel where show x = case x of UnivSel xs -> "*" ++ showSubs xs TypeSel el xs -> el ++ showSubs xs showSubs :: [SubSel] -> String showSubs = show . hcat . map (text . show) instance Show PseudoVal where show x = case x of PIdent a -> show a PFunc a -> show a instance Show SubSel where show x = case x of AttrSel a -> show $ brackets $ text $ show a ClassSel v -> "." ++ v IdSel v -> "#" ++ v PseudoSel v -> ":" ++ show v instance Show Attr where show x = case x of Attr a -> show $ text a AttrIs a v -> show $ text a <> equals <> (doubleQuotes $ text v) AttrIncl a v -> show $ text a <> text "~=" <> (doubleQuotes $ text v) AttrBegins a v -> show $ text a <> text "|=" <> (doubleQuotes $ text v) -- Values instance Show Expr where show x = case x of EVal x -> show x SlashSep x e -> show x ++ " / " ++ show e CommaSep x e -> show x ++ " , " ++ show e SpaceSep x e -> show x ++ " " ++ show e instance Show Func where show (Func name arg) = show $ text (show name) <+> parens (text $ show arg) instance Show Ident where show (Ident a) = a -- Measure Units -- Value instance Show Value where show x = case x of VDeg a -> show a VRad a -> show a VGrad a -> show a VColor a -> show a VHz a -> show a VKHz a -> show a VFunc a -> show a VIdent a -> show a VInt a -> show a VEm a -> show a VEx a -> show a VPx a -> show a VIn a -> show a VCm a -> show a VMm a -> show a VPc a -> show a VPt a -> show a VDouble a -> show a VPercentage a -> show a VString a -> show a VMs a -> show a VS a -> show a VUri a -> show a -- Value elems instance Show Deg where show (Deg x) = show x ++ "deg" instance Show Rad where show (Rad x) = show x ++ "rad" instance Show Grad where show (Grad x) = show x ++ "grad" instance Show Color where show x = case x of { Cword a -> a ; Crgb r g b -> show $ (text "rgb" <> ) $ parens $ hsep $ punctuate comma $ map (text. show) [r, g, b]} instance Show Hz where show (Hz x) = show x ++ "Hz" instance Show KHz where show (KHz x) = show x ++ "kHz" instance Show Em where show (Em x) = show x ++ "em" instance Show Ex where show (Ex x) = show x ++ "ex" instance Show Px where show (Px x) = show x ++ "px" instance Show In where show (In x) = show x ++ "in" instance Show Cm where show (Cm x) = show x ++ "cm" instance Show Mm where show (Mm x) = show x ++ "mm" instance Show Pc where show (Pc x) = show x ++ "pc" instance Show Pt where show (Pt x) = show x ++ "pt" instance Show Percentage where show (Percentage x) = show x ++ "%" instance Show Ms where show (Ms x) = show x ++ "ms" instance Show S where show (S x) = show x ++ "s" instance Show Uri where show (Uri x) = "url(" ++ show x ++ ")"