diff --git a/clay.cabal b/clay.cabal --- a/clay.cabal +++ b/clay.cabal @@ -1,5 +1,5 @@ Name: clay -Version: 0.6 +Version: 0.7 Synopsis: CSS preprocessor as embedded Haskell. Description: Clay is a CSS preprocessor like LESS and Sass, but implemented as an embedded @@ -11,11 +11,10 @@ . The API documentation can be found in the top level module "Clay". . - > 0.5.1 -> 0.6 - > - Simplified implementation of size rendering. - > - Implemented @font-face construct. By James Fisher. - > - Make hsl(a) colors actually print percentage values. - > - Changed the renderer to haul @font-face to the top level. + > 0.6 -> 0.7 + > - Stop printing banner in compact mode. + > - Generic font family as datatype. + > - Only drop final semicolon if doing compact printing. Author: Sebastiaan Visser Maintainer: Sebastiaan Visser diff --git a/src/Clay/Color.hs b/src/Clay/Color.hs --- a/src/Clay/Color.hs +++ b/src/Clay/Color.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Clay.Color where +import Data.Char (isHexDigit) import Data.Monoid import Data.String import Data.Text (Text) @@ -101,7 +102,7 @@ parse :: Text -> Color parse t = case Text.uncons t of - Just ('#', cs) | Text.all isHex cs -> + Just ('#', cs) | Text.all isHexDigit cs -> case Text.unpack cs of [a, b, c, d, e, f, g, h] -> rgba (hex a b) (hex c d) (hex e f) (hex g h) [a, b, c, d, e, f ] -> rgb (hex a b) (hex c d) (hex e f) @@ -112,7 +113,6 @@ where hex a b = either err fst (Text.hexadecimal (Text.singleton a <> Text.singleton b)) - isHex a = (a >= 'a' && a <= 'f') || (a >= 'A' && a <= 'F') || (a >= '0' && a <= '9') err = error "Invalid color string" ------------------------------------------------------------------------------- diff --git a/src/Clay/Common.hs b/src/Clay/Common.hs --- a/src/Clay/Common.hs +++ b/src/Clay/Common.hs @@ -58,3 +58,4 @@ call :: (IsString s, Monoid s) => s -> s -> s call fn arg = fn <> "(" <> arg <> ")" + diff --git a/src/Clay/Font.hs b/src/Clay/Font.hs --- a/src/Clay/Font.hs +++ b/src/Clay/Font.hs @@ -23,6 +23,8 @@ , sansSerif , serif , monospace +, cursive +, fantasy -- * Font-size. @@ -62,10 +64,9 @@ where import Control.Applicative -import Data.Text (pack) +import Data.Text (pack, Text) import Data.Monoid import Prelude hiding (Left, Right) -import Data.Text (Text) import Clay.Color import Clay.Common @@ -77,6 +78,8 @@ -- multiple value types. This allows us to combine different font aspects into -- a shorthand syntax. Fonts require a mandatory part and have a optional a -- part. +-- +-- class Val a => Font a where font :: a -> Css @@ -117,24 +120,33 @@ ------------------------------------------------------------------------------- -fontFamily :: [Text] -> [Text] -> Css -fontFamily a b = key "font-family" $ - let sep = if null a || null b then "" else ", " - in value (Literal <$> a) <> sep <> value b +-- | The five generic font families. +-- +-- . -sansSerif :: Text -sansSerif = "sans-serif" +newtype GenericFontFamily = GenericFontFamily Value + deriving (Val, Inherit, Auto, Other) -serif :: Text -serif = "serif" +sansSerif, serif, monospace, cursive, fantasy :: GenericFontFamily -monospace :: Text -monospace = "monospace" +sansSerif = GenericFontFamily "sans-serif" +serif = GenericFontFamily "serif" +monospace = GenericFontFamily "monospace" +cursive = GenericFontFamily "cursive" +fantasy = GenericFontFamily "fantasy" +-- | The `fontFamily` style rules takes to lists of font families: zero or more +-- custom font-families and preferably one or more generic font families. + +fontFamily :: [Text] -> [GenericFontFamily] -> Css +fontFamily a b = key "font-family" $ + let sep = if null a || null b then "" else ", " + in value (Literal <$> a) <> sep <> value b + ------------------------------------------------------------------------------- newtype FontSize = FontSize Value - deriving (Val, Inherit, Auto) + deriving (Val, Inherit, Auto, Other) xxSmall, xSmall, small, medium, large, xLarge, xxLarge, smaller, larger :: FontSize @@ -157,7 +169,7 @@ ------------------------------------------------------------------------------- newtype FontStyle = FontStyle Value - deriving (Val, Inherit, Normal) + deriving (Val, Inherit, Normal, Other) italic, oblique :: FontStyle @@ -170,7 +182,7 @@ ------------------------------------------------------------------------------- newtype FontVariant = FontVariant Value - deriving (Val, Inherit, Normal) + deriving (Val, Inherit, Normal, Other) smallCaps :: FontVariant smallCaps = FontVariant "small-caps" @@ -181,7 +193,7 @@ ------------------------------------------------------------------------------- newtype FontWeight = FontWeight Value - deriving (Val, Inherit, Normal) + deriving (Val, Inherit, Normal, Other) bold, bolder, lighter :: FontWeight @@ -198,7 +210,7 @@ ------------------------------------------------------------------------------- newtype NamedFont = NamedFont Value - deriving Val + deriving (Val, Other) caption, icon, menu, messageBox, smallCaption, statusBar :: NamedFont diff --git a/src/Clay/FontFace.hs b/src/Clay/FontFace.hs --- a/src/Clay/FontFace.hs +++ b/src/Clay/FontFace.hs @@ -39,8 +39,8 @@ value src = Value $ Plain $ case src of FontFaceSrcLocal name -> call "local" (quote name) FontFaceSrcUrl url mformat -> - (call "url" $ quote url) - <> (fromMaybe "" $ call "format" . quote . formatName <$> mformat) + call "url" (quote url) + <> fromMaybe "" (call "format" . quote . formatName <$> mformat) ------------------------------------------------------------------------------- diff --git a/src/Clay/Render.hs b/src/Clay/Render.hs --- a/src/Clay/Render.hs +++ b/src/Clay/Render.hs @@ -30,23 +30,40 @@ import qualified Clay.Stylesheet as Rule data Config = Config - { indentation :: Builder - , newline :: Builder - , sep :: Builder - , warn :: Bool - , align :: Bool - , banner :: Bool + { indentation :: Builder + , newline :: Builder + , sep :: Builder + , finalSemicolon :: Bool + , warn :: Bool + , align :: Bool + , banner :: Bool } -- | Configuration to print to a pretty human readable CSS output. pretty :: Config -pretty = Config " " "\n" " " True True True +pretty = Config + { indentation = " " + , newline = "\n" + , sep = " " + , finalSemicolon = True + , warn = True + , align = True + , banner = True + } -- | Configuration to print to a compacted unreadable CSS output. compact :: Config -compact = Config "" "" "" False False True +compact = Config + { indentation = "" + , newline = "" + , sep = "" + , finalSemicolon = False + , warn = False + , align = False + , banner = False + } -- | Render to CSS using the default configuration (`pretty`) and directly -- print to the standard output. @@ -168,27 +185,28 @@ properties :: Config -> [Either Text (Text, Text)] -> Builder properties cfg xs = - let width = 1 + maximum (Text.length . fst <$> rights xs) - ind = indentation cfg - new = newline cfg - in flip foldMap xs $ \p -> + let width = 1 + maximum (Text.length . fst <$> rights xs) + ind = indentation cfg + new = newline cfg + finalSemi = if finalSemicolon cfg then ";" else "" + in (<> new) $ (<> finalSemi) $ intersperse (";" <> new) $ flip map xs $ \p -> case p of Left w -> if warn cfg then ind <> "/* no value for " <> fromText w <> " */" <> new else mempty Right (k, v) -> let pad = if align cfg then fromText (Text.replicate (width - Text.length k) " ") else "" - in mconcat [ind, fromText k, pad, ":", sep cfg, fromText v, ";", new] + in mconcat [ind, fromText k, pad, ":", sep cfg, fromText v] selector :: Config -> Selector -> Builder selector cfg = intersperse ("," <> newline cfg) . rec where rec (In (SelectorF (Refinement ft) p)) = (<> foldMap predicate (sort ft)) <$> case p of - Star -> if length ft == 0 then ["*"] else [""] + Star -> if null ft then ["*"] else [""] Elem t -> [fromText t] Child a b -> ins " > " <$> rec a <*> rec b Deep a b -> ins " " <$> rec a <*> rec b Adjacent a b -> ins " + " <$> rec a <*> rec b Combined a b -> rec a ++ rec b - where ins s a b = (a <> s <> b) + where ins s a b = a <> s <> b predicate :: Predicate -> Builder predicate ft = mconcat $