summaryrefslogtreecommitdiff
path: root/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch
diff options
context:
space:
mode:
Diffstat (limited to 'standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch')
-rw-r--r--standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch260
1 files changed, 260 insertions, 0 deletions
diff --git a/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch
new file mode 100644
index 000000000..3e2637293
--- /dev/null
+++ b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch
@@ -0,0 +1,260 @@
+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
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-06 06:03:12 +0000