Smart*CSSっぽい何か

Haskell 30分プログラム

http://howdyworld.org/yacss/index.htmlで最新版を配布しています。

30分+プログラム、177。Smart*CSSっぽいやつ。

Smart*CSSは以下のように記述したCSSを動的に変換するPHPスクリプト。

div.entry{
  div.title{
    ...
  }

  div.section{
    ...
  }
}

これとほとんど同じことを実現するプログラムを作った。違いは以下の通り。

  • 静的に変換する。要するに「手元で変換して、そのファイルをアップ」のような面倒なことが必要
  • 変数機能を意図的に排除。cppやm4を利用することを意図してる
  • 2007-11-08現在、利用可能(Smart*CSSは公開停止中)

後日ちゃんとREADMEとかを書くつもりです。あとWindowsバイナリを用意するかも。

使い方

# 入力例
$ cat sample1.css
body{
  h1{
    font-size:150%;
  }

  h2{
    font-size:120%;
  }
}

# 変換する
$ css sample1.css
body h1 {
  font-size: 150%;
}

body h2 {
  font-size: 120%;
}

# 変数付き
$ cat sample2.css
#define BIG 150%

body{
  h1{
    font-size:BIG;
  }

  h2{
    font-size:120%;
  }
}

# cppに通してから変換する
$ cpp -P sample2.css | css
body h1 {
  font-size: 150%;
}

body h2 {
  font-size: 120%;
}

ソースコード

module Main where
import Data.List
import Text.ParserCombinators.Parsec 
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.Printf
import System.Environment
import System.IO

data Tree a b = Branch a [Tree a b] | Leaf b deriving Show
type AssocList a b = [(a,b)]

-- 構造化されたCSS。Simple*CSSから名前を盗んだ
-- ツリーの形をしている
type SCSS = Tree Selector Property

-- 普通のCSS。
-- 連想リストの形をしている
type CSS = AssocList [Selector] [Property]

-- エイリアス
type Selector = String
type Property = (String,String)

-- scss parser
alpha = alphaNum <|> oneOf "-"
lexme = P.makeTokenParser (P.LanguageDef{
                                  P.commentStart = "/*",
                                  P.commentEnd = "*/",
                                  P.commentLine = "#",
                                  P.nestedComments = False,
                                  P.identStart  = alpha,
                                  P.identLetter = alpha,
                                  P.opStart = undefined,
                                  P.opLetter = undefined,
                                  P.reservedNames = [],
                                  P.reservedOpNames = [],
                                  P.caseSensitive = False
                                })
ident      = P.identifier lexme
whiteSpace = P.whiteSpace lexme
symbol     = P.symbol lexme

pCSS :: Parser [SCSS]
pCSS = try (do selector <- ident `sepBy1` (symbol ",")
               child <- between (symbol "{") (symbol "}") $ many pCSS
               return $ map (\sel->Branch sel $ concat child) selector) <|>
       do name <- ident
          symbol ":"
          value <- many1 $ oneOf "(),% " <|> alphaNum
          symbol ";"
          return $ [Leaf (name,value)]

pMain = do whiteSpace
           css <- many pCSS
           eof
           return $ concat css

parseSCSS = run pMain

run p input = case (parse p "" input) of
                Left err -> error $ show err
                Right x -> x

-- CSSの変換
flatten :: Tree a b -> [([a],b)]
flatten tree = f [] tree
    where f route (Branch x child) = concatMap (f (x:route)) child
          f route (Leaf x) = [(reverse route,x)]

groupAssoc :: Eq a => AssocList a b -> AssocList a [b]
groupAssoc xs = 
    map (\l@((y,_):_) -> (y,map snd l)) $
        groupBy (\(x,_) (y,_) -> x==y ) xs

toCSS :: SCSS -> CSS
toCSS = groupAssoc . flatten

-- 文字列化
fromSelector :: [Selector]->String
fromSelector = unwords

fromProperty :: [Property]->String
fromProperty prop = unlines $ map (\(name,value)->printf "  %s: %s;" name value) prop

fromCSS :: CSS->[String]
fromCSS xs = map (\(sel,prop)->printf 
                               "%s {\n%s}\n"
                               (fromSelector sel)
                               (fromProperty prop))
             xs

-- main
-- SCSSからCSSに変換する
convert :: String -> String
convert = unlines.fromCSS.(concatMap toCSS).parseSCSS

main = do args <- getArgs
          if args == [] 
            then hGetContents stdin >>= putStr.convert
            else mapM_ (\x -> readFile x >>= putStr.convert) args

参考