module Language.Css.Pretty(
Pretty(..), prettyPrint)
where
import Text.PrettyPrint
import Language.Css.Syntax
class Pretty a where
pretty :: a -> Doc
prettyPrint :: Pretty a => a -> String
prettyPrint = render . pretty
ppMaybe :: Pretty a => Maybe a -> Doc
ppMaybe = maybe empty pretty
punctuatePretties :: Pretty a => Doc -> [a] -> Doc
punctuatePretties sep = hcat . punctuate sep . map pretty
vsep = vcat . punctuate (text "\n")
instance Pretty StyleSheet where
pretty (StyleSheet ch imp body) =
ppMaybe ch
$$ (vsep $ map pretty imp)
$$ (vsep $ map pretty body)
instance Pretty StyleBody where
pretty x = case x of
SRuleSet x -> pretty x
SAtMedia x -> pretty x
SAtPage x -> pretty x
SAtFontFace x -> pretty x
instance Pretty AtCharSet where
pretty (AtCharSet str) = text "@charset " <> text str <+> semi
instance Pretty AtImport where
pretty (AtImport head ms) =
text "@import" <+> pretty head <+>
punctuatePretties comma ms <+> semi
instance Pretty ImportHead where
pretty x = case x of
IStr x -> text x
IUri x -> pretty x
instance Pretty AtPage where
pretty (AtPage id pp ds) = text "@page"
<+> ppMaybe id <+> ppMaybe pp
<+> (braces $ punctuatePretties semi ds)
instance Pretty AtMedia where
pretty (AtMedia ms rs) = text "@media"
<+> punctuatePretties comma ms
<+> punctuatePretties comma rs
instance Pretty AtFontFace where
pretty (AtFontFace ds) = text "@font-face"
<+> (braces $ punctuatePretties semi ds)
instance Pretty RuleSet where
pretty (RuleSet sels decls) =
(vcat $ punctuate comma $ map pretty sels)
<+> lbrace
$$ (nest 4 $ vcat $ punctuate semi $ map pretty decls)
<+> rbrace
instance Pretty Decl where
pretty (Decl prio p v) =
case prio of
Just x -> decl <+> pretty x
Nothing -> decl
where decl = pretty p <+> char ':' <+> pretty v
instance Pretty Prio where
pretty = const $ text "!important"
instance Pretty Sel where
pretty x = case x of
SSel x -> pretty x
DescendSel x xs -> pretty x <+> space <+> pretty xs
ChildSel x xs -> pretty x <+> char '>' <+> pretty xs
AdjSel x xs -> pretty x <+> char '+' <+> pretty xs
instance Pretty SimpleSel where
pretty x = case x of
UnivSel xs -> char '*' <> prettySubs xs
TypeSel el xs -> text el <> prettySubs xs
prettySubs :: [SubSel] -> Doc
prettySubs = hcat . map pretty
instance Pretty PseudoVal where
pretty x = case x of
PIdent a -> pretty a
PFunc a -> pretty a
instance Pretty SubSel where
pretty x = case x of
AttrSel a -> brackets $ pretty a
ClassSel v -> char '.' <> text v
IdSel v -> char '#' <> text v
PseudoSel v -> char ':' <> pretty v
instance Pretty Attr where
pretty x = case x of
Attr a -> text a
AttrIs a v -> text a <> equals <> (doubleQuotes $ text v)
AttrIncl a v -> text a <> text "~=" <> (doubleQuotes $ text v)
AttrBegins a v -> text a <> text "|=" <> (doubleQuotes $ text v)
instance Pretty Value where
pretty x = case x of
VDeg a -> pretty a
VRad a -> pretty a
VGrad a -> pretty a
VColor a -> pretty a
VHz a -> pretty a
VKHz a -> pretty a
VFunc a -> pretty a
VIdent a -> pretty a
VInt a -> int a
VEm a -> pretty a
VEx a -> pretty a
VPx a -> pretty a
VIn a -> pretty a
VCm a -> pretty a
VMm a -> pretty a
VPc a -> pretty a
VPt a -> pretty a
VDouble a -> double a
VPercentage a -> pretty a
VString a -> doubleQuotes $ text a
VMs a -> pretty a
VS a -> pretty a
VUri a -> pretty a
instance Pretty Expr where
pretty x = case x of
EVal x -> pretty x
SlashSep x e -> pretty x <+> char '/' <+> pretty e
CommaSep x e -> pretty x <+> char ',' <+> pretty e
SpaceSep x e -> pretty x <+> space <+> pretty e
instance Pretty Func where
pretty (Func name arg) = pretty name <> parens (pretty arg)
instance Pretty Ident where
pretty (Ident a) = text a
instance Pretty Deg where
pretty (Deg x) = double x <> text "deg"
instance Pretty Rad where
pretty (Rad x) = double x <> text "rad"
instance Pretty Grad where
pretty (Grad x) = double x <> text "grad"
instance Pretty Color where
pretty x = case x of
Cword a -> text a
Crgb r g b -> (text "rgb" <> ) $ parens $ hsep $
punctuate comma $ map int [r, g, b]
instance Pretty Hz where
pretty (Hz x) = double x <> text "Hz"
instance Pretty KHz where
pretty (KHz x) = double x <> text "kHz"
instance Pretty Em where
pretty (Em x) = double x <> text "em"
instance Pretty Ex where
pretty (Ex x) = double x <> text "ex"
instance Pretty Px where
pretty (Px x) = int x <> text "px"
instance Pretty In where
pretty (In x) = double x <> text "in"
instance Pretty Cm where
pretty (Cm x) = double x <> text "cm"
instance Pretty Mm where
pretty (Mm x) = double x <> text "mm"
instance Pretty Pc where
pretty (Pc x) = double x <> text "pc"
instance Pretty Pt where
pretty (Pt x) = int x <> text "pt"
instance Pretty Percentage where
pretty (Percentage x) = double x <> text "%"
instance Pretty Ms where
pretty (Ms x) = double x <> text "ms"
instance Pretty S where
pretty (S x) = double x <> text "s"
instance Pretty Uri where
pretty (Uri x) = text "url" <> (parens $ text x)