diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## 0.3.0.1 + +* Make it work on modern GHCs diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Anton Kholomiov 2010 +Copyright Anton Kholomiov 2010, Tom Ellis 2020 All rights reserved. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# language-css [![Hackage version](https://img.shields.io/hackage/v/language-css.svg?label=Hackage)](https://hackage.haskell.org/package/language-css) [![Linux build status](https://img.shields.io/travis/tomjaguarpaw/language-css/master.svg?label=Linux%20build)](https://travis-ci.org/tomjaguarpaw/language-css) + +This package is deprecated. It is highly recommended that you do not +use it. diff --git a/language-css.cabal b/language-css.cabal --- a/language-css.cabal +++ b/language-css.cabal @@ -1,22 +1,32 @@ -Name: language-css -Version: 0.0.3 -Cabal-Version: >= 1.2 -License: BSD3 -License-file: LICENSE -Author: Anton Kholomiov -Synopsis: CSS 2.1 syntax -Description: library for building and pretty printing CSS 2.1 code -Stability: Experimental -Tested-With: GHC==6.13.1 -Build-Type: Simple -Category: Language -Maintainer: +name: language-css +copyright: Copyright Anton Kholomiov 2010, Tom Ellis 2020 +version: 0.0.3.1 +cabal-version: >= 1.18 +license: BSD3 +license-file: LICENSE +author: Anton Kholomiov +synopsis: CSS 2.1 syntax +description: library for building and pretty printing CSS 2.1 code + deprecated +tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 +build-type: Simple +category: Language +maintainer: Tom Ellis +extra-doc-files: README.md + CHANGELOG.md +homepage: https://github.com/tomjaguarpaw/language-css +bug-reports: https://github.com/tomjaguarpaw/language-css/issues +source-repository head + type: git + location: https://github.com/tomjaguarpaw/language-css.git + Library - Build-Depends: - base >= 4, base < 5, pretty - Hs-Source-Dirs: src/ - Exposed-Modules: + default-language: Haskell2010 + build-depends: + base >= 4, base < 5, pretty + hs-source-dirs: src/ + exposed-modules: Language.Css.Syntax Language.Css.Pretty Language.Css.Build @@ -26,9 +36,5 @@ Language.Css.Build.Pseudos ----------------------------------------------------------------------------------- - Other-Modules: - - - - +---------------------------------------------------------------------------------- + other-modules: diff --git a/src/Language/Css/Build.hs b/src/Language/Css/Build.hs --- a/src/Language/Css/Build.hs +++ b/src/Language/Css/Build.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -- | Combinators to build AST -- --- Example : +-- Example : -- -- > -- >import Language.Css.Syntax @@ -14,17 +14,17 @@ -- > body [ -- > margin <:> int 0, -- > border <:> int 0 ], --- > +-- > -- > h1 [ textAlign <:> center], -- > --- > p [ --- > backgroundColor <:> black, +-- > p [ +-- > backgroundColor <:> black, -- > color <:> white, -- > padding <:> spaces [pct 5, pct 5, pct 10, pct 10] ], -- > --- > (star /. "warning") [ color <:> red ] +-- > (star /. "warning") [ color <:> red ] -- > ] --- > +-- > -- >main = print $ pretty res -- > -- @@ -33,7 +33,7 @@ Idents(..), ToExpr(..), -- * StyleSheet - styleSheet, rules, ruleSets, + styleSheet, rules, ruleSets, addImports, addRules, charset, -- * AtRules @@ -42,12 +42,12 @@ -- * RuleSets -- ** Selectors - Sel', star, sels, + Sel', star, sels, (/>), (/-), (/#), (/.), (/:), Attrs(..), (!), (.=), (~=), (|=), - + -- ** Declarations - (<:>), important, + (<:>), important, space, slash, comma, spaces, slashes, commas, @@ -58,8 +58,8 @@ pct, ms, s, url, -- * Colors - aqua, black, blue, fuchsia, gray, green, - lime, maroon, navy, olive, orange, purple, + aqua, black, blue, fuchsia, gray, green, + lime, maroon, navy, olive, orange, purple, red, silver, teal, white, yellow ) where @@ -158,7 +158,7 @@ -- | groups selectors sels :: [Sel'] -> Sel' sels xs d = joinRules [] $ map ($ d) xs - where joinRules sels xs = + where joinRules sels xs = case xs of [] -> RuleSet sels d a:as -> joinRules (sels ++ getSels a) as @@ -185,7 +185,7 @@ -- | set id (/#) :: Sel' -> String -> Sel' -(/#) s id = liftSel1 (appendSubSel $ IdSel id) s +(/#) s id = liftSel1 (appendSubSel $ IdSel id) s -- | set class (/.) :: Sel' -> String -> Sel' @@ -193,10 +193,10 @@ -- | set attributes (!) :: Sel' -> Attr -> Sel' -(!) s attr = liftSel1 (appendSubSel $ AttrSel attr) s +(!) s attr = liftSel1 (appendSubSel $ AttrSel attr) s -- | set pseudo classes/elements -(/:) :: Sel' -> PseudoVal -> Sel' +(/:) :: Sel' -> PseudoVal -> Sel' (/:) s p = liftSel1 (appendSubSel $ PseudoSel p) s liftSel1 :: (Sel -> Sel) -> (Sel' -> Sel') @@ -204,7 +204,7 @@ where f' a = RuleSet (liftA f $ getSels a) $ getDecls a liftSel2 :: (Sel -> Sel -> Sel) -> (Sel' -> Sel' -> Sel') -liftSel2 f = liftA2 f' +liftSel2 f = liftA2 f' where f' a b = RuleSet (liftA2 f (getSels a) (getSels b)) $ getDecls a @@ -223,7 +223,7 @@ -- | element's attribute is (.=) :: AttrIdent -> AttrVal -> Attr -(.=) = AttrIs +(.=) = AttrIs -- | element's attribute includes (~=) :: AttrIdent -> AttrVal -> Attr @@ -235,17 +235,17 @@ appendSubSel :: SubSel -> Sel -> Sel -appendSubSel s a = +appendSubSel s a = case a of SSel x -> case x of UnivSel xs -> SSel $ UnivSel $ xs ++ [s] TypeSel el xs -> SSel $ TypeSel el $ xs ++ [s] DescendSel x y -> DescendSel (appendSubSel s x) (appendSubSel s y) ChildSel x y -> ChildSel (appendSubSel s x) (appendSubSel s y) - AdjSel x y -> AdjSel (appendSubSel s x) (appendSubSel s y) + AdjSel x y -> AdjSel (appendSubSel s x) (appendSubSel s y) -getSels :: RuleSet -> [Sel] +getSels :: RuleSet -> [Sel] getSels (RuleSet xs _) = xs getDecls :: RuleSet -> [Decl] @@ -262,8 +262,8 @@ (<:>) :: String -> Expr -> Decl (<:>) a b = Decl Nothing (ident a) b --- | set @!important@ -important :: Decl -> Decl +-- | set @!important@ +important :: Decl -> Decl important (Decl _ a b) = Decl (Just Important) a b -- | space separated values @@ -305,7 +305,7 @@ instance Idents Value where ident = VIdent . ident -instance ToExpr Value where +instance ToExpr Value where expr = EVal ----------------------------------------------------------------- @@ -316,87 +316,87 @@ fun :: ToExpr a => Ident -> a -> Func fun str = Func str . expr --- | \ +-- | \ deg :: Double -> Expr deg = expr . Deg --- | \ +-- | \ rad :: Double -> Expr rad = expr . Rad --- | \ +-- | \ grad :: Double -> Expr grad = expr . Grad --- | \ +-- | \ cword :: String -> Expr cword = expr . Cword . checkWord --- | \ +-- | \ rgb :: Int -> Int -> Int -> Expr rgb x0 x1 x2 = expr $ Crgb x0 x1 x2 --- | \ +-- | \ hz :: Double -> Expr hz = expr . Hz --- | \ +-- | \ khz :: Double -> Expr khz = expr . KHz --- | \ +-- | \ em :: Double -> Expr em = expr . Em --- | \ +-- | \ ex :: Double -> Expr ex = expr . Ex --- | \ +-- | \ px :: Int -> Expr px = expr . Px --- | \ +-- | \ in' :: Double -> Expr in' = expr . In --- | \ +-- | \ cm :: Double -> Expr cm = expr . Cm --- | \ +-- | \ mm :: Double -> Expr mm = expr . Mm --- | \ +-- | \ pc :: Double -> Expr pc = expr . Pc --- | \ +-- | \ pt :: Int -> Expr pt = expr . Pt --- | \ +-- | \ pct :: Double -> Expr pct = expr . Percentage --- | \ +-- | \ ms :: Double -> Expr ms = expr . Ms --- | \ +-- | \ s :: Double -> Expr s = expr . S --- | \ +-- | \ url :: String -> Expr url = expr . Uri -checkWord x +checkWord x | checkLeng x && checkNums x && checkFirst x = x - | otherwise = errorMsg - where errorMsg = error "must be number in hexadecimal notation" - checkLeng x + | otherwise = errorMsg + where errorMsg = error "must be number in hexadecimal notation" + checkLeng x | length x == 4 || length x == 7 = True | otherwise = error "string length must be 4 or 7" checkNums x @@ -404,7 +404,7 @@ | otherwise = errorMsg checkFirst x | '#' == head x = True - | otherwise = error "first character must be #" + | otherwise = error "first character must be #" @@ -414,7 +414,7 @@ int :: Int -> Expr int = expr -num :: Double -> Expr +num :: Double -> Expr num = expr -- instances @@ -489,22 +489,20 @@ -- colors -- -aqua = cword "#00ffff" +aqua = cword "#00ffff" black = cword "#000000" -blue = cword "#0000ff" -fuchsia = cword "#ff00ff" -gray = cword "#808080" -green = cword "#008000" -lime = cword "#00ff00" -maroon = cword "#800000" -navy = cword "#000080" -olive = cword "#808000" -orange = cword "#ffA500" -purple = cword "#800080" -red = cword "#ff0000" -silver = cword "#c0c0c0" -teal = cword "#008080" -white = cword "#ffffff" +blue = cword "#0000ff" +fuchsia = cword "#ff00ff" +gray = cword "#808080" +green = cword "#008000" +lime = cword "#00ff00" +maroon = cword "#800000" +navy = cword "#000080" +olive = cword "#808000" +orange = cword "#ffA500" +purple = cword "#800080" +red = cword "#ff0000" +silver = cword "#c0c0c0" +teal = cword "#008080" +white = cword "#ffffff" yellow = cword "#ffff00" - - diff --git a/src/Language/Css/Build/Pseudos.hs b/src/Language/Css/Build/Pseudos.hs --- a/src/Language/Css/Build/Pseudos.hs +++ b/src/Language/Css/Build/Pseudos.hs @@ -13,11 +13,11 @@ firstLetter, before, after -) +) where import Language.Css.Syntax -import Language.Css.Build +import Language.Css.Build -- pseudo-classes @@ -25,7 +25,7 @@ firstChild :: PseudoVal firstChild = ident "first-child" --- | :link +-- | :link link :: PseudoVal link = ident "link" @@ -45,7 +45,7 @@ focus :: PseudoVal focus = ident "focus" --- | :lang +-- | :lang lang :: Expr -> PseudoVal lang = PFunc . fun (ident "lang") @@ -55,15 +55,14 @@ firstLine :: PseudoVal firstLine = ident "first-line" --- | :first-letter +-- | :first-letter firstLetter :: PseudoVal firstLetter = ident "first-letter" --- | :before +-- | :before before :: PseudoVal before = ident "before" --- | :after +-- | :after after :: PseudoVal after = ident "after" - diff --git a/src/Language/Css/Pretty.hs b/src/Language/Css/Pretty.hs --- a/src/Language/Css/Pretty.hs +++ b/src/Language/Css/Pretty.hs @@ -2,6 +2,7 @@ Pretty(..), prettyPrint) where +import Prelude hiding ((<>)) import Text.PrettyPrint import Language.Css.Syntax @@ -9,7 +10,7 @@ class Pretty a where pretty :: a -> Doc --- | pretty-print with the default style. +-- | pretty-print with the default style. prettyPrint :: Pretty a => a -> String prettyPrint = render . pretty @@ -25,8 +26,8 @@ -- StyleSheet instance Pretty StyleSheet where - pretty (StyleSheet ch imp body) = - ppMaybe ch + pretty (StyleSheet ch imp body) = + ppMaybe ch $$ (vsep $ map pretty imp) $$ (vsep $ map pretty body) @@ -55,30 +56,29 @@ IUri x -> pretty x -- @page instance Pretty AtPage where - pretty (AtPage id pp ds) = text "@page" - <+> ppMaybe id <+> ppMaybe pp + 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" + pretty (AtMedia ms rs) = text "@media" <+> punctuatePretties comma ms <+> punctuatePretties comma rs - -- @font-face instance Pretty AtFontFace where - pretty (AtFontFace ds) = text "@font-face" + pretty (AtFontFace ds) = text "@font-face" <+> (braces $ punctuatePretties semi ds) -- RuleSets instance Pretty RuleSet where - pretty (RuleSet sels decls) = + pretty (RuleSet sels decls) = (vcat $ punctuate comma $ map pretty sels) - <+> lbrace + <+> lbrace $$ (nest 4 $ vcat $ punctuate semi $ map pretty decls) <+> rbrace @@ -86,10 +86,10 @@ -- Declarations instance Pretty Decl where - pretty (Decl prio p v) = + pretty (Decl prio p v) = case prio of Just x -> decl <+> pretty x - Nothing -> decl + Nothing -> decl where decl = pretty p <+> char ':' <+> pretty v instance Pretty Prio where @@ -98,39 +98,39 @@ -- 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 + 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 + 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 + 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 + 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) - + 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 @@ -173,7 +173,7 @@ instance Pretty Ident where - pretty (Ident a) = text a + pretty (Ident a) = text a -- Value elems @@ -188,9 +188,9 @@ 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 $ + 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 @@ -234,9 +234,3 @@ instance Pretty Uri where pretty (Uri x) = text "url" <> (parens $ text x) - - - - - - diff --git a/src/Language/Css/Syntax.hs b/src/Language/Css/Syntax.hs --- a/src/Language/Css/Syntax.hs +++ b/src/Language/Css/Syntax.hs @@ -1,7 +1,6 @@ - -- | Css2.1 syntax -- --- haskell translation of css 2.1 grammar. +-- haskell translation of css 2.1 grammar. -- -- See and module Language.Css.Syntax ( @@ -9,26 +8,26 @@ StyleSheet(..), StyleBody(..), -- * AtRule - AtCharSet(..), + AtCharSet(..), AtImport(..), ImportHead(..), - AtMedia(..), + AtMedia(..), AtPage(..), PseudoPage, AtFontFace(..), - + -- * RuleSet RuleSet(..), Decl(..), Prop, Prio(..), Expr(..), - + -- * Selectors Sel(..), SimpleSel(..), SubSel(..), Element, Attr(..), Class, Id, AttrIdent, AttrVal, PseudoVal(..), -- * Values - Value(..), - + Value(..), + -- * Primitives - Ident(..), Func(..), - - Deg(..), + Ident(..), Func(..), + + Deg(..), Rad(..), Grad(..), Color(..), @@ -61,8 +60,8 @@ data StyleSheet = StyleSheet (Maybe AtCharSet) [AtImport] [StyleBody] deriving (Eq, Show) -data StyleBody = SRuleSet RuleSet - | SAtMedia AtMedia +data StyleBody = SRuleSet RuleSet + | SAtMedia AtMedia | SAtPage AtPage | SAtFontFace AtFontFace deriving (Eq, Show) @@ -115,26 +114,26 @@ -- Selectors -- | Selector -data Sel = SSel SimpleSel -- ^ single selector - | DescendSel Sel Sel -- ^ ' ' - | ChildSel Sel Sel -- ^ \'>\' - | AdjSel Sel Sel -- ^ \'+\' +data Sel = SSel SimpleSel -- ^ single selector + | DescendSel Sel Sel -- ^ ' ' + | ChildSel Sel Sel -- ^ \'>\' + | AdjSel Sel Sel -- ^ \'+\' deriving (Eq, Show) -- | Simple selector data SimpleSel = UnivSel [SubSel] -- ^ Universal selector - | TypeSel Element [SubSel] -- ^ Type selector + | TypeSel Element [SubSel] -- ^ Type selector deriving (Eq, Show) data SubSel = AttrSel Attr -- ^ attribute selector - | ClassSel Class -- ^ \'.\' - | IdSel Id -- ^ \'#\' - | PseudoSel PseudoVal -- ^ pseudo classes/elements + | ClassSel Class -- ^ \'.\' + | IdSel Id -- ^ \'#\' + | PseudoSel PseudoVal -- ^ pseudo classes/elements deriving (Eq, Show) -- | attribute selector -data Attr = Attr AttrIdent +data Attr = Attr AttrIdent | AttrIs AttrIdent AttrVal -- ^ \'=\' | AttrIncl AttrIdent AttrVal -- ^ \'~=\' | AttrBegins AttrIdent AttrVal -- ^ \'|=\' @@ -143,7 +142,7 @@ type Element = String type Class = String type Id = String - + type AttrIdent = String type AttrVal = String @@ -160,28 +159,28 @@ | SpaceSep Expr Expr -- ^ space separated expressions deriving (Eq, Show) -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 | +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, Show) @@ -201,7 +200,7 @@ deriving (Eq, Show) -- | \ -data Color = Cword String | +data Color = Cword String | Crgb Int Int Int deriving (Eq, Show)