From be2245f59093276c115fe82ebe25dc332de9d763 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 7 May 2013 17:50:14 -0400 Subject: fix filenames --- .../shakespeare-css_1.0.2_0001-remove-TH.patch | 260 ++++++++++++++++++ ...-css_1.0.2_0002-expose-modules-used-by-TH.patch | 26 ++ .../shakespeare-i18n_1.0.0.2_0001-remove-TH.patch | 162 +++++++++++ .../shakespeare-js_1.1.2_0001-remove-TH.patch | 303 +++++++++++++++++++++ .../shakespeare_css-1.0.2_0001-remove-TH.patch | 260 ------------------ ..._css-1.0.2_0002-expose-modules-used-by-TH.patch | 26 -- .../shakespeare_i18n-1.0.0.2_0001-remove-TH.patch | 162 ----------- .../shakespeare_js-1.1.2_0001-remove-TH.patch | 303 --------------------- 8 files changed, 751 insertions(+), 751 deletions(-) create mode 100644 standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch create mode 100644 standalone/android/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch create mode 100644 standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch create mode 100644 standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch delete mode 100644 standalone/android/haskell-patches/shakespeare_css-1.0.2_0001-remove-TH.patch delete mode 100644 standalone/android/haskell-patches/shakespeare_css-1.0.2_0002-expose-modules-used-by-TH.patch delete mode 100644 standalone/android/haskell-patches/shakespeare_i18n-1.0.0.2_0001-remove-TH.patch delete mode 100644 standalone/android/haskell-patches/shakespeare_js-1.1.2_0001-remove-TH.patch (limited to 'standalone/android/haskell-patches') 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 +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 + diff --git a/standalone/android/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch new file mode 100644 index 000000000..5bf57d527 --- /dev/null +++ b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch @@ -0,0 +1,26 @@ +From 23e96f0d948e7a26febf1745a4c373faf579c8ee Mon Sep 17 00:00:00 2001 +From: Joey Hess +Date: Mon, 15 Apr 2013 16:32:31 -0400 +Subject: [PATCH] expose modules used by TH + +--- + shakespeare-css.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal +index de2497b..468353a 100644 +--- a/shakespeare-css.cabal ++++ b/shakespeare-css.cabal +@@ -39,8 +39,8 @@ library + + exposed-modules: Text.Cassius + Text.Lucius +- other-modules: Text.MkSizeType + Text.Css ++ other-modules: Text.MkSizeType + Text.IndentToBrace + Text.CssCommon + ghc-options: -Wall +-- +1.8.2.rc3 + diff --git a/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch new file mode 100644 index 000000000..60528db0d --- /dev/null +++ b/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch @@ -0,0 +1,162 @@ +From b128412ecee9677b788abecbbf1fd1edd447eea2 Mon Sep 17 00:00:00 2001 +From: Joey Hess +Date: Thu, 28 Feb 2013 23:35:59 -0400 +Subject: [PATCH] remove TH + +--- + Text/Shakespeare/I18N.hs | 130 +--------------------------------------------- + 1 file changed, 1 insertion(+), 129 deletions(-) + +diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs +index 1b486ed..aa5e358 100644 +--- a/Text/Shakespeare/I18N.hs ++++ b/Text/Shakespeare/I18N.hs +@@ -51,10 +51,7 @@ + -- + -- You can also adapt those instructions for use with other systems. + module Text.Shakespeare.I18N +- ( mkMessage +- , mkMessageFor +- , mkMessageVariant +- , RenderMessage (..) ++ ( RenderMessage (..) + , ToMessage (..) + , SomeMessage (..) + , Lang +@@ -115,133 +112,8 @@ type Lang = Text + -- + -- 3. create a 'RenderMessage' instance + -- +-mkMessage :: String -- ^ base name to use for translation type +- -> FilePath -- ^ subdirectory which contains the translation files +- -> Lang -- ^ default translation language +- -> Q [Dec] +-mkMessage dt folder lang = +- mkMessageCommon True "Msg" "Message" dt dt folder lang + + +--- | create 'RenderMessage' instance for an existing data-type +-mkMessageFor :: String -- ^ master translation data type +- -> String -- ^ existing type to add translations for +- -> FilePath -- ^ path to translation folder +- -> Lang -- ^ default language +- -> Q [Dec] +-mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang +- +--- | create an additional set of translations for a type created by `mkMessage` +-mkMessageVariant :: String -- ^ master translation data type +- -> String -- ^ existing type to add translations for +- -> FilePath -- ^ path to translation folder +- -> Lang -- ^ default language +- -> Q [Dec] +-mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang +- +--- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type +-mkMessageCommon :: Bool -- ^ generate a new datatype from the constructors found in the .msg files +- -> String -- ^ string to append to constructor names +- -> String -- ^ string to append to datatype name +- -> String -- ^ base name of master datatype +- -> String -- ^ base name of translation datatype +- -> FilePath -- ^ path to translation folder +- -> Lang -- ^ default lang +- -> Q [Dec] +-mkMessageCommon genType prefix postfix master dt folder lang = do +- files <- qRunIO $ getDirectoryContents folder +- (_files', contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files +-#ifdef GHC_7_4 +- mapM_ qAddDependentFile _files' +-#endif +- sdef <- +- case lookup lang contents of +- Nothing -> error $ "Did not find main language file: " ++ unpack lang +- Just def -> toSDefs def +- mapM_ (checkDef sdef) $ map snd contents +- let mname = mkName $ dt ++ postfix +- c1 <- fmap concat $ mapM (toClauses prefix dt) contents +- c2 <- mapM (sToClause prefix dt) sdef +- c3 <- defClause +- return $ +- ( if genType +- then ((DataD [] mname [] (map (toCon dt) sdef) []) :) +- else id) +- [ InstanceD +- [] +- (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname) +- [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3] +- ] +- ] +- +-toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause] +-toClauses prefix dt (lang, defs) = +- mapM go defs +- where +- go def = do +- a <- newName "lang" +- (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def) +- guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|] +- return $ Clause +- [WildP, ConP (mkName ":") [VarP a, WildP], pat] +- (GuardedB [(guard, bod)]) +- [] +- +-mkBody :: String -- ^ datatype +- -> String -- ^ constructor +- -> [String] -- ^ variable names +- -> [Content] +- -> Q (Pat, Exp) +-mkBody dt cs vs ct = do +- vp <- mapM go vs +- let pat = RecP (mkName cs) (map (varName dt *** VarP) vp) +- let ct' = map (fixVars vp) ct +- pack' <- [|Data.Text.pack|] +- tomsg <- [|toMessage|] +- let ct'' = map (toH pack' tomsg) ct' +- mapp <- [|mappend|] +- let app a b = InfixE (Just a) mapp (Just b) +- e <- +- case ct'' of +- [] -> [|mempty|] +- [x] -> return x +- (x:xs) -> return $ foldl' app x xs +- return (pat, e) +- where +- toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String) +- toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d +- go x = do +- let y = mkName $ '_' : x +- return (x, y) +- fixVars vp (Var d) = Var $ fixDeref vp d +- fixVars _ (Raw s) = Raw s +- fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i +- fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b) +- fixDeref _ d = d +- fixIdent vp i = +- case lookup i vp of +- Nothing -> i +- Just y -> nameBase y +- +-sToClause :: String -> String -> SDef -> Q Clause +-sToClause prefix dt sdef = do +- (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef) +- return $ Clause +- [WildP, ConP (mkName "[]") [], pat] +- (NormalB bod) +- [] +- +-defClause :: Q Clause +-defClause = do +- a <- newName "sub" +- c <- newName "langs" +- d <- newName "msg" +- rm <- [|renderMessage|] +- return $ Clause +- [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d] +- (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) +- [] +- + toCon :: String -> SDef -> Con + toCon dt (SDef c vs _) = + RecC (mkName $ "Msg" ++ c) $ map go vs +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch new file mode 100644 index 000000000..b583d6e0a --- /dev/null +++ b/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch @@ -0,0 +1,303 @@ +From f3e31696cfb45a528e4b4b6f016dc7101d7cd4fb Mon Sep 17 00:00:00 2001 +From: Joey Hess +Date: Thu, 28 Feb 2013 23:36:06 -0400 +Subject: [PATCH] remove TH + +--- + Text/Coffee.hs | 54 ------------------------------------------------- + Text/Julius.hs | 53 +----------------------------------------------- + Text/Roy.hs | 54 ------------------------------------------------- + Text/TypeScript.hs | 57 +--------------------------------------------------- + 4 files changed, 2 insertions(+), 216 deletions(-) + +diff --git a/Text/Coffee.hs b/Text/Coffee.hs +index 2481936..3f7f9c3 100644 +--- a/Text/Coffee.hs ++++ b/Text/Coffee.hs +@@ -51,14 +51,6 @@ module Text.Coffee + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- coffee +- , coffeeFile +- , coffeeFileReload +- , coffeeFileDebug +- +-#ifdef TEST_EXPORT +- , coffeeSettings +-#endif + ) where + + import Language.Haskell.TH.Quote (QuasiQuoter (..)) +@@ -66,49 +58,3 @@ import Language.Haskell.TH.Syntax + import Text.Shakespeare + import Text.Julius + +-coffeeSettings :: Q ShakespeareSettings +-coffeeSettings = do +- jsettings <- javascriptSettings +- return $ jsettings { varChar = '%' +- , preConversion = Just PreConvert { +- preConvert = ReadProcess "coffee" ["-spb"] +- , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks. +- , preEscapeIgnoreLine = "#" -- ignore commented lines +- , wrapInsertion = Just WrapInsertion { +- wrapInsertionIndent = Just " " +- , wrapInsertionStartBegin = "((" +- , wrapInsertionSeparator = ", " +- , wrapInsertionStartClose = ") =>" +- , wrapInsertionEnd = ")" +- , wrapInsertionApplyBegin = "(" +- , wrapInsertionApplyClose = ")\n" +- } +- } +- } +- +--- | Read inline, quasiquoted CoffeeScript. +-coffee :: QuasiQuoter +-coffee = QuasiQuoter { quoteExp = \s -> do +- rs <- coffeeSettings +- quoteExp (shakespeare rs) s +- } +- +--- | Read in a CoffeeScript template file. This function reads the file once, at +--- compile time. +-coffeeFile :: FilePath -> Q Exp +-coffeeFile fp = do +- rs <- coffeeSettings +- shakespeareFile rs fp +- +--- | Read in a CoffeeScript template file. This impure function uses +--- unsafePerformIO to re-read the file on every call, allowing for rapid +--- iteration. +-coffeeFileReload :: FilePath -> Q Exp +-coffeeFileReload fp = do +- rs <- coffeeSettings +- shakespeareFileReload rs fp +- +--- | Deprecated synonym for 'coffeeFileReload' +-coffeeFileDebug :: FilePath -> Q Exp +-coffeeFileDebug = coffeeFileReload +-{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-} +diff --git a/Text/Julius.hs b/Text/Julius.hs +index 230eac3..b990f73 100644 +--- a/Text/Julius.hs ++++ b/Text/Julius.hs +@@ -14,17 +14,8 @@ module Text.Julius + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- js +- , julius +- , juliusFile +- , jsFile +- , juliusFileDebug +- , jsFileDebug +- , juliusFileReload +- , jsFileReload +- + -- * Datatypes +- , JavascriptUrl ++ JavascriptUrl + , Javascript (..) + , RawJavascript (..) + +@@ -37,7 +28,6 @@ module Text.Julius + , renderJavascriptUrl + + -- ** internal, used by 'Text.Coffee' +- , javascriptSettings + -- ** internal + , juliusUsedIdentifiers + ) where +@@ -101,47 +91,6 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText + instance RawJS Builder where rawJS = RawJavascript + instance RawJS Bool where rawJS = RawJavascript . toJavascript + +-javascriptSettings :: Q ShakespeareSettings +-javascriptSettings = do +- toJExp <- [|toJavascript|] +- wrapExp <- [|Javascript|] +- unWrapExp <- [|unJavascript|] +- asJavascriptUrl' <- [|asJavascriptUrl|] +- return $ defaultShakespeareSettings { toBuilder = toJExp +- , wrap = wrapExp +- , unwrap = unWrapExp +- , modifyFinalValue = Just asJavascriptUrl' +- } +- +-js, julius :: QuasiQuoter +-js = QuasiQuoter { quoteExp = \s -> do +- rs <- javascriptSettings +- quoteExp (shakespeare rs) s +- } +- +-julius = js +- +-jsFile, juliusFile :: FilePath -> Q Exp +-jsFile fp = do +- rs <- javascriptSettings +- shakespeareFile rs fp +- +-juliusFile = jsFile +- +- +-jsFileReload, juliusFileReload :: FilePath -> Q Exp +-jsFileReload fp = do +- rs <- javascriptSettings +- shakespeareFileReload rs fp +- +-juliusFileReload = jsFileReload +- +-jsFileDebug, juliusFileDebug :: FilePath -> Q Exp +-juliusFileDebug = jsFileReload +-{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-} +-jsFileDebug = jsFileReload +-{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-} +- + -- | Determine which identifiers are used by the given template, useful for + -- creating systems like yesod devel. + juliusUsedIdentifiers :: String -> [(Deref, VarType)] +diff --git a/Text/Roy.hs b/Text/Roy.hs +index cf09cec..870c9f6 100644 +--- a/Text/Roy.hs ++++ b/Text/Roy.hs +@@ -23,13 +23,6 @@ module Text.Roy + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- roy +- , royFile +- , royFileReload +- +-#ifdef TEST_EXPORT +- , roySettings +-#endif + ) where + + import Language.Haskell.TH.Quote (QuasiQuoter (..)) +@@ -37,50 +30,3 @@ import Language.Haskell.TH.Syntax + import Text.Shakespeare + import Text.Julius + +--- | The Roy language compiles down to Javascript. +--- We do this compilation once at compile time to avoid needing to do it during the request. +--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. +-roySettings :: Q ShakespeareSettings +-roySettings = do +- jsettings <- javascriptSettings +- return $ jsettings { varChar = '#' +- , preConversion = Just PreConvert { +- preConvert = ReadProcess "roy" ["--stdio"] +- , preEscapeIgnoreBalanced = "'\"" +- , preEscapeIgnoreLine = "//" +- , wrapInsertion = Nothing +- {- +- Just WrapInsertion { +- wrapInsertionIndent = Just " " +- , wrapInsertionStartBegin = "(\\" +- , wrapInsertionSeparator = " " +- , wrapInsertionStartClose = " ->\n" +- , wrapInsertionEnd = ")" +- , wrapInsertionApplyBegin = " " +- , wrapInsertionApplyClose = ")\n" +- } +- -} +- } +- } +- +--- | Read inline, quasiquoted Roy. +-roy :: QuasiQuoter +-roy = QuasiQuoter { quoteExp = \s -> do +- rs <- roySettings +- quoteExp (shakespeare rs) s +- } +- +--- | Read in a Roy template file. This function reads the file once, at +--- compile time. +-royFile :: FilePath -> Q Exp +-royFile fp = do +- rs <- roySettings +- shakespeareFile rs fp +- +--- | Read in a Roy template file. This impure function uses +--- unsafePerformIO to re-read the file on every call, allowing for rapid +--- iteration. +-royFileReload :: FilePath -> Q Exp +-royFileReload fp = do +- rs <- roySettings +- shakespeareFileReload rs fp +diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs +index 34bf4bf..30c5388 100644 +--- a/Text/TypeScript.hs ++++ b/Text/TypeScript.hs +@@ -53,65 +53,10 @@ + -- + -- 2. TypeScript: + module Text.TypeScript +- ( -- * Functions +- -- ** Template-Reading Functions +- -- | These QuasiQuoter and Template Haskell methods return values of +- -- type @'JavascriptUrl' url@. See the Yesod book for details. +- tsc +- , typeScriptFile +- , typeScriptFileReload +- +-#ifdef TEST_EXPORT +- , typeScriptSettings +-#endif ++ ( + ) where + + import Language.Haskell.TH.Quote (QuasiQuoter (..)) + import Language.Haskell.TH.Syntax + import Text.Shakespeare + import Text.Julius +- +--- | The TypeScript language compiles down to Javascript. +--- We do this compilation once at compile time to avoid needing to do it during the request. +--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. +-typeScriptSettings :: Q ShakespeareSettings +-typeScriptSettings = do +- jsettings <- javascriptSettings +- return $ jsettings { varChar = '#' +- , preConversion = Just PreConvert { +- preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"] +- , preEscapeIgnoreBalanced = "'\"" +- , preEscapeIgnoreLine = "//" +- , wrapInsertion = Just WrapInsertion { +- wrapInsertionIndent = Nothing +- , wrapInsertionStartBegin = ";(function(" +- , wrapInsertionSeparator = ", " +- , wrapInsertionStartClose = "){" +- , wrapInsertionEnd = "})" +- , wrapInsertionApplyBegin = "(" +- , wrapInsertionApplyClose = ");\n" +- } +- } +- } +- +--- | Read inline, quasiquoted TypeScript +-tsc :: QuasiQuoter +-tsc = QuasiQuoter { quoteExp = \s -> do +- rs <- typeScriptSettings +- quoteExp (shakespeare rs) s +- } +- +--- | Read in a Roy template file. This function reads the file once, at +--- compile time. +-typeScriptFile :: FilePath -> Q Exp +-typeScriptFile fp = do +- rs <- typeScriptSettings +- shakespeareFile rs fp +- +--- | Read in a Roy template file. This impure function uses +--- unsafePerformIO to re-read the file on every call, allowing for rapid +--- iteration. +-typeScriptFileReload :: FilePath -> Q Exp +-typeScriptFileReload fp = do +- rs <- typeScriptSettings +- shakespeareFileReload rs fp +-- +1.7.10.4 + 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 deleted file mode 100644 index 3e2637293..000000000 --- a/standalone/android/haskell-patches/shakespeare_css-1.0.2_0001-remove-TH.patch +++ /dev/null @@ -1,260 +0,0 @@ -From cb77113314702175f066cd801dee5c38d3e26576 Mon Sep 17 00:00:00 2001 -From: Joey Hess -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 - diff --git a/standalone/android/haskell-patches/shakespeare_css-1.0.2_0002-expose-modules-used-by-TH.patch b/standalone/android/haskell-patches/shakespeare_css-1.0.2_0002-expose-modules-used-by-TH.patch deleted file mode 100644 index 5bf57d527..000000000 --- a/standalone/android/haskell-patches/shakespeare_css-1.0.2_0002-expose-modules-used-by-TH.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 23e96f0d948e7a26febf1745a4c373faf579c8ee Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Mon, 15 Apr 2013 16:32:31 -0400 -Subject: [PATCH] expose modules used by TH - ---- - shakespeare-css.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal -index de2497b..468353a 100644 ---- a/shakespeare-css.cabal -+++ b/shakespeare-css.cabal -@@ -39,8 +39,8 @@ library - - exposed-modules: Text.Cassius - Text.Lucius -- other-modules: Text.MkSizeType - Text.Css -+ other-modules: Text.MkSizeType - Text.IndentToBrace - Text.CssCommon - ghc-options: -Wall --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/shakespeare_i18n-1.0.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare_i18n-1.0.0.2_0001-remove-TH.patch deleted file mode 100644 index 60528db0d..000000000 --- a/standalone/android/haskell-patches/shakespeare_i18n-1.0.0.2_0001-remove-TH.patch +++ /dev/null @@ -1,162 +0,0 @@ -From b128412ecee9677b788abecbbf1fd1edd447eea2 Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Thu, 28 Feb 2013 23:35:59 -0400 -Subject: [PATCH] remove TH - ---- - Text/Shakespeare/I18N.hs | 130 +--------------------------------------------- - 1 file changed, 1 insertion(+), 129 deletions(-) - -diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs -index 1b486ed..aa5e358 100644 ---- a/Text/Shakespeare/I18N.hs -+++ b/Text/Shakespeare/I18N.hs -@@ -51,10 +51,7 @@ - -- - -- You can also adapt those instructions for use with other systems. - module Text.Shakespeare.I18N -- ( mkMessage -- , mkMessageFor -- , mkMessageVariant -- , RenderMessage (..) -+ ( RenderMessage (..) - , ToMessage (..) - , SomeMessage (..) - , Lang -@@ -115,133 +112,8 @@ type Lang = Text - -- - -- 3. create a 'RenderMessage' instance - -- --mkMessage :: String -- ^ base name to use for translation type -- -> FilePath -- ^ subdirectory which contains the translation files -- -> Lang -- ^ default translation language -- -> Q [Dec] --mkMessage dt folder lang = -- mkMessageCommon True "Msg" "Message" dt dt folder lang - - ---- | create 'RenderMessage' instance for an existing data-type --mkMessageFor :: String -- ^ master translation data type -- -> String -- ^ existing type to add translations for -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default language -- -> Q [Dec] --mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang -- ---- | create an additional set of translations for a type created by `mkMessage` --mkMessageVariant :: String -- ^ master translation data type -- -> String -- ^ existing type to add translations for -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default language -- -> Q [Dec] --mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang -- ---- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type --mkMessageCommon :: Bool -- ^ generate a new datatype from the constructors found in the .msg files -- -> String -- ^ string to append to constructor names -- -> String -- ^ string to append to datatype name -- -> String -- ^ base name of master datatype -- -> String -- ^ base name of translation datatype -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default lang -- -> Q [Dec] --mkMessageCommon genType prefix postfix master dt folder lang = do -- files <- qRunIO $ getDirectoryContents folder -- (_files', contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files --#ifdef GHC_7_4 -- mapM_ qAddDependentFile _files' --#endif -- sdef <- -- case lookup lang contents of -- Nothing -> error $ "Did not find main language file: " ++ unpack lang -- Just def -> toSDefs def -- mapM_ (checkDef sdef) $ map snd contents -- let mname = mkName $ dt ++ postfix -- c1 <- fmap concat $ mapM (toClauses prefix dt) contents -- c2 <- mapM (sToClause prefix dt) sdef -- c3 <- defClause -- return $ -- ( if genType -- then ((DataD [] mname [] (map (toCon dt) sdef) []) :) -- else id) -- [ InstanceD -- [] -- (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname) -- [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3] -- ] -- ] -- --toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause] --toClauses prefix dt (lang, defs) = -- mapM go defs -- where -- go def = do -- a <- newName "lang" -- (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def) -- guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|] -- return $ Clause -- [WildP, ConP (mkName ":") [VarP a, WildP], pat] -- (GuardedB [(guard, bod)]) -- [] -- --mkBody :: String -- ^ datatype -- -> String -- ^ constructor -- -> [String] -- ^ variable names -- -> [Content] -- -> Q (Pat, Exp) --mkBody dt cs vs ct = do -- vp <- mapM go vs -- let pat = RecP (mkName cs) (map (varName dt *** VarP) vp) -- let ct' = map (fixVars vp) ct -- pack' <- [|Data.Text.pack|] -- tomsg <- [|toMessage|] -- let ct'' = map (toH pack' tomsg) ct' -- mapp <- [|mappend|] -- let app a b = InfixE (Just a) mapp (Just b) -- e <- -- case ct'' of -- [] -> [|mempty|] -- [x] -> return x -- (x:xs) -> return $ foldl' app x xs -- return (pat, e) -- where -- toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String) -- toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d -- go x = do -- let y = mkName $ '_' : x -- return (x, y) -- fixVars vp (Var d) = Var $ fixDeref vp d -- fixVars _ (Raw s) = Raw s -- fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i -- fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b) -- fixDeref _ d = d -- fixIdent vp i = -- case lookup i vp of -- Nothing -> i -- Just y -> nameBase y -- --sToClause :: String -> String -> SDef -> Q Clause --sToClause prefix dt sdef = do -- (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef) -- return $ Clause -- [WildP, ConP (mkName "[]") [], pat] -- (NormalB bod) -- [] -- --defClause :: Q Clause --defClause = do -- a <- newName "sub" -- c <- newName "langs" -- d <- newName "msg" -- rm <- [|renderMessage|] -- return $ Clause -- [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d] -- (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) -- [] -- - toCon :: String -> SDef -> Con - toCon dt (SDef c vs _) = - RecC (mkName $ "Msg" ++ c) $ map go vs --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/shakespeare_js-1.1.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare_js-1.1.2_0001-remove-TH.patch deleted file mode 100644 index b583d6e0a..000000000 --- a/standalone/android/haskell-patches/shakespeare_js-1.1.2_0001-remove-TH.patch +++ /dev/null @@ -1,303 +0,0 @@ -From f3e31696cfb45a528e4b4b6f016dc7101d7cd4fb Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Thu, 28 Feb 2013 23:36:06 -0400 -Subject: [PATCH] remove TH - ---- - Text/Coffee.hs | 54 ------------------------------------------------- - Text/Julius.hs | 53 +----------------------------------------------- - Text/Roy.hs | 54 ------------------------------------------------- - Text/TypeScript.hs | 57 +--------------------------------------------------- - 4 files changed, 2 insertions(+), 216 deletions(-) - -diff --git a/Text/Coffee.hs b/Text/Coffee.hs -index 2481936..3f7f9c3 100644 ---- a/Text/Coffee.hs -+++ b/Text/Coffee.hs -@@ -51,14 +51,6 @@ module Text.Coffee - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- coffee -- , coffeeFile -- , coffeeFileReload -- , coffeeFileDebug -- --#ifdef TEST_EXPORT -- , coffeeSettings --#endif - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) -@@ -66,49 +58,3 @@ import Language.Haskell.TH.Syntax - import Text.Shakespeare - import Text.Julius - --coffeeSettings :: Q ShakespeareSettings --coffeeSettings = do -- jsettings <- javascriptSettings -- return $ jsettings { varChar = '%' -- , preConversion = Just PreConvert { -- preConvert = ReadProcess "coffee" ["-spb"] -- , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks. -- , preEscapeIgnoreLine = "#" -- ignore commented lines -- , wrapInsertion = Just WrapInsertion { -- wrapInsertionIndent = Just " " -- , wrapInsertionStartBegin = "((" -- , wrapInsertionSeparator = ", " -- , wrapInsertionStartClose = ") =>" -- , wrapInsertionEnd = ")" -- , wrapInsertionApplyBegin = "(" -- , wrapInsertionApplyClose = ")\n" -- } -- } -- } -- ---- | Read inline, quasiquoted CoffeeScript. --coffee :: QuasiQuoter --coffee = QuasiQuoter { quoteExp = \s -> do -- rs <- coffeeSettings -- quoteExp (shakespeare rs) s -- } -- ---- | Read in a CoffeeScript template file. This function reads the file once, at ---- compile time. --coffeeFile :: FilePath -> Q Exp --coffeeFile fp = do -- rs <- coffeeSettings -- shakespeareFile rs fp -- ---- | Read in a CoffeeScript template file. This impure function uses ---- unsafePerformIO to re-read the file on every call, allowing for rapid ---- iteration. --coffeeFileReload :: FilePath -> Q Exp --coffeeFileReload fp = do -- rs <- coffeeSettings -- shakespeareFileReload rs fp -- ---- | Deprecated synonym for 'coffeeFileReload' --coffeeFileDebug :: FilePath -> Q Exp --coffeeFileDebug = coffeeFileReload --{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-} -diff --git a/Text/Julius.hs b/Text/Julius.hs -index 230eac3..b990f73 100644 ---- a/Text/Julius.hs -+++ b/Text/Julius.hs -@@ -14,17 +14,8 @@ module Text.Julius - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- js -- , julius -- , juliusFile -- , jsFile -- , juliusFileDebug -- , jsFileDebug -- , juliusFileReload -- , jsFileReload -- - -- * Datatypes -- , JavascriptUrl -+ JavascriptUrl - , Javascript (..) - , RawJavascript (..) - -@@ -37,7 +28,6 @@ module Text.Julius - , renderJavascriptUrl - - -- ** internal, used by 'Text.Coffee' -- , javascriptSettings - -- ** internal - , juliusUsedIdentifiers - ) where -@@ -101,47 +91,6 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText - instance RawJS Builder where rawJS = RawJavascript - instance RawJS Bool where rawJS = RawJavascript . toJavascript - --javascriptSettings :: Q ShakespeareSettings --javascriptSettings = do -- toJExp <- [|toJavascript|] -- wrapExp <- [|Javascript|] -- unWrapExp <- [|unJavascript|] -- asJavascriptUrl' <- [|asJavascriptUrl|] -- return $ defaultShakespeareSettings { toBuilder = toJExp -- , wrap = wrapExp -- , unwrap = unWrapExp -- , modifyFinalValue = Just asJavascriptUrl' -- } -- --js, julius :: QuasiQuoter --js = QuasiQuoter { quoteExp = \s -> do -- rs <- javascriptSettings -- quoteExp (shakespeare rs) s -- } -- --julius = js -- --jsFile, juliusFile :: FilePath -> Q Exp --jsFile fp = do -- rs <- javascriptSettings -- shakespeareFile rs fp -- --juliusFile = jsFile -- -- --jsFileReload, juliusFileReload :: FilePath -> Q Exp --jsFileReload fp = do -- rs <- javascriptSettings -- shakespeareFileReload rs fp -- --juliusFileReload = jsFileReload -- --jsFileDebug, juliusFileDebug :: FilePath -> Q Exp --juliusFileDebug = jsFileReload --{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-} --jsFileDebug = jsFileReload --{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-} -- - -- | Determine which identifiers are used by the given template, useful for - -- creating systems like yesod devel. - juliusUsedIdentifiers :: String -> [(Deref, VarType)] -diff --git a/Text/Roy.hs b/Text/Roy.hs -index cf09cec..870c9f6 100644 ---- a/Text/Roy.hs -+++ b/Text/Roy.hs -@@ -23,13 +23,6 @@ module Text.Roy - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- roy -- , royFile -- , royFileReload -- --#ifdef TEST_EXPORT -- , roySettings --#endif - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) -@@ -37,50 +30,3 @@ import Language.Haskell.TH.Syntax - import Text.Shakespeare - import Text.Julius - ---- | The Roy language compiles down to Javascript. ---- We do this compilation once at compile time to avoid needing to do it during the request. ---- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. --roySettings :: Q ShakespeareSettings --roySettings = do -- jsettings <- javascriptSettings -- return $ jsettings { varChar = '#' -- , preConversion = Just PreConvert { -- preConvert = ReadProcess "roy" ["--stdio"] -- , preEscapeIgnoreBalanced = "'\"" -- , preEscapeIgnoreLine = "//" -- , wrapInsertion = Nothing -- {- -- Just WrapInsertion { -- wrapInsertionIndent = Just " " -- , wrapInsertionStartBegin = "(\\" -- , wrapInsertionSeparator = " " -- , wrapInsertionStartClose = " ->\n" -- , wrapInsertionEnd = ")" -- , wrapInsertionApplyBegin = " " -- , wrapInsertionApplyClose = ")\n" -- } -- -} -- } -- } -- ---- | Read inline, quasiquoted Roy. --roy :: QuasiQuoter --roy = QuasiQuoter { quoteExp = \s -> do -- rs <- roySettings -- quoteExp (shakespeare rs) s -- } -- ---- | Read in a Roy template file. This function reads the file once, at ---- compile time. --royFile :: FilePath -> Q Exp --royFile fp = do -- rs <- roySettings -- shakespeareFile rs fp -- ---- | Read in a Roy template file. This impure function uses ---- unsafePerformIO to re-read the file on every call, allowing for rapid ---- iteration. --royFileReload :: FilePath -> Q Exp --royFileReload fp = do -- rs <- roySettings -- shakespeareFileReload rs fp -diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs -index 34bf4bf..30c5388 100644 ---- a/Text/TypeScript.hs -+++ b/Text/TypeScript.hs -@@ -53,65 +53,10 @@ - -- - -- 2. TypeScript: - module Text.TypeScript -- ( -- * Functions -- -- ** Template-Reading Functions -- -- | These QuasiQuoter and Template Haskell methods return values of -- -- type @'JavascriptUrl' url@. See the Yesod book for details. -- tsc -- , typeScriptFile -- , typeScriptFileReload -- --#ifdef TEST_EXPORT -- , typeScriptSettings --#endif -+ ( - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) - import Language.Haskell.TH.Syntax - import Text.Shakespeare - import Text.Julius -- ---- | The TypeScript language compiles down to Javascript. ---- We do this compilation once at compile time to avoid needing to do it during the request. ---- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. --typeScriptSettings :: Q ShakespeareSettings --typeScriptSettings = do -- jsettings <- javascriptSettings -- return $ jsettings { varChar = '#' -- , preConversion = Just PreConvert { -- preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"] -- , preEscapeIgnoreBalanced = "'\"" -- , preEscapeIgnoreLine = "//" -- , wrapInsertion = Just WrapInsertion { -- wrapInsertionIndent = Nothing -- , wrapInsertionStartBegin = ";(function(" -- , wrapInsertionSeparator = ", " -- , wrapInsertionStartClose = "){" -- , wrapInsertionEnd = "})" -- , wrapInsertionApplyBegin = "(" -- , wrapInsertionApplyClose = ");\n" -- } -- } -- } -- ---- | Read inline, quasiquoted TypeScript --tsc :: QuasiQuoter --tsc = QuasiQuoter { quoteExp = \s -> do -- rs <- typeScriptSettings -- quoteExp (shakespeare rs) s -- } -- ---- | Read in a Roy template file. This function reads the file once, at ---- compile time. --typeScriptFile :: FilePath -> Q Exp --typeScriptFile fp = do -- rs <- typeScriptSettings -- shakespeareFile rs fp -- ---- | Read in a Roy template file. This impure function uses ---- unsafePerformIO to re-read the file on every call, allowing for rapid ---- iteration. --typeScriptFileReload :: FilePath -> Q Exp --typeScriptFileReload fp = do -- rs <- typeScriptSettings -- shakespeareFileReload rs fp --- -1.7.10.4 - -- cgit v1.2.3