module Language.Css.Syntax (
StyleSheet(..), StyleBody(..),
AtCharSet(..),
AtImport(..), ImportHead(..),
AtMedia(..),
AtPage(..), PseudoPage,
AtFontFace(..),
RuleSet(..), Decl(..), Prop, Prio(..), Expr(..),
Sel(..), SimpleSel(..), SubSel(..),
Element, Attr(..), Class, Id, AttrIdent, AttrVal, PseudoVal(..),
Value(..),
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)
data StyleSheet = StyleSheet (Maybe AtCharSet) [AtImport] [StyleBody]
deriving (Eq)
data StyleBody = SRuleSet RuleSet
| SAtMedia AtMedia
| SAtPage AtPage
| SAtFontFace AtFontFace
deriving (Eq)
data AtCharSet = AtCharSet String
deriving (Eq)
data AtImport = AtImport ImportHead [Ident]
deriving (Eq)
data ImportHead = IStr String | IUri Uri
deriving (Eq)
data AtMedia = AtMedia [Ident] [RuleSet]
deriving (Eq)
data AtPage = AtPage (Maybe Ident) (Maybe PseudoPage) [Decl]
deriving (Eq)
type PseudoPage = Ident
data AtFontFace = AtFontFace [Decl]
deriving (Eq)
data RuleSet = RuleSet [Sel] [Decl]
deriving (Eq)
data Decl = Decl (Maybe Prio) Prop Expr
deriving (Eq)
type Prop = Ident
data Prio = Important
deriving (Eq)
data Sel = SSel SimpleSel
| DescendSel Sel Sel
| ChildSel Sel Sel
| AdjSel Sel Sel
deriving (Eq)
data SimpleSel = UnivSel [SubSel]
| TypeSel Element [SubSel]
deriving (Eq)
data SubSel = AttrSel Attr
| ClassSel Class
| IdSel Id
| PseudoSel PseudoVal
deriving (Eq)
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)
data Expr = EVal Value
| SlashSep Expr Expr
| CommaSep Expr Expr
| SpaceSep Expr Expr
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)
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")
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
instance Show AtCharSet where
show (AtCharSet str) = "@charset " ++ str ++ " ;"
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
instance Show AtPage where
show (AtPage id pp ds) = show $ text "@page"
<+> ppMaybe id <+> ppMaybe pp
<+> (braces $ punctuateShows semi ds)
instance Show AtMedia where
show (AtMedia ms rs) = show $ text "@media"
<+> punctuateShows comma ms
<+> punctuateShows comma rs
instance Show AtFontFace where
show (AtFontFace ds) = show $ text "@font-face"
<+> (braces $ punctuateShows semi ds)
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
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"
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)
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
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
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 ++ ")"