language-css 0.0.1 → 0.0.2
raw patch · 4 files changed
+284/−266 lines, 4 files
Files
- language-css.cabal +2/−1
- src/Language/Css/Build.hs +2/−1
- src/Language/Css/Pretty.hs +242/−0
- src/Language/Css/Syntax.hs +38/−264
language-css.cabal view
@@ -1,5 +1,5 @@ Name: language-css-Version: 0.0.1+Version: 0.0.2 Cabal-Version: >= 1.2 License: BSD3 License-file: LICENSE@@ -18,6 +18,7 @@ Hs-Source-Dirs: src/ Exposed-Modules: Language.Css.Syntax+ Language.Css.Pretty Language.Css.Build Language.Css.Build.Idents Language.Css.Build.Tags
src/Language/Css/Build.hs view
@@ -6,6 +6,7 @@ -- > -- >import Language.Css.Syntax -- >import Language.Css.Build+-- >import Language.Css.Pretty -- >import Language.Css.Build.Idents -- >import Language.Css.Build.Tags hiding (center) -- >@@ -24,7 +25,7 @@ -- > (star /. "warning") [ color <:> red ] -- > ] -- > --- >main = print res+-- >main = print $ pretty res -- > -- module Language.Css.Build (
+ src/Language/Css/Pretty.hs view
@@ -0,0 +1,242 @@+module Language.Css.Pretty(+ Pretty(..), prettyPrint)+where++import Text.PrettyPrint+import Language.Css.Syntax+++class Pretty a where+ pretty :: a -> Doc++-- | pretty-print with the default style. +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")+++-- StyleSheet++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++-- AtRules++-- @charset+instance Pretty AtCharSet where+ pretty (AtCharSet str) = text "@charset " <> text str <+> semi++-- @import+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+-- @page+instance Pretty AtPage where+ pretty (AtPage id pp ds) = text "@page" + <+> ppMaybe id <+> ppMaybe pp + <+> (braces $ punctuatePretties semi ds)+++-- @media+instance Pretty AtMedia where+ pretty (AtMedia ms rs) = text "@media" + <+> punctuatePretties comma ms+ <+> punctuatePretties comma rs+ ++-- @font-face+instance Pretty AtFontFace where+ pretty (AtFontFace ds) = text "@font-face" + <+> (braces $ punctuatePretties semi ds)+++-- RuleSets++instance Pretty RuleSet where+ pretty (RuleSet sels decls) = + (vcat $ punctuate comma $ map pretty sels)+ <+> lbrace + $$ (nest 4 $ vcat $ punctuate semi $ map pretty decls)+ <+> rbrace+++-- Declarations++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"++-- Selectors++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 $ text $ show 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)+ +-- Value++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 -> text $ show a+ VMs a -> pretty a+ VS a -> pretty a+ VUri a -> pretty a++-- Values++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) = text (show name) <+> parens (pretty arg)+++instance Pretty Ident where+ pretty (Ident a) = text a+++-- Value elems++instance Pretty Deg where+ pretty (Deg x) = (text $ show x) <> text "deg"++instance Pretty Rad where+ pretty (Rad x) = (text $ show x) <> text "rad"++instance Pretty Grad where+ pretty (Grad x) = (text $ show 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 (text. show) [r, g, b]++instance Pretty Hz where+ pretty (Hz x) = (text $ show x) <> text "Hz"++instance Pretty KHz where+ pretty (KHz x) = (text $ show x) <> text "kHz"++instance Pretty Em where+ pretty (Em x) = (text $ show x) <> text "em"++instance Pretty Ex where+ pretty (Ex x) = (text $ show x) <> text "ex"++instance Pretty Px where+ pretty (Px x) = (text $ show x) <> text "px"++instance Pretty In where+ pretty (In x) = (text $ show x) <> text "in"++instance Pretty Cm where+ pretty (Cm x) = (text $ show x) <> text "cm"++instance Pretty Mm where+ pretty (Mm x) = (text $ show x) <> text "mm"++instance Pretty Pc where+ pretty (Pc x) = (text $ show x) <> text "pc"++instance Pretty Pt where+ pretty (Pt x) = (text $ show x) <> text "pt"++instance Pretty Percentage where+ pretty (Percentage x) = (text $ show x) <> text "%"++instance Pretty Ms where+ pretty (Ms x) = (text $ show x) <> text "ms"++instance Pretty S where+ pretty (S x) = (text $ show x) <> text "s"++instance Pretty Uri where+ pretty (Uri x) = text "url" <> (parens $ text $ show x)++++++
src/Language/Css/Syntax.hs view
@@ -53,63 +53,63 @@ import Text.PrettyPrint data Ident = Ident String- deriving (Eq)+ deriving (Eq, Show) -------------------------------------------------------- -- Stylesheet data StyleSheet = StyleSheet (Maybe AtCharSet) [AtImport] [StyleBody]- deriving (Eq)+ deriving (Eq, Show) data StyleBody = SRuleSet RuleSet | SAtMedia AtMedia | SAtPage AtPage | SAtFontFace AtFontFace- deriving (Eq)+ deriving (Eq, Show) --------------------------------------------------------- -- AtRules -- | \@charset data AtCharSet = AtCharSet String- deriving (Eq)+ deriving (Eq, Show) -- | \@import data AtImport = AtImport ImportHead [Ident]- deriving (Eq)+ deriving (Eq, Show) data ImportHead = IStr String | IUri Uri- deriving (Eq)+ deriving (Eq, Show) -- | \@media data AtMedia = AtMedia [Ident] [RuleSet]- deriving (Eq)+ deriving (Eq, Show) -- | \@page data AtPage = AtPage (Maybe Ident) (Maybe PseudoPage) [Decl]- deriving (Eq)+ deriving (Eq, Show) type PseudoPage = Ident -- | \@font-face data AtFontFace = AtFontFace [Decl]- deriving (Eq)+ deriving (Eq, Show) --------------------------------------------------------- -- Rules data RuleSet = RuleSet [Sel] [Decl]- deriving (Eq)+ deriving (Eq, Show) -- | Declaration data Decl = Decl (Maybe Prio) Prop Expr- deriving (Eq)+ deriving (Eq, Show) -- | Property type Prop = Ident -- | sets @!important@ declaration data Prio = Important- deriving (Eq)+ deriving (Eq, Show) --------------------------------------------------------- -- Selectors@@ -119,26 +119,26 @@ | DescendSel Sel Sel -- ^ ' ' | ChildSel Sel Sel -- ^ \'>\' | AdjSel Sel Sel -- ^ \'+\'- deriving (Eq)+ deriving (Eq, Show) -- | Simple selector data SimpleSel = UnivSel [SubSel] -- ^ Universal selector | TypeSel Element [SubSel] -- ^ Type selector- deriving (Eq)+ deriving (Eq, Show) data SubSel = AttrSel Attr -- ^ attribute selector | ClassSel Class -- ^ \'.\' | IdSel Id -- ^ \'#\' | PseudoSel PseudoVal -- ^ pseudo classes/elements- deriving (Eq)+ deriving (Eq, Show) -- | attribute selector data Attr = Attr AttrIdent | AttrIs AttrIdent AttrVal -- ^ \'=\' | AttrIncl AttrIdent AttrVal -- ^ \'~=\' | AttrBegins AttrIdent AttrVal -- ^ \'|=\'- deriving (Eq)+ deriving (Eq, Show) type Element = String type Class = String@@ -149,7 +149,7 @@ data PseudoVal = PIdent Ident | PFunc Func- deriving (Eq)+ deriving (Eq, Show) ------------------------------------------------------------------- -- Values@@ -158,7 +158,7 @@ | SlashSep Expr Expr -- ^ slash separated expressions | CommaSep Expr Expr -- ^ comma separated expressions | SpaceSep Expr Expr -- ^ space separated expressions- deriving (Eq)+ deriving (Eq, Show) data Value = VDeg Deg | VRad Rad | @@ -183,306 +183,80 @@ VMs Ms | VS S | VUri Uri- deriving (Eq)+ deriving (Eq, Show) data Func = Func Ident Expr- deriving (Eq)+ deriving (Eq, Show) -- | \<angle\> data Deg = Deg Double- deriving (Eq)+ deriving (Eq, Show) -- | \<angle\> data Rad = Rad Double- deriving (Eq)+ deriving (Eq, Show) -- | \<angle\> data Grad = Grad Double- deriving (Eq)+ deriving (Eq, Show) -- | \<color\> data Color = Cword String | Crgb Int Int Int- deriving (Eq)+ deriving (Eq, Show) -- | \<frequency\> data Hz = Hz Double- deriving (Eq)+ deriving (Eq, Show) -- | \<frequency\> data KHz = KHz Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Em = Em Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Ex = Ex Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Px = Px Int- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data In = In Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Cm = Cm Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Mm = Mm Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Pc = Pc Double- deriving (Eq)+ deriving (Eq, Show) -- | \<length\> data Pt = Pt Int- deriving (Eq)+ deriving (Eq, Show) -- | \<percentage\> data Percentage = Percentage Double- deriving (Eq)+ deriving (Eq, Show) -- | \<time\> data Ms = Ms Double- deriving (Eq)+ deriving (Eq, Show) -- | \<time\> data S = S Double- deriving (Eq)+ deriving (Eq, Show) -- | \<uri\> 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 ++ ")"--+ deriving (Eq, Show)