diff --git a/Data/AdobeSwatchExchange.hs b/Data/AdobeSwatchExchange.hs --- a/Data/AdobeSwatchExchange.hs +++ b/Data/AdobeSwatchExchange.hs @@ -1,4 +1,12 @@ {-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +{- | + +This module defines the types for 'AdobeStageExchange' and a suitable +'Binary' instance. All the get/put helper functions are also exported, +but, in general, you will just want the types and the 'Binary' +instance. + +-} module Data.AdobeSwatchExchange where import Control.Applicative ((<$>)) @@ -50,6 +58,7 @@ -} +-- | A color data Color = CYMK Float Float Float Float | RGB Float Float Float @@ -57,12 +66,14 @@ | Gray Float deriving (Eq, Ord, Read, Show, Data, Typeable) +-- | color type data ColorType = Global | Spot | Normal deriving (Eq, Ord, Read, Show, Data, Typeable) +-- | A named color data ColorEntry = ColorEntry { colorName :: String , color :: Color @@ -70,18 +81,21 @@ } deriving (Eq, Ord, Read, Show, Data, Typeable) +-- | An Adobe Swatch Exchange block data ASEBlock = GroupStart { groupName :: String } | GroupEnd | CE ColorEntry deriving (Eq, Ord, Read, Show, Data, Typeable) +-- | AdobeSwatchExchange data AdobeSwatchExchange = AdobeSwatchExchange { version :: (Word16, Word16) , blocks :: [ASEBlock] } deriving (Eq, Ord, Read, Show, Data, Typeable) +-- | get the ASEF file signature getFileSig :: Get () getFileSig = do bs <- getByteString 4 @@ -256,16 +270,16 @@ put = putASE get = getASE -test = - do c <- B.readFile "Yellow rose.ase" - print $ runGet getASE c - return () - -test_2 = - do c <- B.readFile "Yellow rose.ase" - print c - let ase = runGet getASE c - print ase - let c' = runPut (put ase) - print c' - print (c == c') +-- | Convert a 'Color' to an RGB hex value. +colorToHex :: Color -> String +colorToHex (RGB r g b) = + showString "#" . + showHex' (round (r * 255)) . + showHex' (round (g * 255)) . + showHex' (round (b * 255)) $ "" + where + showHex' n + | n < 10 = showString "0" . showHex n + | otherwise = showHex n +colorToHex c = + error $ "Alas! We have not written the code to convert " ++ show c ++ " to the RGB color space." diff --git a/Data/AdobeSwatchExchange/CSS.hs b/Data/AdobeSwatchExchange/CSS.hs --- a/Data/AdobeSwatchExchange/CSS.hs +++ b/Data/AdobeSwatchExchange/CSS.hs @@ -1,32 +1,55 @@ +{- | + +Create a @.css@ file from a @.ase@ file. For each color in the @.ase@ the @.css@ will contain three entries: + + fg-color-ase-n + bg-color-ase-n + border-color-ase-n + +Where @n@ is an integer based on the order the color was found in the @.ase@ file. + +-} module Data.AdobeSwatchExchange.CSS where -import Data.AdobeSwatchExchange as ASE (ASEBlock(CE), ColorEntry(color), AdobeSwatchExchange, Color(RGB), blocks, getASE) +import Control.Monad.State (State, get, put, evalState) +import Data.AdobeSwatchExchange as ASE (ASEBlock(CE), ColorEntry(color), AdobeSwatchExchange, Color(RGB), blocks, colorToHex, getASE) import qualified Data.ByteString.Lazy as B import Language.Css.Build ((<:>), (/.), cword, ruleSets, star) -import Language.Css.Build.Idents as CSS (backgroundColor, color) +import Language.Css.Build.Idents as CSS (backgroundColor, borderColor, color) import Language.Css.Syntax (Expr, RuleSet, StyleSheet) import Numeric (showHex) -ase2css :: [ColorEntry] -> StyleSheet -ase2css colorEntries = - ruleSets (concatMap genColor (zip [1..] colorEntries)) - -genColor :: (Int, ColorEntry) -> [RuleSet] -genColor (n, colorEntry) = - [ (star /. ("fg-color-ase-" ++ Prelude.show n)) [ CSS.color <:> (colorToHex (ASE.color colorEntry)) - ] - , (star /. ("bg-color-ase-" ++ Prelude.show n)) [ backgroundColor <:> (colorToHex (ASE.color colorEntry)) - ] - ] +-- | generate a 'StyleSheet' from an 'AdobeSwatchExchange' +ase2css :: AdobeSwatchExchange -> StyleSheet +ase2css ase = + ruleSets (concat $ evalState (mapM genBlock (blocks ase)) 1) -colorToHex :: Color -> Expr -colorToHex (RGB r g b) = - cword $ - showString "#" . - showHex' (round (r * 255)) . - showHex' (round (g * 255)) . - showHex' (round (b * 255)) $ "" - where - showHex' n - | n < 10 = showString "0" . showHex n - | otherwise = showHex n +-- | generate a color rules from an indexed @ColorEntry@ +-- +-- generates: +-- +-- fg-color-ase-n +-- bg-color-ase-n +-- border-color-ase-n +-- +-- Currently only 'RGB' color is supported. Since CSS only supports +-- rgb, supporting other colors would require the conversion to RGB +-- color space. Feel free to send a patch! +-- genColor :: (Int, ASEBlock) -> (Int, [RuleSet]) +genBlock :: ASEBlock -> State Int [RuleSet] +genBlock (CE colorEntry) = + do n <- get + put $! (n + 1) + return [ (star /. ("fg-color-ase-" ++ Prelude.show n)) + [ CSS.color <:> (cword $ colorToHex (ASE.color colorEntry)) + ] + , (star /. ("bg-color-ase-" ++ Prelude.show n)) + [ backgroundColor <:> (cword $ colorToHex (ASE.color colorEntry)) + ] + , (star /. ("border-color-ase-" ++ Prelude.show n)) + [ borderColor <:> (cword $ colorToHex (ASE.color colorEntry)) + ] + ] +-- in theory, we should generate CSS comments for the GroupName, but +-- language-css does not support comments :-/ +genBlock _ = return [] diff --git a/Data/AdobeSwatchExchange/LESS.hs b/Data/AdobeSwatchExchange/LESS.hs new file mode 100644 --- /dev/null +++ b/Data/AdobeSwatchExchange/LESS.hs @@ -0,0 +1,46 @@ +{- | + +Create a @.less@ file from a @.ase@ file. For each color in the @.ase@ the @.css@ will contain an entry: + + color-ase-n + +Where @n@ is an integer based on the order the color was found in the @.ase@ file. + +-} +module Data.AdobeSwatchExchange.LESS where + +import Control.Monad.State (State, evalState, get, put) +import Data.AdobeSwatchExchange as ASE (ASEBlock(CE, GroupStart, GroupEnd), ColorEntry(color), AdobeSwatchExchange, Color(RGB), blocks, colorToHex, getASE) +import qualified Data.ByteString.Lazy as B +import Numeric (showHex) +import Text.PrettyPrint.HughesPJ (Doc, (<>), (<+>), ($+$), braces, colon, empty, int, semi, text, vcat) + +-- | generate a less document from an 'AdobeSwatchExchange' +ase2less :: AdobeSwatchExchange -> Doc +ase2less ase = + vcat $ evalState (mapM genColor (blocks ase)) 1 + +-- | generate a color rules from an indexed @ColorEntry@ +-- +-- generates: +-- +-- fg-color-ase-n +-- bg-color-ase-n +-- border-color-ase-n +-- +-- Currently only 'RGB' color is supported. Since CSS only supports +-- rgb, supporting other colors would require the conversion to RGB +-- color space. Feel free to send a patch! +genColor :: ASEBlock -> State Int Doc +genColor (CE colorEntry) = + do n <- get + put $! (n + 1) + let colorAse = text "@color-ase-" <> int n + return $ colorAse <> colon <+> (text $ colorToHex (color colorEntry)) <> semi $+$ + text ".fg-color-ase-" <> int n <+> braces (text "color:" <+> colorAse <> semi) $+$ + text ".bg-color-ase-" <> int n <+> braces (text "background-color:" <+> colorAse <> semi) $+$ + text ".border-color-ase-" <> int n <+> braces (text "border-color:" <+> colorAse <> semi) $+$ + text "" +genColor (GroupStart name) = + return $ text "/* Group" <+> text name <+> text "*/" -- FIXME: what if name contains */ +genColor _ = return empty diff --git a/adobe-swatch-exchange.cabal b/adobe-swatch-exchange.cabal --- a/adobe-swatch-exchange.cabal +++ b/adobe-swatch-exchange.cabal @@ -1,5 +1,5 @@ name: adobe-swatch-exchange -version: 0.1.0.0 +version: 0.2.0 synopsis: parse Adobe Swatch Exchange files and (optionally) output .css files with the colors homepage: https://github.com/stepcut/ase2css license: BSD3 @@ -13,11 +13,14 @@ library exposed-modules: Data.AdobeSwatchExchange Data.AdobeSwatchExchange.CSS + Data.AdobeSwatchExchange.LESS build-depends: base >= 4.5 && < 5, bytestring == 0.10.*, data-binary-ieee754 == 0.4.*, binary == 0.5.*, - language-css == 0.0.* + language-css == 0.0.*, + mtl >= 2.0 && < 2.2, + pretty == 1.1.* executable ase2css main-is: ase2css.hs build-depends: base >= 4.5 && < 5, @@ -25,5 +28,16 @@ bytestring == 0.10.*, data-binary-ieee754 == 0.4.*, language-css == 0.0.*, + mtl >= 2.0 && < 2.2, pretty == 1.1.* + +executable ase2less + main-is: ase2less.hs + build-depends: base >= 4.5 && < 5, + binary == 0.5.*, + bytestring == 0.10.*, + data-binary-ieee754 == 0.4.*, + mtl >= 2.0 && < 2.2, + pretty == 1.1.* + diff --git a/ase2css.hs b/ase2css.hs --- a/ase2css.hs +++ b/ase2css.hs @@ -16,7 +16,7 @@ do c <- B.readFile inFile let ase = runGet getASE c css = text "/* Generated from" <+> doubleQuotes (text inFile) <+> text "using ase2css */" $+$ - pretty (ase2css [ ce | (CE ce) <- blocks ase ]) + pretty (ase2css ase) writeFile outFile $ show $ css _ -> putStrLn "Usage: ase2css " diff --git a/ase2less.hs b/ase2less.hs new file mode 100644 --- /dev/null +++ b/ase2less.hs @@ -0,0 +1,20 @@ +module Main where + +import Data.AdobeSwatchExchange.LESS (ase2less) +import Data.AdobeSwatchExchange (ASEBlock(CE), ColorEntry(colorName), AdobeSwatchExchange, blocks, getASE) +import qualified Data.ByteString.Lazy as B +import Data.Binary.Get (runGet) +import System.Environment (getArgs) +import Text.PrettyPrint.HughesPJ (($+$), (<+>), doubleQuotes, text) + +main :: IO () +main = + do args <- getArgs + case args of + [inFile, outFile] -> + do c <- B.readFile inFile + let ase = runGet getASE c + less = text "/* Generated from" <+> doubleQuotes (text inFile) <+> text "using ase2less */" $+$ + ase2less ase + writeFile outFile $ show $ less + _ -> putStrLn "Usage: ase2css "