git-annex/standalone/android/haskell-patches/shakespeare-css-1.0.2_0001-remove-TH.patch

From cb77113314702175f066cd801dee5c38d3e26576 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 28 Feb 2013 23:35:51 -0400
Subject: [PATCH] remove TH

---
 Text/Cassius.hs   |   23 ---------------
 Text/Css.hs       |   84 -----------------------------------------------------
 Text/CssCommon.hs |    4 ---
 Text/Lucius.hs    |   30 +------------------
 4 files changed, 1 insertion(+), 140 deletions(-)

diff --git a/Text/Cassius.hs b/Text/Cassius.hs
index ce05374..ae56b0a 100644
--- a/Text/Cassius.hs
+++ b/Text/Cassius.hs
@@ -13,10 +13,6 @@ module Text.Cassius
     , renderCss
     , renderCssUrl
       -- * Parsing
-    , cassius
-    , cassiusFile
-    , cassiusFileDebug
-    , cassiusFileReload
       -- * ToCss instances
       -- ** Color
     , Color (..)
@@ -27,11 +23,8 @@ module Text.Cassius
     , AbsoluteUnit (..)
     , AbsoluteSize (..)
     , absoluteSize
-    , EmSize (..)
-    , ExSize (..)
     , PercentageSize (..)
     , percentageSize
-    , PixelSize (..)
       -- * Internal
     , cassiusUsedIdentifiers
     ) where
@@ -42,25 +35,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
 import Language.Haskell.TH.Syntax
 import qualified Data.Text.Lazy as TL
 import Text.CssCommon
-import Text.Lucius (lucius)
 import qualified Text.Lucius
 import Text.IndentToBrace (i2b)
 
-cassius :: QuasiQuoter
-cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }
-
-cassiusFile :: FilePath -> Q Exp
-cassiusFile fp = do
-#ifdef GHC_7_4
-    qAddDependentFile fp
-#endif
-    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
-    quoteExp cassius contents
-
-cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp
-cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels
-cassiusFileReload = cassiusFileDebug
-
 -- | Determine which identifiers are used by the given template, useful for
 -- creating systems like yesod devel.
 cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
diff --git a/Text/Css.hs b/Text/Css.hs
index 8e6fc09..401a166 100644
--- a/Text/Css.hs
+++ b/Text/Css.hs
@@ -108,19 +108,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =
         (scope, rest') = go rest
     go' (k, v) = k ++ v
 
-cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
-             -> Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp
-cssFileDebug toi2b parseBlocks' parseBlocks fp = do
-    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp
-#ifdef GHC_7_4
-    qAddDependentFile fp
-#endif
-    let vs = cssUsedIdentifiers toi2b parseBlocks s
-    c <- mapM vtToExp vs
-    cr <- [|cssRuntime toi2b|]
-    parseBlocks'' <- parseBlocks'
-    return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c
-
 combineSelectors :: Selector -> Selector -> Selector
 combineSelectors a b = do
     a' <- a
@@ -202,17 +189,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do
 
     addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd
 
-vtToExp :: (Deref, VarType) -> Q Exp
-vtToExp (d, vt) = do
-    d' <- lift d
-    c' <- c vt
-    return $ TupE [d', c' `AppE` derefToExp [] d]
-  where
-    c :: VarType -> Q Exp
-    c VTPlain = [|CDPlain . toCss|]
-    c VTUrl = [|CDUrl|]
-    c VTUrlParam = [|CDUrlParam|]
-
 getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]
 getVars _ ContentRaw{} = return []
 getVars scope (ContentVar d) =
@@ -268,68 +244,8 @@ compressBlock (Block x y blocks) =
     cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
     cc (a:b) = a : cc b
 
-blockToCss :: Name -> Scope -> Block -> Q Exp
-blockToCss r scope (Block sel props subblocks) =
-    [|(:) (Css' $(selectorToBuilder r scope sel) $(listE $ map go props))
-      . foldr (.) id $(listE $ map subGo subblocks)
-    |]
-  where
-    go (x, y) = tupE [contentsToBuilder r scope x, contentsToBuilder r scope y]
-    subGo (Block sel' b c) =
-        blockToCss r scope $ Block sel'' b c
-      where
-        sel'' = combineSelectors sel sel'
-
-selectorToBuilder :: Name -> Scope -> Selector -> Q Exp
-selectorToBuilder r scope sels =
-    contentsToBuilder r scope $ intercalate [ContentRaw ","] sels
-
-contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp
-contentsToBuilder r scope contents =
-    appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents
-
-contentToBuilder :: Name -> Scope -> Content -> Q Exp
-contentToBuilder _ _ (ContentRaw x) =
-    [|fromText . pack|] `appE` litE (StringL x)
-contentToBuilder _ scope (ContentVar d) =
-    case d of
-        DerefIdent (Ident s)
-            | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val)
-        _ -> [|toCss|] `appE` return (derefToExp [] d)
-contentToBuilder r _ (ContentUrl u) =
-    [|fromText|] `appE`
-        (varE r `appE` return (derefToExp [] u) `appE` listE [])
-contentToBuilder r _ (ContentUrlParam u) =
-    [|fromText|] `appE`
-        ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u))
-
 type Scope = [(String, String)]
 
