adobe-swatch-exchange 0.1.0.0 → 0.2.0

raw patch · 6 files changed

+157/−40 lines, 6 filesdep +mtlnew-component:exe:ase2lessPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• Data/AdobeSwatchExchange.hs +27/−13
• Data/AdobeSwatchExchange/CSS.hs +47/−24
• Data/AdobeSwatchExchange/LESS.hs +46/−0
• adobe-swatch-exchange.cabal +16/−2
• ase2css.hs +1/−1
• ase2less.hs +20/−0

@@ -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."

@@ -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 []

@@ -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

@@ -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.*+ 

@@ -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 <infile.ase> <outfile.css>" 

@@ -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 <infile.ase> <outfile.less>"