aboutsummaryrefslogtreecommitdiff
path: root/standalone/no-th
diff options
context:
space:
mode:
authorGravatar Your Name <you@example.com>2014-05-20 22:12:29 +0000
committerGravatar Your Name <you@example.com>2014-05-20 22:12:29 +0000
commitbbbfc1f3420ecbe6918333ec2d213a3a75b6a867 (patch)
tree0349a1511582a6c56ad5231a55fd022597a819d3 /standalone/no-th
parentb605914a4ab5ed478f84fe0d5a5fd4b59a200f1d (diff)
update haskell patches (incomplete)
Diffstat (limited to 'standalone/no-th')
-rw-r--r--standalone/no-th/haskell-patches/aeson_remove-TH.patch40
-rw-r--r--standalone/no-th/haskell-patches/hamlet_remove-TH.patch205
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch26
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch351
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch215
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch316
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch153
-rw-r--r--standalone/no-th/haskell-patches/shakespeare_remove-TH.patch1312
-rw-r--r--standalone/no-th/haskell-patches/shakespeare_remove-th.patch189
-rw-r--r--standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch23
-rw-r--r--standalone/no-th/haskell-patches/yesod-core_expand_TH.patch71
11 files changed, 1398 insertions, 1503 deletions
diff --git a/standalone/no-th/haskell-patches/aeson_remove-TH.patch b/standalone/no-th/haskell-patches/aeson_remove-TH.patch
new file mode 100644
index 000000000..dc40de79e
--- /dev/null
+++ b/standalone/no-th/haskell-patches/aeson_remove-TH.patch
@@ -0,0 +1,40 @@
+From f147ec9aeaa03ca6e30232c84c413ef29b95fb62 Mon Sep 17 00:00:00 2001
+From: Your Name <you@example.com>
+Date: Tue, 20 May 2014 19:53:55 +0000
+Subject: [PATCH] avoid TH
+
+---
+ aeson.cabal | 3 ---
+ 1 file changed, 3 deletions(-)
+
+diff --git a/aeson.cabal b/aeson.cabal
+index 493d625..02dc6f4 100644
+--- a/aeson.cabal
++++ b/aeson.cabal
+@@ -88,7 +88,6 @@ library
+ Data.Aeson.Generic
+ Data.Aeson.Parser
+ Data.Aeson.Types
+- Data.Aeson.TH
+
+ other-modules:
+ Data.Aeson.Functions
+@@ -121,7 +120,6 @@ library
+ old-locale,
+ scientific >= 0.3.1 && < 0.4,
+ syb,
+- template-haskell >= 2.4,
+ time,
+ unordered-containers >= 0.2.3.0,
+ vector >= 0.7.1
+@@ -164,7 +162,6 @@ test-suite tests
+ base,
+ containers,
+ bytestring,
+- template-haskell,
+ test-framework,
+ test-framework-quickcheck2,
+ test-framework-hunit,
+--
+2.0.0.rc2
+
diff --git a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch
deleted file mode 100644
index 04989b148..000000000
--- a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch
+++ /dev/null
@@ -1,205 +0,0 @@
-From 60d7ac8aa1b3282a06ea7b17680dfc32c61fcbf6 Mon Sep 17 00:00:00 2001
-From: dummy <dummy@example.com>
-Date: Thu, 6 Mar 2014 23:19:40 +0000
-Subject: [PATCH] remove TH
-
----
- Text/Hamlet.hs | 86 +++++++++++++++++-----------------------------------
- Text/Hamlet/Parse.hs | 3 +-
- 2 files changed, 29 insertions(+), 60 deletions(-)
-
-diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
-index 9500ecb..ec8471a 100644
---- a/Text/Hamlet.hs
-+++ b/Text/Hamlet.hs
-@@ -11,36 +11,36 @@
- module Text.Hamlet
- ( -- * Plain HTML
- Html
-- , shamlet
-- , shamletFile
-- , xshamlet
-- , xshamletFile
-+ --, shamlet
-+ --, shamletFile
-+ --, xshamlet
-+ --, xshamletFile
- -- * Hamlet
- , HtmlUrl
-- , hamlet
-- , hamletFile
-- , hamletFileReload
-- , ihamletFileReload
-- , xhamlet
-- , xhamletFile
-+ --, hamlet
-+ --, hamletFile
-+ --, hamletFileReload
-+ --, ihamletFileReload
-+ --, xhamlet
-+ --, xhamletFile
- -- * I18N Hamlet
- , HtmlUrlI18n
-- , ihamlet
-- , ihamletFile
-+ --, ihamlet
-+ --, ihamletFile
- -- * Type classes
- , ToAttributes (..)
- -- * Internal, for making more
- , HamletSettings (..)
- , NewlineStyle (..)
-- , hamletWithSettings
-- , hamletFileWithSettings
-+ --, hamletWithSettings
-+ --, hamletFileWithSettings
- , defaultHamletSettings
- , xhtmlHamletSettings
-- , Env (..)
-- , HamletRules (..)
-- , hamletRules
-- , ihamletRules
-- , htmlRules
-+ --, Env (..)
-+ --, HamletRules (..)
-+ --, hamletRules
-+ --, ihamletRules
-+ --, htmlRules
- , CloseStyle (..)
- -- * Used by generated code
- , condH
-@@ -110,47 +110,9 @@ type HtmlUrl url = Render url -> Html
- -- | A function generating an 'Html' given a message translator and a URL rendering function.
- type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
-
--docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
--docsToExp env hr scope docs = do
-- exps <- mapM (docToExp env hr scope) docs
-- case exps of
-- [] -> [|return ()|]
-- [x] -> return x
-- _ -> return $ DoE $ map NoBindS exps
--
- unIdent :: Ident -> String
- unIdent (Ident s) = s
-
--bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
--bindingPattern (BindAs i@(Ident s) b) = do
-- name <- newName s
-- (pattern, scope) <- bindingPattern b
-- return (AsP name pattern, (i, VarE name):scope)
--bindingPattern (BindVar i@(Ident s))
-- | all isDigit s = do
-- return (LitP $ IntegerL $ read s, [])
-- | otherwise = do
-- name <- newName s
-- return (VarP name, [(i, VarE name)])
--bindingPattern (BindTuple is) = do
-- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
-- return (TupP patterns, concat scopes)
--bindingPattern (BindList is) = do
-- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
-- return (ListP patterns, concat scopes)
--bindingPattern (BindConstr con is) = do
-- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
-- return (ConP (mkConName con) patterns, concat scopes)
--bindingPattern (BindRecord con fields wild) = do
-- let f (Ident field,b) =
-- do (p,s) <- bindingPattern b
-- return ((mkName field,p),s)
-- (patterns, scopes) <- fmap unzip $ mapM f fields
-- (patterns1, scopes1) <- if wild
-- then bindWildFields con $ map fst fields
-- else return ([],[])
-- return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)
--
- mkConName :: DataConstr -> Name
- mkConName = mkName . conToStr
-
-@@ -158,6 +120,7 @@ conToStr :: DataConstr -> String
- conToStr (DCUnqualified (Ident x)) = x
- conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]
-
-+{-
- -- Wildcards bind all of the unbound fields to variables whose name
- -- matches the field name.
- --
-@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings
-
- xhamlet :: QuasiQuoter
- xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
-+-}
-
- asHtmlUrl :: HtmlUrl url -> HtmlUrl url
- asHtmlUrl = id
-
-+{-
- hamletRules :: Q HamletRules
- hamletRules = do
- i <- [|id|]
-@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
- hamletFromString qhr set s = do
- hr <- qhr
- hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s
-+-}
-
- docFromString :: HamletSettings -> String -> [Doc]
- docFromString set s =
-@@ -367,6 +333,7 @@ docFromString set s =
- Error s' -> error s'
- Ok (_, d) -> d
-
-+{-
- hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
- hamletFileWithSettings qhr set fp = do
- #ifdef GHC_7_4
-@@ -408,6 +375,7 @@ strToExp s@(c:_)
- | isUpper c = ConE $ mkName s
- | otherwise = VarE $ mkName s
- strToExp "" = error "strToExp on empty string"
-+-}
-
- -- | Checks for truth in the left value in each pair in the first argument. If
- -- a true exists, then the corresponding right action is performed. Only the
-@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings =
- data HamletRuntimeRules = HamletRuntimeRules {
- hrrI18n :: Bool
- }
--
-+{-
- hamletFileReloadWithSettings :: HamletRuntimeRules
- -> HamletSettings -> FilePath -> Q Exp
- hamletFileReloadWithSettings hrr settings fp = do
-@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do
- c VTUrlParam = [|EUrlParam|]
- c VTMixin = [|\r -> EMixin $ \c -> r c|]
- c VTMsg = [|EMsg|]
--
-+-}
- -- move to Shakespeare.Base?
- readFileUtf8 :: FilePath -> IO String
- readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp
-diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
-index b7e2954..1f14946 100644
---- a/Text/Hamlet/Parse.hs
-+++ b/Text/Hamlet/Parse.hs
-@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines
- | DefaultNewlineStyle
- deriving Show
-
-+{-
- instance Lift NewlineStyle where
- lift NoNewlines = [|NoNewlines|]
- lift NewlinesText = [|NewlinesText|]
-@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where
-
- instance Lift HamletSettings where
- lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]
--
-+-}
-
- htmlEmptyTags :: Set String
- htmlEmptyTags = Set.fromAscList
---
-1.9.0
-
diff --git a/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch b/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch
deleted file mode 100644
index 5bf57d527..000000000
--- a/standalone/no-th/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 <joey@kitenet.net>
-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/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch b/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch
deleted file mode 100644
index c57eb01c6..000000000
--- a/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch
+++ /dev/null
@@ -1,351 +0,0 @@
-From 8c9e29d3716bcbbfc3144cf1f8af0569212a5878 Mon Sep 17 00:00:00 2001
-From: dummy <dummy@example.com>
-Date: Tue, 17 Dec 2013 06:33:03 +0000
-Subject: [PATCH] remove more TH
-
----
- Text/Cassius.hs | 23 ---------
- Text/Css.hs | 151 ------------------------------------------------------
- Text/CssCommon.hs | 4 --
- Text/Lucius.hs | 46 +----------------
- 4 files changed, 2 insertions(+), 222 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 fb06dd2..954e574 100644
---- a/Text/Css.hs
-+++ b/Text/Css.hs
-@@ -169,22 +169,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =
- (scope, rest') = go rest
- go' (Attr k v) = k ++ v
-
--cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
-- -> Q Exp
-- -> Parser [TopLevel Unresolved]
-- -> 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 :: HasLeadingSpace
- -> [Contents]
- -> [Contents]
-@@ -290,18 +274,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|]
-- c VTMixin = [|CDMixin|]
--
- getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]
- getVars _ ContentRaw{} = return []
- getVars scope (ContentVar d) =
-@@ -345,111 +317,8 @@ compressBlock (Block x y blocks mixins) =
- cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
- cc (a:b) = a : cc b
-
--blockToMixin :: Name
-- -> Scope
-- -> Block Unresolved
-- -> Q Exp
--blockToMixin r scope (Block _sel props subblocks mixins) =
-- [|Mixin
-- { mixinAttrs = concat
-- $ $(listE $ map go props)
-- : map mixinAttrs $mixinsE
-- -- FIXME too many complications to implement sublocks for now...
-- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) []
-- }|]
-- {-
-- . foldr (.) id $(listE $ map subGo subblocks)
-- . (concatMap mixinBlocks $mixinsE ++)
-- |]
-- -}
-- where
-- mixinsE = return $ ListE $ map (derefToExp []) mixins
-- go (Attr x y) = conE 'Attr
-- `appE` (contentsToBuilder r scope x)
-- `appE` (contentsToBuilder r scope y)
-- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d
--
--blockToCss :: Name
-- -> Scope
-- -> Block Unresolved
-- -> Q Exp
--blockToCss r scope (Block sel props subblocks mixins) =
-- [|((Block
-- { blockSelector = $(selectorToBuilder r scope sel)
-- , blockAttrs = concat
-- $ $(listE $ map go props)
-- : map mixinAttrs $mixinsE
-- , blockBlocks = ()
-- , blockMixins = ()
-- } :: Block Resolved):)
-- . foldr (.) id $(listE $ map subGo subblocks)
-- . (concatMap mixinBlocks $mixinsE ++)
-- |]
-- where
-- mixinsE = return $ ListE $ map (derefToExp []) mixins
-- go (Attr x y) = conE 'Attr
-- `appE` (contentsToBuilder r scope x)
-- `appE` (contentsToBuilder r scope y)
-- subGo (hls, Block sel' b c d) =
-- blockToCss r scope $ Block sel'' b c d
-- where
-- sel'' = combineSelectors hls sel sel'
--
--selectorToBuilder :: Name -> Scope -> [Contents] -> 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))
--contentToBuilder _ _ ContentMixin{} = error "contentToBuilder on ContentMixin"
--
- type Scope = [(String, String)]
-
--topLevelsToCassius :: [TopLevel Unresolved]
-- -> 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 TopBlock ($(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 <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
-- es <- go r scope rest
-- return $ e : es
-- go r scope (TopAtDecl dec cs:rest) = do
-- e <- [|(:) $ TopAtDecl $(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 Unresolved]
-- -> 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
-@@ -518,23 +387,3 @@ renderBlock haveWhiteSpace indent (Block sel attrs () ())
- | haveWhiteSpace = fromString ";\n"
- | otherwise = singleton ';'
-
--instance Lift Mixin where
-- lift (Mixin a b) = [|Mixin a b|]
--instance Lift (Attr Unresolved) where
-- lift (Attr k v) = [|Attr k v :: Attr Unresolved |]
--instance Lift (Attr Resolved) where
-- lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]
--
--liftBuilder :: Builder -> Q Exp
--liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]
--
--instance Lift Content where
-- lift (ContentRaw s) = [|ContentRaw s|]
-- lift (ContentVar d) = [|ContentVar d|]
-- lift (ContentUrl d) = [|ContentUrl d|]
-- lift (ContentUrlParam d) = [|ContentUrlParam d|]
-- lift (ContentMixin m) = [|ContentMixin m|]
--instance Lift (Block Unresolved) where
-- lift (Block a b c d) = [|Block a b c d|]
--instance Lift (Block Resolved) where
-- lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]
-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 c2c4352..8b2bb9c 100644
---- a/Text/Lucius.hs
-+++ b/Text/Lucius.hs
-@@ -8,13 +8,9 @@
- {-# OPTIONS_GHC -fno-warn-missing-fields #-}
- module Text.Lucius
- ( -- * Parsing
-- lucius
-- , luciusFile
-- , luciusFileDebug
-- , luciusFileReload
- -- ** Mixins
-- , luciusMixin
-- , Mixin
-+ -- luciusMixin
-+ Mixin
- -- ** Runtime
- , luciusRT
- , luciusRT'
-@@ -40,11 +36,8 @@ module Text.Lucius
- , AbsoluteUnit (..)
- , AbsoluteSize (..)
- , absoluteSize
-- , EmSize (..)
-- , ExSize (..)
- , PercentageSize (..)
- , percentageSize
-- , PixelSize (..)
- -- * Internal
- , parseTopLevels
- , luciusUsedIdentifiers
-@@ -66,18 +59,6 @@ import Data.Monoid (mconcat)
- import Data.List (isSuffixOf)
- import Control.Arrow (second)
-
---- |
----
---- >>> 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 ()
-
-@@ -217,17 +198,6 @@ parseComment = do
- _ <- manyTill anyChar $ try $ string "*/"
- return $ ContentRaw ""
-
--luciusFile :: FilePath -> Q Exp
--luciusFile fp = do
--#ifdef GHC_7_4
-- qAddDependentFile fp
--#endif
-- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
-- luciusFromString contents
--
--luciusFileDebug, luciusFileReload :: FilePath -> Q Exp
--luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
--luciusFileReload = luciusFileDebug
-
- parseTopLevels :: Parser [TopLevel Unresolved]
- parseTopLevels =
-@@ -376,15 +346,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $
- -- creating systems like yesod devel.
- luciusUsedIdentifiers :: String -> [(Deref, VarType)]
- luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels
--
--luciusMixin :: QuasiQuoter
--luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }
--
--luciusMixinFromString :: String -> Q Exp
--luciusMixinFromString s' = do
-- r <- newName "_render"
-- case fmap compressBlock $ parse parseBlock s s of
-- Left e -> error $ show e
-- Right block -> blockToMixin r [] block
-- where
-- s = concat ["mixin{", s', "}"]
---
-1.8.5.1
-
diff --git a/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch
deleted file mode 100644
index 3c6924039..000000000
--- a/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch
+++ /dev/null
@@ -1,215 +0,0 @@
-From 57ad7d1512a3144fd0b00f9796d5fd9e0ea86852 Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey@kitenet.net>
-Date: Tue, 17 Dec 2013 16:30:59 +0000
-Subject: [PATCH] remove TH
-
----
- Text/Shakespeare/I18N.hs | 178 ++---------------------------------------------
- 1 file changed, 4 insertions(+), 174 deletions(-)
-
-diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
-index 2077914..2289214 100644
---- a/Text/Shakespeare/I18N.hs
-+++ b/Text/Shakespeare/I18N.hs
-@@ -51,10 +51,10 @@
- --
- -- You can also adapt those instructions for use with other systems.
- module Text.Shakespeare.I18N
-- ( mkMessage
-- , mkMessageFor
-- , mkMessageVariant
-- , RenderMessage (..)
-+ --( mkMessage
-+ --, mkMessageFor
-+ ---, mkMessageVariant
-+ ( RenderMessage (..)
- , ToMessage (..)
- , SomeMessage (..)
- , Lang
-@@ -105,143 +105,6 @@ instance RenderMessage master Text where
- -- | an RFC1766 / ISO 639-1 language code (eg, @fr@, @en-GB@, etc).
- type Lang = Text
-
---- |generate translations from translation files
----
---- This function will:
----
---- 1. look in the supplied subdirectory for files ending in @.msg@
----
---- 2. generate a type based on the constructors found
----
---- 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
-@@ -257,39 +120,6 @@ varName a y =
- upper (x:xs) = toUpper x : xs
- upper [] = []
-
--checkDef :: [SDef] -> [Def] -> Q ()
--checkDef x y =
-- go (sortBy (comparing sconstr) x) (sortBy (comparing constr) y)
-- where
-- go _ [] = return ()
-- go [] (b:_) = error $ "Extra message constructor: " ++ constr b
-- go (a:as) (b:bs)
-- | sconstr a < constr b = go as (b:bs)
-- | sconstr a > constr b = error $ "Extra message constructor: " ++ constr b
-- | otherwise = do
-- go' (svars a) (vars b)
-- go as bs
-- go' ((an, at):as) ((bn, mbt):bs)
-- | an /= bn = error "Mismatched variable names"
-- | otherwise =
-- case mbt of
-- Nothing -> go' as bs
-- Just bt
-- | at == bt -> go' as bs
-- | otherwise -> error "Mismatched variable types"
-- go' [] [] = return ()
-- go' _ _ = error "Mistmached variable count"
--
--toSDefs :: [Def] -> Q [SDef]
--toSDefs = mapM toSDef
--
--toSDef :: Def -> Q SDef
--toSDef d = do
-- vars' <- mapM go $ vars d
-- return $ SDef (constr d) vars' (content d)
-- where
-- go (a, Just b) = return (a, b)
-- go (a, Nothing) = error $ "Main language missing type for " ++ show (constr d, a)
-
- data SDef = SDef
- { sconstr :: String
---
-1.8.5.1
-
diff --git a/standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch
deleted file mode 100644
index 52b4b3b7c..000000000
--- a/standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch
+++ /dev/null
@@ -1,316 +0,0 @@
-From be50798c9abc22648a0a3eb81db462abea79698c Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey@kitenet.net>
-Date: Tue, 17 Dec 2013 16:47:03 +0000
-Subject: [PATCH] remove TH
-
----
- Text/Coffee.hs | 56 ++++-----------------------------------------
- Text/Julius.hs | 67 +++++++++---------------------------------------------
- Text/Roy.hs | 51 ++++-------------------------------------
- Text/TypeScript.hs | 51 ++++-------------------------------------
- 4 files changed, 24 insertions(+), 201 deletions(-)
-
-diff --git a/Text/Coffee.hs b/Text/Coffee.hs
-index 488c81b..61db85b 100644
---- a/Text/Coffee.hs
-+++ b/Text/Coffee.hs
-@@ -51,13 +51,13 @@ 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
-+ -- coffee
-+ --, coffeeFile
-+ --, coffeeFileReload
-+ --, coffeeFileDebug
-
- #ifdef TEST_EXPORT
-- , coffeeSettings
-+ --, coffeeSettings
- #endif
- ) where
-
-@@ -65,49 +65,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
- 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 = ""
-- , wrapInsertionAddParens = False
-- }
-- }
-- }
--
---- | 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 ec30690..5b5a075 100644
---- a/Text/Julius.hs
-+++ b/Text/Julius.hs
-@@ -14,17 +14,17 @@ 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
-+ -- js
-+ -- julius
-+ -- juliusFile
-+ -- jsFile
-+ --, juliusFileDebug
-+ --, jsFileDebug
-+ --, juliusFileReload
-+ --, jsFileReload
-
- -- * Datatypes
-- , JavascriptUrl
-+ JavascriptUrl
- , Javascript (..)
- , RawJavascript (..)
-
-@@ -37,9 +37,9 @@ module Text.Julius
- , renderJavascriptUrl
-
- -- ** internal, used by 'Text.Coffee'
-- , javascriptSettings
-+ --, javascriptSettings
- -- ** internal
-- , juliusUsedIdentifiers
-+ --, juliusUsedIdentifiers
- , asJavascriptUrl
- ) where
-
-@@ -102,48 +102,3 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText
- instance RawJS Builder where rawJS = RawJavascript
- instance RawJS Bool where rawJS = RawJavascript . unJavascript . 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)]
--juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings
-diff --git a/Text/Roy.hs b/Text/Roy.hs
-index 8bffc5a..8bf2a09 100644
---- a/Text/Roy.hs
-+++ b/Text/Roy.hs
-@@ -39,12 +39,12 @@ 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
-+ -- roy
-+ --, royFile
-+ --, royFileReload
-
- #ifdef TEST_EXPORT
-- , roySettings
-+ --, roySettings
- #endif
- ) where
-
-@@ -53,46 +53,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", "--browser"]
-- , preEscapeIgnoreBalanced = "'\""
-- , preEscapeIgnoreLine = "//"
-- , wrapInsertion = Just WrapInsertion {
-- wrapInsertionIndent = Just " "
-- , wrapInsertionStartBegin = "(\\"
-- , wrapInsertionSeparator = " "
-- , wrapInsertionStartClose = " ->\n"
-- , wrapInsertionEnd = ")"
-- , wrapInsertionAddParens = True
-- }
-- }
-- }
--
---- | 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 70c8820..5be994a 100644
---- a/Text/TypeScript.hs
-+++ b/Text/TypeScript.hs
-@@ -57,12 +57,12 @@ module Text.TypeScript
- -- ** Template-Reading Functions
- -- | These QuasiQuoter and Template Haskell methods return values of
- -- type @'JavascriptUrl' url@. See the Yesod book for details.
-- tsc
-- , typeScriptFile
-- , typeScriptFileReload
-+ -- tsc
-+ --, typeScriptFile
-+ --, typeScriptFileReload
-
- #ifdef TEST_EXPORT
-- , typeScriptSettings
-+ --, typeScriptSettings
- #endif
- ) where
-
-@@ -71,46 +71,3 @@ 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 = "})"
-- , wrapInsertionAddParens = False
-- }
-- }
-- }
--
---- | Read inline, quasiquoted TypeScript
--tsc :: QuasiQuoter
--tsc = QuasiQuoter { quoteExp = \s -> do
-- rs <- typeScriptSettings
-- quoteExp (shakespeare rs) s
-- }
--
---- | Read in a TypeScript 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.8.5.1
-
diff --git a/standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch
deleted file mode 100644
index 4af0995bd..000000000
--- a/standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch
+++ /dev/null
@@ -1,153 +0,0 @@
-From f94ab5c4fe8f01cb9353a9d246e8f7c48475d834 Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey@kitenet.net>
-Date: Wed, 18 Dec 2013 04:10:23 +0000
-Subject: [PATCH] remove TH
-
----
- Text/Shakespeare/Text.hs | 125 +++++------------------------------------------
- 1 file changed, 11 insertions(+), 114 deletions(-)
-
-diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs
-index 738164b..65818ee 100644
---- a/Text/Shakespeare/Text.hs
-+++ b/Text/Shakespeare/Text.hs
-@@ -7,18 +7,18 @@ module Text.Shakespeare.Text
- ( TextUrl
- , ToText (..)
- , renderTextUrl
-- , stext
-- , text
-- , textFile
-- , textFileDebug
-- , textFileReload
-- , st -- | strict text
-- , lt -- | lazy text, same as stext :)
-+ --, stext
-+ --, text
-+ --, textFile
-+ --, textFileDebug
-+ --, textFileReload
-+ --, st -- | strict text
-+ --, lt -- | lazy text, same as stext :)
- -- * Yesod code generation
-- , codegen
-- , codegenSt
-- , codegenFile
-- , codegenFileReload
-+ --, codegen
-+ --, codegenSt
-+ --, codegenFile
-+ --, codegenFileReload
- ) where
-
- import Language.Haskell.TH.Quote (QuasiQuoter (..))
-@@ -43,106 +43,3 @@ instance ToText TL.Text where toText = fromLazyText
- instance ToText Int32 where toText = toText . show
- instance ToText Int64 where toText = toText . show
-
--settings :: Q ShakespeareSettings
--settings = do
-- toTExp <- [|toText|]
-- wrapExp <- [|id|]
-- unWrapExp <- [|id|]
-- return $ defaultShakespeareSettings { toBuilder = toTExp
-- , wrap = wrapExp
-- , unwrap = unWrapExp
-- }
--
--
--stext, lt, st, text :: QuasiQuoter
--stext =
-- QuasiQuoter { quoteExp = \s -> do
-- rs <- settings
-- render <- [|toLazyText|]
-- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
-- return (render `AppE` rendered)
-- }
--lt = stext
--
--st =
-- QuasiQuoter { quoteExp = \s -> do
-- rs <- settings
-- render <- [|TL.toStrict . toLazyText|]
-- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
-- return (render `AppE` rendered)
-- }
--
--text = QuasiQuoter { quoteExp = \s -> do
-- rs <- settings
-- quoteExp (shakespeare rs) $ filter (/='\r') s
-- }
--
--
--textFile :: FilePath -> Q Exp
--textFile fp = do
-- rs <- settings
-- shakespeareFile rs fp
--
--
--textFileDebug :: FilePath -> Q Exp
--textFileDebug = textFileReload
--{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-}
--
--textFileReload :: FilePath -> Q Exp
--textFileReload fp = do
-- rs <- settings
-- shakespeareFileReload rs fp
--
---- | codegen is designed for generating Yesod code, including templates
---- So it uses different interpolation characters that won't clash with templates.
--codegenSettings :: Q ShakespeareSettings
--codegenSettings = do
-- toTExp <- [|toText|]
-- wrapExp <- [|id|]
-- unWrapExp <- [|id|]
-- return $ defaultShakespeareSettings { toBuilder = toTExp
-- , wrap = wrapExp
-- , unwrap = unWrapExp
-- , varChar = '~'
-- , urlChar = '*'
-- , intChar = '&'
-- , justVarInterpolation = True -- always!
-- }
--
---- | codegen is designed for generating Yesod code, including templates
---- So it uses different interpolation characters that won't clash with templates.
---- You can use the normal text quasiquoters to generate code
--codegen :: QuasiQuoter
--codegen =
-- QuasiQuoter { quoteExp = \s -> do
-- rs <- codegenSettings
-- render <- [|toLazyText|]
-- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
-- return (render `AppE` rendered)
-- }
--
---- | Generates strict Text
---- codegen is designed for generating Yesod code, including templates
---- So it uses different interpolation characters that won't clash with templates.
--codegenSt :: QuasiQuoter
--codegenSt =
-- QuasiQuoter { quoteExp = \s -> do
-- rs <- codegenSettings
-- render <- [|TL.toStrict . toLazyText|]
-- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
-- return (render `AppE` rendered)
-- }
--
--codegenFileReload :: FilePath -> Q Exp
--codegenFileReload fp = do
-- rs <- codegenSettings
-- render <- [|TL.toStrict . toLazyText|]
-- rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp
-- return (render `AppE` rendered)
--
--codegenFile :: FilePath -> Q Exp
--codegenFile fp = do
-- rs <- codegenSettings
-- render <- [|TL.toStrict . toLazyText|]
-- rendered <- shakespeareFile rs{ justVarInterpolation = True } fp
-- return (render `AppE` rendered)
---
-1.8.5.1
-
diff --git a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch
new file mode 100644
index 000000000..6a499bc26
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch
@@ -0,0 +1,1312 @@
+From a4b8a90dbb97392378a3c5980cbb9c033702dfb2 Mon Sep 17 00:00:00 2001
+From: Your Name <you@example.com>
+Date: Tue, 20 May 2014 21:17:27 +0000
+Subject: [PATCH] remove TN
+
+---
+ Text/Cassius.hs | 23 ------
+ Text/Coffee.hs | 56 ++-------------
+ Text/Css.hs | 151 ----------------------------------------
+ Text/CssCommon.hs | 4 --
+ Text/Hamlet.hs | 86 +++++++----------------
+ Text/Hamlet/Parse.hs | 3 +-
+ Text/Julius.hs | 67 +++---------------
+ Text/Lucius.hs | 46 +-----------
+ Text/Roy.hs | 51 ++------------
+ Text/Shakespeare.hs | 70 +++----------------
+ Text/Shakespeare/Base.hs | 28 --------
+ Text/Shakespeare/I18N.hs | 178 ++---------------------------------------------
+ Text/Shakespeare/Text.hs | 125 +++------------------------------
+ shakespeare.cabal | 2 +-
+ 14 files changed, 78 insertions(+), 812 deletions(-)
+
+diff --git a/Text/Cassius.hs b/Text/Cassius.hs
+index 91fc90f..c515807 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
+@@ -43,25 +36,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/Coffee.hs b/Text/Coffee.hs
+index 488c81b..61db85b 100644
+--- a/Text/Coffee.hs
++++ b/Text/Coffee.hs
+@@ -51,13 +51,13 @@ 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
++ -- coffee
++ --, coffeeFile
++ --, coffeeFileReload
++ --, coffeeFileDebug
+
+ #ifdef TEST_EXPORT
+- , coffeeSettings
++ --, coffeeSettings
+ #endif
+ ) where
+
+@@ -65,49 +65,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+ 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 = ""
+- , wrapInsertionAddParens = False
+- }
+- }
+- }
+-
+--- | 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/Css.hs b/Text/Css.hs
+index 75dc549..20c206c 100644
+--- a/Text/Css.hs
++++ b/Text/Css.hs
+@@ -166,22 +166,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =
+ (scope, rest') = go rest
+ go' (Attr k v) = k ++ v
+
+-cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
+- -> Q Exp
+- -> Parser [TopLevel Unresolved]
+- -> 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 :: HasLeadingSpace
+ -> [Contents]
+ -> [Contents]
+@@ -287,18 +271,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|]
+- c VTMixin = [|CDMixin|]
+-
+ getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]
+ getVars _ ContentRaw{} = return []
+ getVars scope (ContentVar d) =
+@@ -342,111 +314,8 @@ compressBlock (Block x y blocks mixins) =
+ cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
+ cc (a:b) = a : cc b
+
+-blockToMixin :: Name
+- -> Scope
+- -> Block Unresolved
+- -> Q Exp
+-blockToMixin r scope (Block _sel props subblocks mixins) =
+- [|Mixin
+- { mixinAttrs = concat
+- $ $(listE $ map go props)
+- : map mixinAttrs $mixinsE
+- -- FIXME too many complications to implement sublocks for now...
+- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) []
+- }|]
+- {-
+- . foldr (.) id $(listE $ map subGo subblocks)
+- . (concatMap mixinBlocks $mixinsE ++)
+- |]
+- -}
+- where
+- mixinsE = return $ ListE $ map (derefToExp []) mixins
+- go (Attr x y) = conE 'Attr
+- `appE` (contentsToBuilder r scope x)
+- `appE` (contentsToBuilder r scope y)
+- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d
+-
+-blockToCss :: Name
+- -> Scope
+- -> Block Unresolved
+- -> Q Exp
+-blockToCss r scope (Block sel props subblocks mixins) =
+- [|((Block
+- { blockSelector = $(selectorToBuilder r scope sel)
+- , blockAttrs = concat
+- $ $(listE $ map go props)
+- : map mixinAttrs $mixinsE
+- , blockBlocks = ()
+- , blockMixins = ()
+- } :: Block Resolved):)
+- . foldr (.) id $(listE $ map subGo subblocks)
+- . (concatMap mixinBlocks $mixinsE ++)
+- |]
+- where
+- mixinsE = return $ ListE $ map (derefToExp []) mixins
+- go (Attr x y) = conE 'Attr
+- `appE` (contentsToBuilder r scope x)
+- `appE` (contentsToBuilder r scope y)
+- subGo (hls, Block sel' b c d) =
+- blockToCss r scope $ Block sel'' b c d
+- where
+- sel'' = combineSelectors hls sel sel'
+-
+-selectorToBuilder :: Name -> Scope -> [Contents] -> 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))
+-contentToBuilder _ _ ContentMixin{} = error "contentToBuilder on ContentMixin"
+-
+ type Scope = [(String, String)]
+
+-topLevelsToCassius :: [TopLevel Unresolved]
+- -> 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 TopBlock ($(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 <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
+- es <- go r scope rest
+- return $ e : es
+- go r scope (TopAtDecl dec cs:rest) = do
+- e <- [|(:) $ TopAtDecl $(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 Unresolved]
+- -> 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
+@@ -515,23 +384,3 @@ renderBlock haveWhiteSpace indent (Block sel attrs () ())
+ | haveWhiteSpace = fromString ";\n"
+ | otherwise = singleton ';'
+
+-instance Lift Mixin where
+- lift (Mixin a b) = [|Mixin a b|]
+-instance Lift (Attr Unresolved) where
+- lift (Attr k v) = [|Attr k v :: Attr Unresolved |]
+-instance Lift (Attr Resolved) where
+- lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]
+-
+-liftBuilder :: Builder -> Q Exp
+-liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]
+-
+-instance Lift Content where
+- lift (ContentRaw s) = [|ContentRaw s|]
+- lift (ContentVar d) = [|ContentVar d|]
+- lift (ContentUrl d) = [|ContentUrl d|]
+- lift (ContentUrlParam d) = [|ContentUrlParam d|]
+- lift (ContentMixin m) = [|ContentMixin m|]
+-instance Lift (Block Unresolved) where
+- lift (Block a b c d) = [|Block a b c d|]
+-instance Lift (Block Resolved) where
+- lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]
+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/Hamlet.hs b/Text/Hamlet.hs
+index 9500ecb..ec8471a 100644
+--- a/Text/Hamlet.hs
++++ b/Text/Hamlet.hs
+@@ -11,36 +11,36 @@
+ module Text.Hamlet
+ ( -- * Plain HTML
+ Html
+- , shamlet
+- , shamletFile
+- , xshamlet
+- , xshamletFile
++ --, shamlet
++ --, shamletFile
++ --, xshamlet
++ --, xshamletFile
+ -- * Hamlet
+ , HtmlUrl
+- , hamlet
+- , hamletFile
+- , hamletFileReload
+- , ihamletFileReload
+- , xhamlet
+- , xhamletFile
++ --, hamlet
++ --, hamletFile
++ --, hamletFileReload
++ --, ihamletFileReload
++ --, xhamlet
++ --, xhamletFile
+ -- * I18N Hamlet
+ , HtmlUrlI18n
+- , ihamlet
+- , ihamletFile
++ --, ihamlet
++ --, ihamletFile
+ -- * Type classes
+ , ToAttributes (..)
+ -- * Internal, for making more
+ , HamletSettings (..)
+ , NewlineStyle (..)
+- , hamletWithSettings
+- , hamletFileWithSettings
++ --, hamletWithSettings
++ --, hamletFileWithSettings
+ , defaultHamletSettings
+ , xhtmlHamletSettings
+- , Env (..)
+- , HamletRules (..)
+- , hamletRules
+- , ihamletRules
+- , htmlRules
++ --, Env (..)
++ --, HamletRules (..)
++ --, hamletRules
++ --, ihamletRules
++ --, htmlRules
+ , CloseStyle (..)
+ -- * Used by generated code
+ , condH
+@@ -110,47 +110,9 @@ type HtmlUrl url = Render url -> Html
+ -- | A function generating an 'Html' given a message translator and a URL rendering function.
+ type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
+
+-docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
+-docsToExp env hr scope docs = do
+- exps <- mapM (docToExp env hr scope) docs
+- case exps of
+- [] -> [|return ()|]
+- [x] -> return x
+- _ -> return $ DoE $ map NoBindS exps
+-
+ unIdent :: Ident -> String
+ unIdent (Ident s) = s
+
+-bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
+-bindingPattern (BindAs i@(Ident s) b) = do
+- name <- newName s
+- (pattern, scope) <- bindingPattern b
+- return (AsP name pattern, (i, VarE name):scope)
+-bindingPattern (BindVar i@(Ident s))
+- | all isDigit s = do
+- return (LitP $ IntegerL $ read s, [])
+- | otherwise = do
+- name <- newName s
+- return (VarP name, [(i, VarE name)])
+-bindingPattern (BindTuple is) = do
+- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
+- return (TupP patterns, concat scopes)
+-bindingPattern (BindList is) = do
+- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
+- return (ListP patterns, concat scopes)
+-bindingPattern (BindConstr con is) = do
+- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
+- return (ConP (mkConName con) patterns, concat scopes)
+-bindingPattern (BindRecord con fields wild) = do
+- let f (Ident field,b) =
+- do (p,s) <- bindingPattern b
+- return ((mkName field,p),s)
+- (patterns, scopes) <- fmap unzip $ mapM f fields
+- (patterns1, scopes1) <- if wild
+- then bindWildFields con $ map fst fields
+- else return ([],[])
+- return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)
+-
+ mkConName :: DataConstr -> Name
+ mkConName = mkName . conToStr
+
+@@ -158,6 +120,7 @@ conToStr :: DataConstr -> String
+ conToStr (DCUnqualified (Ident x)) = x
+ conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]
+
++{-
+ -- Wildcards bind all of the unbound fields to variables whose name
+ -- matches the field name.
+ --
+@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings
+
+ xhamlet :: QuasiQuoter
+ xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
++-}
+
+ asHtmlUrl :: HtmlUrl url -> HtmlUrl url
+ asHtmlUrl = id
+
++{-
+ hamletRules :: Q HamletRules
+ hamletRules = do
+ i <- [|id|]
+@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
+ hamletFromString qhr set s = do
+ hr <- qhr
+ hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s
++-}
+
+ docFromString :: HamletSettings -> String -> [Doc]
+ docFromString set s =
+@@ -367,6 +333,7 @@ docFromString set s =
+ Error s' -> error s'
+ Ok (_, d) -> d
+
++{-
+ hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
+ hamletFileWithSettings qhr set fp = do
+ #ifdef GHC_7_4
+@@ -408,6 +375,7 @@ strToExp s@(c:_)
+ | isUpper c = ConE $ mkName s
+ | otherwise = VarE $ mkName s
+ strToExp "" = error "strToExp on empty string"
++-}
+
+ -- | Checks for truth in the left value in each pair in the first argument. If
+ -- a true exists, then the corresponding right action is performed. Only the
+@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings =
+ data HamletRuntimeRules = HamletRuntimeRules {
+ hrrI18n :: Bool
+ }
+-
++{-
+ hamletFileReloadWithSettings :: HamletRuntimeRules
+ -> HamletSettings -> FilePath -> Q Exp
+ hamletFileReloadWithSettings hrr settings fp = do
+@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do
+ c VTUrlParam = [|EUrlParam|]
+ c VTMixin = [|\r -> EMixin $ \c -> r c|]
+ c VTMsg = [|EMsg|]
+-
++-}
+ -- move to Shakespeare.Base?
+ readFileUtf8 :: FilePath -> IO String
+ readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp
+diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
+index b7e2954..1f14946 100644
+--- a/Text/Hamlet/Parse.hs
++++ b/Text/Hamlet/Parse.hs
+@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines
+ | DefaultNewlineStyle
+ deriving Show
+
++{-
+ instance Lift NewlineStyle where
+ lift NoNewlines = [|NoNewlines|]
+ lift NewlinesText = [|NewlinesText|]
+@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where
+
+ instance Lift HamletSettings where
+ lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]
+-
++-}
+
+ htmlEmptyTags :: Set String
+ htmlEmptyTags = Set.fromAscList
+diff --git a/Text/Julius.hs b/Text/Julius.hs
+index ec30690..5b5a075 100644
+--- a/Text/Julius.hs
++++ b/Text/Julius.hs
+@@ -14,17 +14,17 @@ 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
++ -- js
++ -- julius
++ -- juliusFile
++ -- jsFile
++ --, juliusFileDebug
++ --, jsFileDebug
++ --, juliusFileReload
++ --, jsFileReload
+
+ -- * Datatypes
+- , JavascriptUrl
++ JavascriptUrl
+ , Javascript (..)
+ , RawJavascript (..)
+
+@@ -37,9 +37,9 @@ module Text.Julius
+ , renderJavascriptUrl
+
+ -- ** internal, used by 'Text.Coffee'
+- , javascriptSettings
++ --, javascriptSettings
+ -- ** internal
+- , juliusUsedIdentifiers
++ --, juliusUsedIdentifiers
+ , asJavascriptUrl
+ ) where
+
+@@ -102,48 +102,3 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText
+ instance RawJS Builder where rawJS = RawJavascript
+ instance RawJS Bool where rawJS = RawJavascript . unJavascript . 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)]
+-juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings
+diff --git a/Text/Lucius.hs b/Text/Lucius.hs
+index 346883d..f38492b 100644
+--- a/Text/Lucius.hs
++++ b/Text/Lucius.hs
+@@ -8,13 +8,9 @@
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Lucius
+ ( -- * Parsing
+- lucius
+- , luciusFile
+- , luciusFileDebug
+- , luciusFileReload
+ -- ** Mixins
+- , luciusMixin
+- , Mixin
++ -- luciusMixin
++ Mixin
+ -- ** Runtime
+ , luciusRT
+ , luciusRT'
+@@ -40,11 +36,8 @@ module Text.Lucius
+ , AbsoluteUnit (..)
+ , AbsoluteSize (..)
+ , absoluteSize
+- , EmSize (..)
+- , ExSize (..)
+ , PercentageSize (..)
+ , percentageSize
+- , PixelSize (..)
+ -- * Internal
+ , parseTopLevels
+ , luciusUsedIdentifiers
+@@ -67,18 +60,6 @@ import Data.List (isSuffixOf)
+ import Control.Arrow (second)
+ import Text.Shakespeare (VarType)
+
+--- |
+---
+--- >>> 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 ()
+
+@@ -218,17 +199,6 @@ parseComment = do
+ _ <- manyTill anyChar $ try $ string "*/"
+ return $ ContentRaw ""
+
+-luciusFile :: FilePath -> Q Exp
+-luciusFile fp = do
+-#ifdef GHC_7_4
+- qAddDependentFile fp
+-#endif
+- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
+- luciusFromString contents
+-
+-luciusFileDebug, luciusFileReload :: FilePath -> Q Exp
+-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
+-luciusFileReload = luciusFileDebug
+
+ parseTopLevels :: Parser [TopLevel Unresolved]
+ parseTopLevels =
+@@ -377,15 +347,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $
+ -- creating systems like yesod devel.
+ luciusUsedIdentifiers :: String -> [(Deref, VarType)]
+ luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels
+-
+-luciusMixin :: QuasiQuoter
+-luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }
+-
+-luciusMixinFromString :: String -> Q Exp
+-luciusMixinFromString s' = do
+- r <- newName "_render"
+- case fmap compressBlock $ parse parseBlock s s of
+- Left e -> error $ show e
+- Right block -> blockToMixin r [] block
+- where
+- s = concat ["mixin{", s', "}"]
+diff --git a/Text/Roy.hs b/Text/Roy.hs
+index 6e5e246..9ab0dbc 100644
+--- a/Text/Roy.hs
++++ b/Text/Roy.hs
+@@ -39,12 +39,12 @@ 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
++ -- roy
++ --, royFile
++ --, royFileReload
+
+ #ifdef TEST_EXPORT
+- , roySettings
++ --, roySettings
+ #endif
+ ) where
+
+@@ -53,46 +53,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", "--browser"]
+- , preEscapeIgnoreBalanced = "'\""
+- , preEscapeIgnoreLine = "//"
+- , wrapInsertion = Just WrapInsertion {
+- wrapInsertionIndent = Just " "
+- , wrapInsertionStartBegin = "(\\"
+- , wrapInsertionSeparator = " "
+- , wrapInsertionStartClose = " ->\n"
+- , wrapInsertionEnd = ")"
+- , wrapInsertionAddParens = True
+- }
+- }
+- }
+-
+--- | 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/Shakespeare.hs b/Text/Shakespeare.hs
+index 67d7dde..a510215 100644
+--- a/Text/Shakespeare.hs
++++ b/Text/Shakespeare.hs
+@@ -15,12 +15,12 @@ module Text.Shakespeare
+ , WrapInsertion (..)
+ , PreConversion (..)
+ , defaultShakespeareSettings
+- , shakespeare
+- , shakespeareFile
+- , shakespeareFileReload
++ -- , shakespeare
++ -- , shakespeareFile
++ -- , shakespeareFileReload
+ -- * low-level
+- , shakespeareFromString
+- , shakespeareUsedIdentifiers
++ -- , shakespeareFromString
++ -- , shakespeareUsedIdentifiers
+ , RenderUrl
+ , VarType (..)
+ , Deref
+@@ -153,38 +153,6 @@ defaultShakespeareSettings = ShakespeareSettings {
+ , modifyFinalValue = Nothing
+ }
+
+-instance Lift PreConvert where
+- lift (PreConvert convert ignore comment wrapInsertion) =
+- [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]
+-
+-instance Lift WrapInsertion where
+- lift (WrapInsertion indent sb sep sc e wp) =
+- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]
+-
+-instance Lift PreConversion where
+- lift (ReadProcess command args) =
+- [|ReadProcess $(lift command) $(lift args)|]
+- lift Id = [|Id|]
+-
+-instance Lift ShakespeareSettings where
+- lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =
+- [|ShakespeareSettings
+- $(lift x1) $(lift x2) $(lift x3)
+- $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
+- where
+- liftExp (VarE n) = [|VarE $(liftName n)|]
+- liftExp (ConE n) = [|ConE $(liftName n)|]
+- liftExp _ = error "liftExp only supports VarE and ConE"
+- liftMExp Nothing = [|Nothing|]
+- liftMExp (Just e) = [|Just|] `appE` liftExp e
+- liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
+- liftFlavour NameS = [|NameS|]
+- liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]
+- liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]
+- liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]
+- liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]
+- liftNS VarName = [|VarName|]
+- liftNS DataName = [|DataName|]
+
+ type QueryParameters = [(TS.Text, TS.Text)]
+ type RenderUrl url = (url -> QueryParameters -> TS.Text)
+@@ -348,6 +316,7 @@ pack' = TS.pack
+ {-# NOINLINE pack' #-}
+ #endif
+
++{-
+ contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
+ contentsToShakespeare rs a = do
+ r <- newName "_render"
+@@ -399,16 +368,19 @@ shakespeareFile r fp =
+ qAddDependentFile fp >>
+ #endif
+ readFileQ fp >>= shakespeareFromString r
++-}
+
+ data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)
+
++{-
+ getVars :: Content -> [(Deref, VarType)]
+ getVars ContentRaw{} = []
+ getVars (ContentVar d) = [(d, VTPlain)]
+ getVars (ContentUrl d) = [(d, VTUrl)]
+ getVars (ContentUrlParam d) = [(d, VTUrlParam)]
+ getVars (ContentMix d) = [(d, VTMixin)]
++-}
+
+ data VarExp url = EPlain Builder
+ | EUrl url
+@@ -417,8 +389,10 @@ data VarExp url = EPlain Builder
+
+ -- | Determine which identifiers are used by the given template, useful for
+ -- creating systems like yesod devel.
++{-
+ shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
+ shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
++-}
+
+ type MTime = UTCTime
+
+@@ -435,28 +409,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
+ insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
+ (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))
+
+-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
+-shakespeareFileReload settings fp = do
+- str <- readFileQ fp
+- s <- qRunIO $ preFilter (Just fp) settings str
+- let b = shakespeareUsedIdentifiers settings s
+- c <- mapM vtToExp b
+- rt <- [|shakespeareRuntime settings fp|]
+- wrap' <- [|\x -> $(return $ wrap settings) . x|]
+- return $ wrap' `AppE` (rt `AppE` ListE c)
+- where
+- 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 = [|EPlain . $(return $
+- InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]
+- c VTUrl = [|EUrl|]
+- c VTUrlParam = [|EUrlParam|]
+- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]
+
+
+
+diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
+index a0e983c..23b4692 100644
+--- a/Text/Shakespeare/Base.hs
++++ b/Text/Shakespeare/Base.hs
+@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident
+ | DerefTuple [Deref]
+ deriving (Show, Eq, Read, Data, Typeable, Ord)
+
+-instance Lift Ident where
+- lift (Ident s) = [|Ident|] `appE` lift s
+-instance Lift Deref where
+- lift (DerefModulesIdent v s) = do
+- dl <- [|DerefModulesIdent|]
+- v' <- lift v
+- s' <- lift s
+- return $ dl `AppE` v' `AppE` s'
+- lift (DerefIdent s) = do
+- dl <- [|DerefIdent|]
+- s' <- lift s
+- return $ dl `AppE` s'
+- lift (DerefBranch x y) = do
+- x' <- lift x
+- y' <- lift y
+- db <- [|DerefBranch|]
+- return $ db `AppE` x' `AppE` y'
+- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i
+- lift (DerefRational r) = do
+- n <- lift $ numerator r
+- d <- lift $ denominator r
+- per <- [|(%) :: Int -> Int -> Ratio Int|]
+- dr <- [|DerefRational|]
+- return $ dr `AppE` InfixE (Just n) per (Just d)
+- lift (DerefString s) = [|DerefString|] `appE` lift s
+- lift (DerefList x) = [|DerefList $(lift x)|]
+- lift (DerefTuple x) = [|DerefTuple $(lift x)|]
+-
+ derefParens, derefCurlyBrackets :: UserParser a Deref
+ derefParens = between (char '(') (char ')') parseDeref
+ derefCurlyBrackets = between (char '{') (char '}') parseDeref
+diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
+index a39a614..753cba7 100644
+--- a/Text/Shakespeare/I18N.hs
++++ b/Text/Shakespeare/I18N.hs
+@@ -52,10 +52,10 @@
+ --
+ -- You can also adapt those instructions for use with other systems.
+ module Text.Shakespeare.I18N
+- ( mkMessage
+- , mkMessageFor
+- , mkMessageVariant
+- , RenderMessage (..)
++ --( mkMessage
++ --, mkMessageFor
++ ---, mkMessageVariant
++ ( RenderMessage (..)
+ , ToMessage (..)
+ , SomeMessage (..)
+ , Lang
+@@ -106,143 +106,6 @@ instance RenderMessage master Text where
+ -- | an RFC1766 / ISO 639-1 language code (eg, @fr@, @en-GB@, etc).
+ type Lang = Text
+
+--- |generate translations from translation files
+---
+--- This function will:
+---
+--- 1. look in the supplied subdirectory for files ending in @.msg@
+---
+--- 2. generate a type based on the constructors found
+---
+--- 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
+@@ -258,39 +121,6 @@ varName a y =
+ upper (x:xs) = toUpper x : xs
+ upper [] = []
+
+-checkDef :: [SDef] -> [Def] -> Q ()
+-checkDef x y =
+- go (sortBy (comparing sconstr) x) (sortBy (comparing constr) y)
+- where
+- go _ [] = return ()
+- go [] (b:_) = error $ "Extra message constructor: " ++ constr b
+- go (a:as) (b:bs)
+- | sconstr a < constr b = go as (b:bs)
+- | sconstr a > constr b = error $ "Extra message constructor: " ++ constr b
+- | otherwise = do
+- go' (svars a) (vars b)
+- go as bs
+- go' ((an, at):as) ((bn, mbt):bs)
+- | an /= bn = error "Mismatched variable names"
+- | otherwise =
+- case mbt of
+- Nothing -> go' as bs
+- Just bt
+- | at == bt -> go' as bs
+- | otherwise -> error "Mismatched variable types"
+- go' [] [] = return ()
+- go' _ _ = error "Mistmached variable count"
+-
+-toSDefs :: [Def] -> Q [SDef]
+-toSDefs = mapM toSDef
+-
+-toSDef :: Def -> Q SDef
+-toSDef d = do
+- vars' <- mapM go $ vars d
+- return $ SDef (constr d) vars' (content d)
+- where
+- go (a, Just b) = return (a, b)
+- go (a, Nothing) = error $ "Main language missing type for " ++ show (constr d, a)
+
+ data SDef = SDef
+ { sconstr :: String
+diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs
+index 6865a5a..e25a8be 100644
+--- a/Text/Shakespeare/Text.hs
++++ b/Text/Shakespeare/Text.hs
+@@ -7,18 +7,18 @@ module Text.Shakespeare.Text
+ ( TextUrl
+ , ToText (..)
+ , renderTextUrl
+- , stext
+- , text
+- , textFile
+- , textFileDebug
+- , textFileReload
+- , st -- | strict text
+- , lt -- | lazy text, same as stext :)
++ --, stext
++ --, text
++ --, textFile
++ --, textFileDebug
++ --, textFileReload
++ --, st -- | strict text
++ --, lt -- | lazy text, same as stext :)
+ -- * Yesod code generation
+- , codegen
+- , codegenSt
+- , codegenFile
+- , codegenFileReload
++ --, codegen
++ --, codegenSt
++ --, codegenFile
++ --, codegenFileReload
+ ) where
+
+ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+@@ -45,106 +45,3 @@ instance ToText Int32 where toText = toText . show
+ instance ToText Int64 where toText = toText . show
+ instance ToText Int where toText = toText . show
+
+-settings :: Q ShakespeareSettings
+-settings = do
+- toTExp <- [|toText|]
+- wrapExp <- [|id|]
+- unWrapExp <- [|id|]
+- return $ defaultShakespeareSettings { toBuilder = toTExp
+- , wrap = wrapExp
+- , unwrap = unWrapExp
+- }
+-
+-
+-stext, lt, st, text :: QuasiQuoter
+-stext =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- settings
+- render <- [|toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-lt = stext
+-
+-st =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- settings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-
+-text = QuasiQuoter { quoteExp = \s -> do
+- rs <- settings
+- quoteExp (shakespeare rs) $ filter (/='\r') s
+- }
+-
+-
+-textFile :: FilePath -> Q Exp
+-textFile fp = do
+- rs <- settings
+- shakespeareFile rs fp
+-
+-
+-textFileDebug :: FilePath -> Q Exp
+-textFileDebug = textFileReload
+-{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-}
+-
+-textFileReload :: FilePath -> Q Exp
+-textFileReload fp = do
+- rs <- settings
+- shakespeareFileReload rs fp
+-
+--- | codegen is designed for generating Yesod code, including templates
+--- So it uses different interpolation characters that won't clash with templates.
+-codegenSettings :: Q ShakespeareSettings
+-codegenSettings = do
+- toTExp <- [|toText|]
+- wrapExp <- [|id|]
+- unWrapExp <- [|id|]
+- return $ defaultShakespeareSettings { toBuilder = toTExp
+- , wrap = wrapExp
+- , unwrap = unWrapExp
+- , varChar = '~'
+- , urlChar = '*'
+- , intChar = '&'
+- , justVarInterpolation = True -- always!
+- }
+-
+--- | codegen is designed for generating Yesod code, including templates
+--- So it uses different interpolation characters that won't clash with templates.
+--- You can use the normal text quasiquoters to generate code
+-codegen :: QuasiQuoter
+-codegen =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- codegenSettings
+- render <- [|toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-
+--- | Generates strict Text
+--- codegen is designed for generating Yesod code, including templates
+--- So it uses different interpolation characters that won't clash with templates.
+-codegenSt :: QuasiQuoter
+-codegenSt =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- codegenSettings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-
+-codegenFileReload :: FilePath -> Q Exp
+-codegenFileReload fp = do
+- rs <- codegenSettings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp
+- return (render `AppE` rendered)
+-
+-codegenFile :: FilePath -> Q Exp
+-codegenFile fp = do
+- rs <- codegenSettings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFile rs{ justVarInterpolation = True } fp
+- return (render `AppE` rendered)
+diff --git a/shakespeare.cabal b/shakespeare.cabal
+index a555c24..d73da26 100644
+--- a/shakespeare.cabal
++++ b/shakespeare.cabal
+@@ -62,8 +62,8 @@ library
+ Text.Cassius
+ Text.Shakespeare.Base
+ Text.Shakespeare
+- other-modules: Text.Hamlet.Parse
+ Text.Css
++ other-modules: Text.Hamlet.Parse
+ Text.MkSizeType
+ Text.IndentToBrace
+ Text.CssCommon
+--
+2.0.0.rc2
+
diff --git a/standalone/no-th/haskell-patches/shakespeare_remove-th.patch b/standalone/no-th/haskell-patches/shakespeare_remove-th.patch
deleted file mode 100644
index 024ec2e20..000000000
--- a/standalone/no-th/haskell-patches/shakespeare_remove-th.patch
+++ /dev/null
@@ -1,189 +0,0 @@
-From 753f8ce37e096a343f1dd02a696a287bc91c24a0 Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey@kitenet.net>
-Date: Thu, 6 Mar 2014 22:34:03 +0000
-Subject: [PATCH] remove TH
-
----
- Text/Shakespeare.hs | 73 ++++++++++--------------------------------------
- Text/Shakespeare/Base.hs | 28 -------------------
- 2 files changed, 14 insertions(+), 87 deletions(-)
-
-diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
-index 68e344f..aef741c 100644
---- a/Text/Shakespeare.hs
-+++ b/Text/Shakespeare.hs
-@@ -14,17 +14,20 @@ module Text.Shakespeare
- , WrapInsertion (..)
- , PreConversion (..)
- , defaultShakespeareSettings
-- , shakespeare
-- , shakespeareFile
-- , shakespeareFileReload
-+ -- , shakespeare
-+ -- , shakespeareFile
-+ -- , shakespeareFileReload
- -- * low-level
-- , shakespeareFromString
-- , shakespeareUsedIdentifiers
-+ -- , shakespeareFromString
-+ -- , shakespeareUsedIdentifiers
- , RenderUrl
- , VarType (..)
- , Deref
- , Parser
-
-+ -- used by TH
-+ , pack'
-+
- #ifdef TEST_EXPORT
- , preFilter
- #endif
-@@ -154,38 +157,6 @@ defaultShakespeareSettings = ShakespeareSettings {
- , modifyFinalValue = Nothing
- }
-
--instance Lift PreConvert where
-- lift (PreConvert convert ignore comment wrapInsertion) =
-- [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]
--
--instance Lift WrapInsertion where
-- lift (WrapInsertion indent sb sep sc e wp) =
-- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]
--
--instance Lift PreConversion where
-- lift (ReadProcess command args) =
-- [|ReadProcess $(lift command) $(lift args)|]
-- lift Id = [|Id|]
--
--instance Lift ShakespeareSettings where
-- lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =
-- [|ShakespeareSettings
-- $(lift x1) $(lift x2) $(lift x3)
-- $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
-- where
-- liftExp (VarE n) = [|VarE $(liftName n)|]
-- liftExp (ConE n) = [|ConE $(liftName n)|]
-- liftExp _ = error "liftExp only supports VarE and ConE"
-- liftMExp Nothing = [|Nothing|]
-- liftMExp (Just e) = [|Just|] `appE` liftExp e
-- liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
-- liftFlavour NameS = [|NameS|]
-- liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]
-- liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]
-- liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]
-- liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]
-- liftNS VarName = [|VarName|]
-- liftNS DataName = [|DataName|]
-
- type QueryParameters = [(TS.Text, TS.Text)]
- type RenderUrl url = (url -> QueryParameters -> TS.Text)
-@@ -349,6 +320,7 @@ pack' = TS.pack
- {-# NOINLINE pack' #-}
- #endif
-
-+{-
- contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
- contentsToShakespeare rs a = do
- r <- newName "_render"
-@@ -400,16 +372,19 @@ shakespeareFile r fp =
- qAddDependentFile fp >>
- #endif
- readFileQ fp >>= shakespeareFromString r
-+-}
-
- data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
- deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)
-
-+{-
- getVars :: Content -> [(Deref, VarType)]
- getVars ContentRaw{} = []
- getVars (ContentVar d) = [(d, VTPlain)]
- getVars (ContentUrl d) = [(d, VTUrl)]
- getVars (ContentUrlParam d) = [(d, VTUrlParam)]
- getVars (ContentMix d) = [(d, VTMixin)]
-+-}
-
- data VarExp url = EPlain Builder
- | EUrl url
-@@ -418,8 +393,10 @@ data VarExp url = EPlain Builder
-
- -- | Determine which identifiers are used by the given template, useful for
- -- creating systems like yesod devel.
-+{-
- shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
- shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
-+-}
-
- type MTime = UTCTime
-
-@@ -436,28 +413,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
- insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
- (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))
-
--shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
--shakespeareFileReload settings fp = do
-- str <- readFileQ fp
-- s <- qRunIO $ preFilter (Just fp) settings str
-- let b = shakespeareUsedIdentifiers settings s
-- c <- mapM vtToExp b
-- rt <- [|shakespeareRuntime settings fp|]
-- wrap' <- [|\x -> $(return $ wrap settings) . x|]
-- return $ wrap' `AppE` (rt `AppE` ListE c)
-- where
-- 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 = [|EPlain . $(return $
-- InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]
-- c VTUrl = [|EUrl|]
-- c VTUrlParam = [|EUrlParam|]
-- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]
-
-
-
-diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
-index a0e983c..23b4692 100644
---- a/Text/Shakespeare/Base.hs
-+++ b/Text/Shakespeare/Base.hs
-@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident
- | DerefTuple [Deref]
- deriving (Show, Eq, Read, Data, Typeable, Ord)
-
--instance Lift Ident where
-- lift (Ident s) = [|Ident|] `appE` lift s
--instance Lift Deref where
-- lift (DerefModulesIdent v s) = do
-- dl <- [|DerefModulesIdent|]
-- v' <- lift v
-- s' <- lift s
-- return $ dl `AppE` v' `AppE` s'
-- lift (DerefIdent s) = do
-- dl <- [|DerefIdent|]
-- s' <- lift s
-- return $ dl `AppE` s'
-- lift (DerefBranch x y) = do
-- x' <- lift x
-- y' <- lift y
-- db <- [|DerefBranch|]
-- return $ db `AppE` x' `AppE` y'
-- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i
-- lift (DerefRational r) = do
-- n <- lift $ numerator r
-- d <- lift $ denominator r
-- per <- [|(%) :: Int -> Int -> Ratio Int|]
-- dr <- [|DerefRational|]
-- return $ dr `AppE` InfixE (Just n) per (Just d)
-- lift (DerefString s) = [|DerefString|] `appE` lift s
-- lift (DerefList x) = [|DerefList $(lift x)|]
-- lift (DerefTuple x) = [|DerefTuple $(lift x)|]
--
- derefParens, derefCurlyBrackets :: UserParser a Deref
- derefParens = between (char '(') (char ')') parseDeref
- derefCurlyBrackets = between (char '{') (char '}') parseDeref
---
-1.9.0
-
diff --git a/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch b/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch
index b9f4283ca..90719b1b4 100644
--- a/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch
+++ b/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch
@@ -1,6 +1,6 @@
-From 8cc398092892377d5fdbda990a2e860155422afa Mon Sep 17 00:00:00 2001
-From: foo <foo@bar>
-Date: Sun, 22 Sep 2013 07:29:39 +0000
+From 8d28a63e9a67cde6149bb2cbcf6172ddd997cfff Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Tue, 20 May 2014 17:53:41 +0000
Subject: [PATCH] deal with TH
Export modules referenced by it.
@@ -10,8 +10,8 @@ Splicer.
---
Network/Wai/Application/Static.hs | 4 ----
WaiAppStatic/Storage/Embedded.hs | 8 ++++----
- wai-app-static.cabal | 4 +---
- 3 files changed, 5 insertions(+), 11 deletions(-)
+ wai-app-static.cabal | 2 --
+ 3 files changed, 4 insertions(+), 10 deletions(-)
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
index f2fa743..1a82b30 100644
@@ -55,7 +55,7 @@ index daa6e50..9873d4e 100644
-import WaiAppStatic.Storage.Embedded.TH
+--import WaiAppStatic.Storage.Embedded.TH
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
-index 5d81150..8f8c144 100644
+index 925d350..d0086e8 100644
--- a/wai-app-static.cabal
+++ b/wai-app-static.cabal
@@ -33,7 +33,6 @@ library
@@ -66,17 +66,14 @@ index 5d81150..8f8c144 100644
, text >= 0.7
, blaze-builder >= 0.2.1.4
, base64-bytestring >= 0.1
-@@ -57,9 +56,8 @@ library
- WaiAppStatic.Storage.Embedded
- WaiAppStatic.Listing
- WaiAppStatic.Types
-- other-modules: Util
+@@ -62,7 +61,6 @@ library
+ WaiAppStatic.CmdLine
+ other-modules: Util
WaiAppStatic.Storage.Embedded.Runtime
- WaiAppStatic.Storage.Embedded.TH
-+ other-modules: Util
ghc-options: -Wall
extensions: CPP
--
-1.8.5.1
+2.0.0.rc2
diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
index 5609fb459..137c550fc 100644
--- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
+++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
@@ -1,25 +1,25 @@
-From be8d5895522da0397fd594d5553ed7d3641eb399 Mon Sep 17 00:00:00 2001
+From 8dd61c7ea1b852957c74dc264004a6f7d70044a9 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 7 Mar 2014 01:40:29 +0000
+Date: Tue, 20 May 2014 21:39:04 +0000
Subject: [PATCH] remove and expand TH
fix Loc from MonadLogger
---
Yesod/Core.hs | 30 +++---
Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++---------------
- Yesod/Core/Dispatch.hs | 37 ++-----
+ Yesod/Core/Dispatch.hs | 38 ++-----
Yesod/Core/Handler.hs | 25 ++---
Yesod/Core/Internal/Run.hs | 8 +-
Yesod/Core/Internal/TH.hs | 111 --------------------
Yesod/Core/Types.hs | 3 +-
Yesod/Core/Widget.hs | 32 +-----
- 8 files changed, 215 insertions(+), 288 deletions(-)
+ 8 files changed, 215 insertions(+), 289 deletions(-)
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
-index 12e59d5..2817a69 100644
+index 9b29317..7c0792d 100644
--- a/Yesod/Core.hs
+++ b/Yesod/Core.hs
-@@ -29,16 +29,16 @@ module Yesod.Core
+@@ -31,16 +31,16 @@ module Yesod.Core
, unauthorizedI
-- * Logging
, LogLevel (..)
@@ -46,7 +46,7 @@ index 12e59d5..2817a69 100644
-- * Sessions
, SessionBackend (..)
, customizeSessionCookies
-@@ -85,17 +85,15 @@ module Yesod.Core
+@@ -87,17 +87,15 @@ module Yesod.Core
, readIntegral
-- * Shakespeare
-- ** Hamlet
@@ -409,7 +409,7 @@ index 140600b..75daabc 100644
- char = show . snd . loc_start
+fileLocationToString loc = "unknown"
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
-index e6f489d..3ff37c1 100644
+index 59663a8..9408a95 100644
--- a/Yesod/Core/Dispatch.hs
+++ b/Yesod/Core/Dispatch.hs
@@ -1,4 +1,3 @@
@@ -446,7 +446,7 @@ index e6f489d..3ff37c1 100644
, PathMultiPiece (..)
, Texts
-- * Convert to WAI
-@@ -128,13 +127,6 @@ toWaiAppLogger logger site = do
+@@ -130,13 +129,6 @@ toWaiAppLogger logger site = do
, yreSite = site
, yreSessionBackend = sb
}
@@ -460,10 +460,11 @@ index e6f489d..3ff37c1 100644
middleware <- mkDefaultMiddlewares logger
return $ middleware $ toWaiAppYre yre
-@@ -163,13 +155,7 @@ warp port site = do
+@@ -165,14 +157,7 @@ warp port site = do
]
-}
, Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
+- when (shouldLog' e) $
- messageLoggerSource
- site
- logger
@@ -471,11 +472,11 @@ index e6f489d..3ff37c1 100644
- "yesod-core"
- LevelError
- (toLogStr $ "Exception from Warp: " ++ show e)
-+ error (show e)
++ when (shouldLog' e) $ error (show e)
}
-
- -- | A default set of middlewares.
-@@ -194,7 +180,6 @@ mkDefaultMiddlewares logger = do
+ where
+ shouldLog' =
+@@ -206,7 +191,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
-- | Deprecated synonym for 'warp'.
warpDebug :: YesodDispatch site => Int -> site -> IO ()
warpDebug = warp
@@ -484,10 +485,10 @@ index e6f489d..3ff37c1 100644
-- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It
-- reads port information from the PORT environment variable, as used by tools
diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
-index 7c561c5..847d475 100644
+index e5cbc44..d583607 100644
--- a/Yesod/Core/Handler.hs
+++ b/Yesod/Core/Handler.hs
-@@ -164,7 +164,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
+@@ -169,7 +169,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as TL
import qualified Text.Blaze.Html.Renderer.Text as RenderText
@@ -496,15 +497,15 @@ index 7c561c5..847d475 100644
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
-@@ -198,6 +198,7 @@ import Data.CaseInsensitive (CI)
- #if MIN_VERSION_wai(2, 0, 0)
- import qualified System.PosixCompat.Files as PC
+@@ -550,6 +550,7 @@ sendFilePart ct fp off count = do
+ #else
+ handlerError $ HCSendFile ct fp $ Just $ W.FilePart off count
#endif
+import qualified Text.Blaze.Internal
- get :: MonadHandler m => m GHState
- get = liftHandlerT $ HandlerT $ I.readIORef . handlerState
-@@ -748,19 +749,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+ -- | Bypass remaining handler code and output the given content with a 200
+ -- status code.
+@@ -806,19 +807,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
-> m a
redirectToPost url = do
urlText <- toTextUrl url
@@ -534,11 +535,11 @@ index 7c561c5..847d475 100644
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs
-index 10871a2..e8d1907 100644
+index 3e2e4e0..b92eadb 100644
--- a/Yesod/Core/Internal/Run.hs
+++ b/Yesod/Core/Internal/Run.hs
-@@ -15,8 +15,8 @@ import qualified Control.Exception as E
- import Control.Exception.Lifted (catch)
+@@ -16,8 +16,8 @@ import Control.Exception.Lifted (catch)
+ import Control.Monad (mplus)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (LogLevel (LevelError), LogSource,
@@ -548,7 +549,7 @@ index 10871a2..e8d1907 100644
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
-@@ -30,7 +30,7 @@ import qualified Data.Text as T
+@@ -31,7 +31,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
@@ -557,7 +558,7 @@ index 10871a2..e8d1907 100644
import qualified Network.HTTP.Types as H
import Network.Wai
#if MIN_VERSION_wai(2, 0, 0)
-@@ -131,8 +131,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+@@ -157,8 +157,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ErrorResponse
-> YesodApp
safeEh log' er req = do
@@ -686,18 +687,18 @@ index 7e84c1c..a273c29 100644
- ]
- return $ LetE [fun] (VarE helper)
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
-index de09f78..9183a64 100644
+index 7e3fd0d..994d322 100644
--- a/Yesod/Core/Types.hs
+++ b/Yesod/Core/Types.hs
-@@ -17,6 +17,7 @@ import Control.Exception (Exception)
- import Control.Monad (liftM, ap)
- import Control.Monad.Base (MonadBase (liftBase))
+@@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..))
+ import Control.Monad.Catch (MonadMask (..))
+ #endif
import Control.Monad.IO.Class (MonadIO (liftIO))
+import qualified Control.Monad.Logger
import Control.Monad.Logger (LogLevel, LogSource,
MonadLogger (..))
import Control.Monad.Trans.Control (MonadBaseControl (..))
-@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv
+@@ -187,7 +188,7 @@ data RunHandlerEnv site = RunHandlerEnv
, rheRoute :: !(Maybe (Route site))
, rheSite :: !site
, rheUpload :: !(RequestBodyLength -> FileUpload)
@@ -707,7 +708,7 @@ index de09f78..9183a64 100644
-- ^ How to respond when an error is thrown internally.
--
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
-index a972efa..156cd45 100644
+index 481199e..8489fbe 100644
--- a/Yesod/Core/Widget.hs
+++ b/Yesod/Core/Widget.hs
@@ -16,8 +16,8 @@ module Yesod.Core.Widget
@@ -730,7 +731,7 @@ index a972efa..156cd45 100644
, asWidgetT
) where
-@@ -189,35 +189,9 @@ addScriptRemote = flip addScriptRemoteAttrs []
+@@ -207,35 +207,9 @@ addScriptRemote = flip addScriptRemoteAttrs []
addScriptRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
@@ -767,5 +768,5 @@ index a972efa..156cd45 100644
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m))
--
-1.9.0
+2.0.0.rc2
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-11 20:43:42 +0000