-topLevelsToCassius :: [TopLevel] -> Q Exp
-topLevelsToCassius a = do
-    r <- newName "_render"
-    lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a
-  where
-    go _ _ [] = return []
-    go r scope (TopBlock b:rest) = do
-        e <- [|(++) $ map Css ($(blockToCss r scope b) [])|]
-        es <- go r scope rest
-        return $ e : es
-    go r scope (TopAtBlock name s b:rest) = do
-        let s' = contentsToBuilder r scope s
-        e <- [|(:) $ AtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
-        es <- go r scope rest
-        return $ e : es
-    go r scope (TopAtDecl dec cs:rest) = do
-        e <- [|(:) $ AtDecl $(lift dec) $(contentsToBuilder r scope cs)|]
-        es <- go r scope rest
-        return $ e : es
-    go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest
-
-blocksToCassius :: Name -> Scope -> [Block] -> Q Exp
-blocksToCassius r scope a = do
-    appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a
-
 renderCss :: Css -> TL.Text
 renderCss css =
     toLazyText $ mconcat $ map go tops-- FIXME use a foldr
diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs
index 719e0a8..8c40e8c 100644
--- a/Text/CssCommon.hs
+++ b/Text/CssCommon.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
@@ -156,6 +155,3 @@ showSize :: Rational -> String -> String
 showSize value' unit = printf "%f" value ++ unit
   where value = fromRational value' :: Double
 
-mkSizeType "EmSize" "em"
-mkSizeType "ExSize" "ex"
-mkSizeType "PixelSize" "px"
diff --git a/Text/Lucius.hs b/Text/Lucius.hs
index b71614e..a902e1c 100644
--- a/Text/Lucius.hs
+++ b/Text/Lucius.hs
@@ -6,12 +6,8 @@
 {-# OPTIONS_GHC -fno-warn-missing-fields #-}
 module Text.Lucius
     ( -- * Parsing
-      lucius
-    , luciusFile
-    , luciusFileDebug
-    , luciusFileReload
       -- ** Runtime
-    , luciusRT
+      luciusRT
     , luciusRT'
     , -- * Datatypes
       Css
@@ -31,11 +27,8 @@ module Text.Lucius
     , AbsoluteUnit (..)
     , AbsoluteSize (..)
     , absoluteSize
-    , EmSize (..)
-    , ExSize (..)
     , PercentageSize (..)
     , percentageSize
-    , PixelSize (..)
       -- * Internal
     , parseTopLevels
     , luciusUsedIdentifiers
@@ -57,18 +50,6 @@ import Data.Either (partitionEithers)
 import Data.Monoid (mconcat)
 import Data.List (isSuffixOf)
 
--- |
---
--- >>> renderCss ([lucius|foo{bar:baz}|] undefined)
--- "foo{bar:baz}"
-lucius :: QuasiQuoter
-lucius = QuasiQuoter { quoteExp = luciusFromString }
-
-luciusFromString :: String -> Q Exp
-luciusFromString s =
-    topLevelsToCassius
-  $ either (error . show) id $ parse parseTopLevels s s
-
 whiteSpace :: Parser ()
 whiteSpace = many whiteSpace1 >> return ()
 
@@ -179,15 +160,6 @@ parseComment = do
     _ <- manyTill anyChar $ try $ string "*/"
     return $ ContentRaw ""
 
-luciusFile :: FilePath -> Q Exp
-luciusFile fp = do
-    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
-    luciusFromString contents
-
-luciusFileDebug, luciusFileReload :: FilePath -> Q Exp
-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
-luciusFileReload = luciusFileDebug
-
 parseTopLevels :: Parser [TopLevel]
 parseTopLevels =
     go id
-- 
1.7.10.4