diff options
author | Joey Hess <joey@kitenet.net> | 2014-10-16 00:31:59 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-10-16 00:31:59 -0400 |
commit | 26c60e07ef7c903fa90b0b8ae70f7c259b230ded (patch) | |
tree | a7fdee91504b4449d272885c057cf58e3de26006 /standalone/no-th | |
parent | 9a4c5746c2df53f9c385b62a051772f8dd91b1a9 (diff) |
finished convering android build to pinned packages
Package versions match Debian jessie, except for a few differences
needed due to the different version of ghc pulling in a few buildin
packages with other versions.
Most of the patches were cherry-picked from past commits, since these are
older versions.
Diffstat (limited to 'standalone/no-th')
11 files changed, 1138 insertions, 1333 deletions
diff --git a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch index 368d52593..6d17d634e 100644 --- a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch +++ b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch @@ -1,19 +1,19 @@ -From 438479e3573d4a9fa2e001b8f7ec5f9a595d7514 Mon Sep 17 00:00:00 2001 +From e54cfacbb9fb24f75d3d93cd8ee6da67b161574f Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 14 Oct 2014 03:48:07 +0000 -Subject: [PATCH] avoid TH +Date: Thu, 16 Oct 2014 02:51:28 +0000 +Subject: [PATCH] remove TH --- - DAV.cabal | 25 +---- - Network/Protocol/HTTP/DAV.hs | 92 +++++++++++++--- - Network/Protocol/HTTP/DAV/TH.hs | 232 ++++++++++++++++++++++++++++++++++++++- - 3 files changed, 306 insertions(+), 43 deletions(-) + DAV.cabal | 28 +---- + Network/Protocol/HTTP/DAV.hs | 92 +++++++++++++--- + Network/Protocol/HTTP/DAV/TH.hs | 232 +++++++++++++++++++++++++++++++++++++++- + 3 files changed, 306 insertions(+), 46 deletions(-) diff --git a/DAV.cabal b/DAV.cabal -index f8fdd40..92945c3 100644 +index 95fffd8..5669c51 100644 --- a/DAV.cabal +++ b/DAV.cabal -@@ -43,30 +43,7 @@ library +@@ -47,33 +47,7 @@ library , utf8-string , xml-conduit >= 1.0 && < 1.3 , xml-hamlet >= 0.4 && < 0.5 @@ -34,13 +34,16 @@ index f8fdd40..92945c3 100644 - , http-types >= 0.7 - , lens >= 3.0 - , mtl >= 2.1 -- , network >= 2.3 - , optparse-applicative >= 0.10.0 - , transformers >= 0.3 - , transformers-base - , utf8-string - , xml-conduit >= 1.0 && < 1.3 - , xml-hamlet >= 0.4 && < 0.5 +- if flag(network-uri) +- build-depends: network-uri >= 2.6, network >= 2.6 +- else +- build-depends: network >= 2.3 && <2.6 + , text source-repository head @@ -413,5 +416,5 @@ index 0ecd476..1653bf6 100644 + Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg)) +{-# INLINE userAgent #-} -- -1.7.10.4 +2.1.1 diff --git a/standalone/no-th/haskell-patches/hamlet_hack_TH.patch b/standalone/no-th/haskell-patches/hamlet_hack_TH.patch new file mode 100644 index 000000000..c4e11ca82 --- /dev/null +++ b/standalone/no-th/haskell-patches/hamlet_hack_TH.patch @@ -0,0 +1,205 @@ +From 0509d4383c328c20be61cf3e3bbc98a0a1161588 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 16 Oct 2014 02:21:17 +0000 +Subject: [PATCH] hack 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 +-- +2.1.1 + diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch index 7fdd70639..bc453bfa1 100644 --- a/standalone/no-th/haskell-patches/lens_no-TH.patch +++ b/standalone/no-th/haskell-patches/lens_no-TH.patch @@ -1,20 +1,20 @@ -From bc312c7431877b3b788de5e7ce5ee743be73c0ba Mon Sep 17 00:00:00 2001 +From 10c9ade98b3ac2054947f411d77db2eb28896b9f Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 10 Jun 2014 22:13:58 +0000 -Subject: [PATCH] remove TH +Date: Thu, 16 Oct 2014 01:43:10 +0000 +Subject: [PATCH] avoid TH --- - lens.cabal | 19 +------------------ + lens.cabal | 17 +---------------- src/Control/Lens.hs | 8 ++------ src/Control/Lens/Cons.hs | 2 -- src/Control/Lens/Internal/Fold.hs | 2 -- src/Control/Lens/Operators.hs | 2 +- src/Control/Lens/Prism.hs | 2 -- src/Control/Monad/Primitive/Lens.hs | 1 - - 7 files changed, 4 insertions(+), 32 deletions(-) + 7 files changed, 4 insertions(+), 30 deletions(-) diff --git a/lens.cabal b/lens.cabal -index d70c2f4..28af768 100644 +index 5388301..d7b02b9 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional @@ -26,7 +26,7 @@ index d70c2f4..28af768 100644 -- build-tools: cpphs tested-with: GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2 synopsis: Lenses, Folds and Traversals -@@ -220,7 +220,6 @@ library +@@ -217,7 +217,6 @@ library Control.Exception.Lens Control.Lens Control.Lens.Action @@ -34,7 +34,16 @@ index d70c2f4..28af768 100644 Control.Lens.Combinators Control.Lens.Cons Control.Lens.Each -@@ -248,29 +247,24 @@ library +@@ -234,8 +233,6 @@ library + Control.Lens.Internal.Context + Control.Lens.Internal.Deque + Control.Lens.Internal.Exception +- Control.Lens.Internal.FieldTH +- Control.Lens.Internal.PrismTH + Control.Lens.Internal.Fold + Control.Lens.Internal.Getter + Control.Lens.Internal.Indexed +@@ -247,25 +244,21 @@ library Control.Lens.Internal.Reflection Control.Lens.Internal.Review Control.Lens.Internal.Setter @@ -60,11 +69,7 @@ index d70c2f4..28af768 100644 Control.Monad.Primitive.Lens Control.Parallel.Strategies.Lens Control.Seq.Lens -- Data.Aeson.Lens - Data.Array.Lens - Data.Bits.Lens - Data.ByteString.Lens -@@ -293,17 +287,10 @@ library +@@ -291,12 +284,8 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens @@ -76,13 +81,8 @@ index d70c2f4..28af768 100644 - Language.Haskell.TH.Lens Numeric.Lens -- other-modules: -- Control.Lens.Internal.TupleIxedTH -- - cpp-options: -traditional - - if flag(safe) -@@ -405,7 +392,6 @@ test-suite doctests + other-modules: +@@ -403,7 +392,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, @@ -90,7 +90,7 @@ index d70c2f4..28af768 100644 mtl, nats, parallel, -@@ -443,7 +429,6 @@ benchmark plated +@@ -441,7 +429,6 @@ benchmark plated comonad, criterion, deepseq, @@ -98,7 +98,7 @@ index d70c2f4..28af768 100644 lens, transformers -@@ -478,7 +463,6 @@ benchmark unsafe +@@ -476,7 +463,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, @@ -106,7 +106,7 @@ index d70c2f4..28af768 100644 lens, transformers -@@ -495,6 +479,5 @@ benchmark zipper +@@ -493,6 +479,5 @@ benchmark zipper comonads-fd, criterion, deepseq, @@ -201,10 +201,10 @@ index 9992e63..631e8e6 100644 , ( # ) -- * "Control.Lens.Setter" diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs -index 9e0bec7..0cf6737 100644 +index b75c870..c6c6596 100644 --- a/src/Control/Lens/Prism.hs +++ b/src/Control/Lens/Prism.hs -@@ -59,8 +59,6 @@ import Unsafe.Coerce +@@ -61,8 +61,6 @@ import Unsafe.Coerce import Data.Profunctor.Unsafe #endif @@ -226,5 +226,5 @@ index ee942c6..2f37134 100644 prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) prim = iso internal primitive -- -2.0.0 +2.1.1 diff --git a/standalone/no-th/haskell-patches/persistent-template_stub-out.patch b/standalone/no-th/haskell-patches/persistent-template_stub-out.patch index caa19074a..f3ee63e06 100644 --- a/standalone/no-th/haskell-patches/persistent-template_stub-out.patch +++ b/standalone/no-th/haskell-patches/persistent-template_stub-out.patch @@ -1,25 +1,25 @@ -From 97e13262aa53cd3cc4f3997ac9156007ca1b9ce0 Mon Sep 17 00:00:00 2001 +From e6542197f1da6984bb6cd3310dba77363dfab2d9 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 14 Oct 2014 02:18:08 +0000 -Subject: [PATCH] unused +Date: Thu, 16 Oct 2014 01:51:02 +0000 +Subject: [PATCH] stub out --- - persistent-template.cabal | 2 +- + persistent-template.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-template.cabal b/persistent-template.cabal -index e247f6b..68184af 100644 +index 59b4149..e11b418 100644 --- a/persistent-template.cabal +++ b/persistent-template.cabal -@@ -29,7 +29,7 @@ library - , tagged - , path-pieces - , ghc-prim +@@ -26,7 +26,7 @@ library + , aeson + , monad-logger + , unordered-containers - exposed-modules: Database.Persist.TH + exposed-modules: ghc-options: -Wall if impl(ghc >= 7.4) cpp-options: -DGHC_7_4 -- -1.7.10.4 +2.1.1 diff --git a/standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch b/standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch new file mode 100644 index 000000000..82e2c6420 --- /dev/null +++ b/standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch @@ -0,0 +1,366 @@ +From 657fa7135bbcf3d5adb3cc0032e09887dd80a2a7 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 16 Oct 2014 02:05:14 +0000 +Subject: [PATCH] hack TH + +--- + Text/Cassius.hs | 23 -------- + Text/Css.hs | 151 -------------------------------------------------- + Text/CssCommon.hs | 4 -- + Text/Lucius.hs | 46 +-------------- + shakespeare-css.cabal | 2 +- + 5 files changed, 3 insertions(+), 223 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/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/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/shakespeare-css.cabal b/shakespeare-css.cabal +index 2d3b25a..cc0553c 100644 +--- a/shakespeare-css.cabal ++++ b/shakespeare-css.cabal +@@ -35,8 +35,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 +-- +2.1.1 + diff --git a/standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch b/standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch new file mode 100644 index 000000000..905467130 --- /dev/null +++ b/standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch @@ -0,0 +1,316 @@ +From 26f7328b0123d3ffa66873b91189ba3bdae3356c Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 16 Oct 2014 02:07:32 +0000 +Subject: [PATCH] hack 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 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/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 +-- +2.1.1 + diff --git a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch index 86022ec3d..940514756 100644 --- a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch +++ b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch @@ -1,791 +1,18 @@ -From 6de4e75bfbfccb8aedcbf3ee75e5d544f1eeeca5 Mon Sep 17 00:00:00 2001 +From 38a22dae4f7f9726379fdaa3f85d78d75eee9d8e Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 3 Jul 2014 21:48:14 +0000 -Subject: [PATCH] remove TH +Date: Thu, 16 Oct 2014 02:01:22 +0000 +Subject: [PATCH] hack TH --- - 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 | 3 +- - 14 files changed, 78 insertions(+), 813 deletions(-) + Text/Shakespeare.hs | 70 ++++++++---------------------------------------- + Text/Shakespeare/Base.hs | 28 ------------------- + 2 files changed, 11 insertions(+), 87 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 39c1528..6321cd3 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 -@@ -460,7 +428,7 @@ hamletUsedIdentifiers settings = - data HamletRuntimeRules = HamletRuntimeRules { - hrrI18n :: Bool - } -- -+{- - hamletFileReloadWithSettings :: HamletRuntimeRules - -> HamletSettings -> FilePath -> Q Exp - hamletFileReloadWithSettings hrr settings fp = do -@@ -487,7 +455,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 +index 68e344f..97361a2 100644 --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs -@@ -15,12 +15,12 @@ module Text.Shakespeare +@@ -14,12 +14,12 @@ module Text.Shakespeare , WrapInsertion (..) , PreConversion (..) , defaultShakespeareSettings @@ -803,7 +30,7 @@ index 67d7dde..a510215 100644 , RenderUrl , VarType (..) , Deref -@@ -153,38 +153,6 @@ defaultShakespeareSettings = ShakespeareSettings { +@@ -154,38 +154,6 @@ defaultShakespeareSettings = ShakespeareSettings { , modifyFinalValue = Nothing } @@ -842,7 +69,7 @@ index 67d7dde..a510215 100644 type QueryParameters = [(TS.Text, TS.Text)] type RenderUrl url = (url -> QueryParameters -> TS.Text) -@@ -348,6 +316,7 @@ pack' = TS.pack +@@ -349,6 +317,7 @@ pack' = TS.pack {-# NOINLINE pack' #-} #endif @@ -850,7 +77,7 @@ index 67d7dde..a510215 100644 contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp contentsToShakespeare rs a = do r <- newName "_render" -@@ -399,16 +368,19 @@ shakespeareFile r fp = +@@ -400,16 +369,19 @@ shakespeareFile r fp = qAddDependentFile fp >> #endif readFileQ fp >>= shakespeareFromString r @@ -870,7 +97,7 @@ index 67d7dde..a510215 100644 data VarExp url = EPlain Builder | EUrl url -@@ -417,8 +389,10 @@ data VarExp url = EPlain Builder +@@ -418,8 +390,10 @@ data VarExp url = EPlain Builder -- | Determine which identifiers are used by the given template, useful for -- creating systems like yesod devel. @@ -881,7 +108,7 @@ index 67d7dde..a510215 100644 type MTime = UTCTime -@@ -435,28 +409,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] +@@ -436,28 +410,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef (\reloadMap -> (M.insert fp (mt, content) reloadMap, content)) @@ -949,366 +176,6 @@ index a0e983c..23b4692 100644 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 05b985e..dd8762a 100644 ---- a/shakespeare.cabal -+++ b/shakespeare.cabal -@@ -61,10 +61,9 @@ library - Text.Lucius - Text.Cassius - Text.Shakespeare.Base -+ Text.Css - Text.Shakespeare -- Text.TypeScript - other-modules: Text.Hamlet.Parse -- Text.Css - Text.MkSizeType - Text.IndentToBrace - Text.CssCommon -- -1.7.10.4 +2.1.1 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 378043410..f58fcb353 100644 --- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch @@ -1,17 +1,17 @@ -From e163ab104cf2f8d2bac07ab389caec49dfc39665 Mon Sep 17 00:00:00 2001 +From f1feea61dcba0b16afed5ce8dd5d2433fe505461 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 14 Oct 2014 02:49:19 +0000 -Subject: [PATCH] expand and remove TH +Date: Thu, 16 Oct 2014 02:15:23 +0000 +Subject: [PATCH] hack TH --- - Yesod/Core.hs | 30 +++--- - Yesod/Core/Class/Yesod.hs | 256 +++++++++++++++++++++++++++++--------------- - Yesod/Core/Dispatch.hs | 38 ++----- - Yesod/Core/Handler.hs | 25 ++--- - Yesod/Core/Internal/Run.hs | 6 +- - Yesod/Core/Internal/TH.hs | 111 ------------------- - Yesod/Core/Types.hs | 3 +- - Yesod/Core/Widget.hs | 32 +----- + Yesod/Core.hs | 30 +++--- + Yesod/Core/Class/Yesod.hs | 256 ++++++++++++++++++++++++++++++--------------- + Yesod/Core/Dispatch.hs | 38 ++----- + Yesod/Core/Handler.hs | 25 ++--- + Yesod/Core/Internal/Run.hs | 6 +- + Yesod/Core/Internal/TH.hs | 111 -------------------- + Yesod/Core/Types.hs | 3 +- + Yesod/Core/Widget.hs | 32 +----- 8 files changed, 213 insertions(+), 288 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs @@ -68,10 +68,10 @@ index 9b29317..7c0792d 100644 , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs -index 5dbaff2..edd98a5 100644 +index 8631d27..c40eb10 100644 --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs -@@ -5,11 +5,15 @@ +@@ -5,18 +5,22 @@ {-# LANGUAGE CPP #-} module Yesod.Core.Class.Yesod where @@ -88,16 +88,15 @@ index 5dbaff2..edd98a5 100644 import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) -@@ -17,7 +21,7 @@ import Control.Arrow ((***), second) - import Control.Exception (bracket) + import Control.Arrow ((***), second) import Control.Monad (forM, when, void) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), +import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther), LogSource) - import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState) import qualified Data.ByteString.Char8 as S8 -@@ -35,7 +39,6 @@ import qualified Data.Text.Encoding.Error as TEE + import qualified Data.ByteString.Lazy as L +@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Word (Word64) @@ -105,7 +104,7 @@ index 5dbaff2..edd98a5 100644 import Network.HTTP.Types (encodePath) import qualified Network.Wai as W import Data.Default (def) -@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where +@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage @@ -144,7 +143,7 @@ index 5dbaff2..edd98a5 100644 -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid -@@ -373,45 +384,103 @@ widgetToPageContent w = do +@@ -374,45 +385,103 @@ widgetToPageContent w = do -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing -- the asynchronous loader means your page doesn't have to wait for all the js to load let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc @@ -287,7 +286,7 @@ index 5dbaff2..edd98a5 100644 return $ PageContent title headAll $ case jsLoader master of -@@ -441,10 +510,13 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" @@ -305,7 +304,7 @@ index 5dbaff2..edd98a5 100644 provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. -@@ -454,10 +526,11 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" @@ -321,7 +320,7 @@ index 5dbaff2..edd98a5 100644 provideRep $ do -- 401 *MUST* include a WWW-Authenticate header -@@ -479,10 +552,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do +@@ -480,10 +553,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -339,7 +338,7 @@ index 5dbaff2..edd98a5 100644 provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) -@@ -491,30 +567,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do +@@ -492,30 +568,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" @@ -397,7 +396,7 @@ index 5dbaff2..edd98a5 100644 provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text) -@@ -653,8 +741,4 @@ loadClientSession key getCachedDate sessionName req = load +@@ -682,8 +770,4 @@ loadClientSession key getCachedDate sessionName req = load -- turn the TH Loc loaction information into a human readable string -- leaving out the loc_end parameter fileLocationToString :: Loc -> String @@ -408,7 +407,7 @@ index 5dbaff2..edd98a5 100644 - char = show . snd . loc_start +fileLocationToString loc = "unknown" diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs -index ad56452..d3d58ee 100644 +index e0d1f0e..cc23fdd 100644 --- a/Yesod/Core/Dispatch.hs +++ b/Yesod/Core/Dispatch.hs @@ -1,4 +1,3 @@ @@ -445,7 +444,7 @@ index ad56452..d3d58ee 100644 , PathMultiPiece (..) , Texts -- * Convert to WAI -@@ -130,13 +129,6 @@ toWaiAppLogger logger site = do +@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do , yreSite = site , yreSessionBackend = sb } @@ -459,10 +458,10 @@ index ad56452..d3d58ee 100644 middleware <- mkDefaultMiddlewares logger return $ middleware $ toWaiAppYre yre -@@ -156,14 +148,7 @@ warp port site = do - Network.Wai.Handler.Warp.setPort port $ - Network.Wai.Handler.Warp.setServerName serverValue $ - Network.Wai.Handler.Warp.setOnException (\_ e -> +@@ -170,14 +162,7 @@ warp port site = do + ] + -} + , Network.Wai.Handler.Warp.settingsOnException = const $ \e -> - when (shouldLog' e) $ - messageLoggerSource - site @@ -470,12 +469,12 @@ index ad56452..d3d58ee 100644 - $(qLocation >>= liftLoc) - "yesod-core" - LevelError -- (toLogStr $ "Exception from Warp: " ++ show e)) $ -+ when (shouldLog' e) $ error (show e)) $ - Network.Wai.Handler.Warp.defaultSettings) +- (toLogStr $ "Exception from Warp: " ++ show e) ++ when (shouldLog' e) $ error (show e) + } where - shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException -@@ -197,7 +182,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr + shouldLog' = +@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr -- | Deprecated synonym for 'warp'. warpDebug :: YesodDispatch site => Int -> site -> IO () warpDebug = warp @@ -484,10 +483,10 @@ index ad56452..d3d58ee 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 36f8f5c..948de5f 100644 +index d2b196b..13cac17 100644 --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs -@@ -171,7 +171,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +@@ -174,7 +174,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,7 +495,7 @@ index 36f8f5c..948de5f 100644 import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -@@ -199,6 +199,7 @@ import Control.Exception (throwIO) +@@ -203,6 +203,7 @@ import Control.Exception (throwIO) import Blaze.ByteString.Builder (Builder) import Safe (headMay) import Data.CaseInsensitive (CI) @@ -504,7 +503,7 @@ index 36f8f5c..948de5f 100644 import qualified Data.Conduit.List as CL import Control.Monad (unless) import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO -@@ -803,19 +804,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) +@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) -> m a redirectToPost url = do urlText <- toTextUrl url @@ -534,7 +533,7 @@ index 36f8f5c..948de5f 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 fdb2261..12ed4fc 100644 +index 311f208..63f666f 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs @@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) @@ -544,7 +543,7 @@ index fdb2261..12ed4fc 100644 -import Control.Monad.Logger (LogLevel (LevelError), LogSource, +import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource, liftLoc) - import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState) + import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) import qualified Data.ByteString as S @@ -31,7 +31,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -554,8 +553,8 @@ index fdb2261..12ed4fc 100644 +import Language.Haskell.TH.Syntax (qLocation) import qualified Network.HTTP.Types as H import Network.Wai - import Network.Wai.Internal -@@ -157,8 +157,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + #if MIN_VERSION_wai(2, 0, 0) +@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp safeEh log' er req = do @@ -684,18 +683,18 @@ index 7e84c1c..a273c29 100644 - ] - return $ LetE [fun] (VarE helper) diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs -index 4d4474b..61ddb20 100644 +index 388dfe3..b3fce0f 100644 --- a/Yesod/Core/Types.hs +++ b/Yesod/Core/Types.hs -@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase)) - import Control.Monad.Catch (MonadCatch (..)) +@@ -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 (..)) -@@ -174,7 +175,7 @@ data RunHandlerEnv site = RunHandlerEnv +@@ -191,7 +192,7 @@ data RunHandlerEnv site = RunHandlerEnv , rheRoute :: !(Maybe (Route site)) , rheSite :: !site , rheUpload :: !(RequestBodyLength -> FileUpload) @@ -765,5 +764,5 @@ index 481199e..8489fbe 100644 ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -1.7.10.4 +2.1.1 diff --git a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch index 9325d1995..84314a8d9 100644 --- a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch +++ b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch @@ -1,16 +1,16 @@ -From 98077d391b930a4c1f69e3b8810409fd261eee34 Mon Sep 17 00:00:00 2001 -From: androidbuilder <androidbuilder@example.com> -Date: Tue, 14 Oct 2014 03:17:38 +0000 -Subject: [PATCH] expand and remove TH +From 1b24ece1a40c9365f719472ca6e342c8c4065c25 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 16 Oct 2014 02:31:20 +0000 +Subject: [PATCH] hack TH --- - Yesod/Form/Bootstrap3.hs | 186 +++++++++-- - Yesod/Form/Fields.hs | 797 +++++++++++++++++++++++++++++++++++----------- - Yesod/Form/Functions.hs | 257 ++++++++++++--- - Yesod/Form/Jquery.hs | 134 ++++++-- - Yesod/Form/MassInput.hs | 226 ++++++++++--- - Yesod/Form/Nic.hs | 46 +-- - 6 files changed, 1279 insertions(+), 367 deletions(-) + Yesod/Form/Bootstrap3.hs | 186 +++++++++-- + Yesod/Form/Fields.hs | 816 +++++++++++++++++++++++++++++++++++------------ + Yesod/Form/Functions.hs | 257 ++++++++++++--- + Yesod/Form/Jquery.hs | 134 ++++++-- + Yesod/Form/MassInput.hs | 226 ++++++++++--- + Yesod/Form/Nic.hs | 67 +++- + 6 files changed, 1322 insertions(+), 364 deletions(-) diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs index 84e85fc..1954fb4 100644 @@ -229,7 +229,7 @@ index 84e85fc..1954fb4 100644 , fvTooltip = Nothing , fvId = bootstrapSubmitId diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs -index 8173e78..68a284c 100644 +index c6091a9..9e6bd4e 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,4 +1,3 @@ @@ -279,7 +279,7 @@ index 8173e78..68a284c 100644 import qualified Blaze.ByteString.Builder.Html.Utf8 as B import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder.Internal.Write (fromWriteList) -@@ -87,15 +88,12 @@ import qualified Data.Text as T (drop, dropWhile) +@@ -91,15 +92,12 @@ import qualified Data.Text as T (drop, dropWhile) import qualified Data.Text.Read import qualified Data.Map as Map @@ -295,7 +295,7 @@ index 8173e78..68a284c 100644 defaultFormMessage :: FormMessage -> Text defaultFormMessage = englishFormMessage -@@ -107,10 +105,25 @@ intField = Field +@@ -111,10 +109,25 @@ intField = Field Right (a, "") -> Right a _ -> Left $ MsgInvalidInteger s @@ -325,7 +325,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where -@@ -124,10 +137,25 @@ doubleField = Field +@@ -128,10 +141,25 @@ doubleField = Field Right (a, "") -> Right a _ -> Left $ MsgInvalidNumber s @@ -355,7 +355,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) -@@ -135,10 +163,24 @@ $newline never +@@ -139,10 +167,24 @@ $newline never dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day dayField = Field { fieldParse = parseHelper $ parseDate . unpack @@ -384,7 +384,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) -@@ -146,10 +188,23 @@ $newline never +@@ -150,10 +192,23 @@ $newline never timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay timeField = Field { fieldParse = parseHelper parseTime @@ -412,7 +412,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where -@@ -162,10 +217,23 @@ $newline never +@@ -166,10 +221,23 @@ $newline never htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html htmlField = Field { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance @@ -440,13 +440,13 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . renderHtml) -@@ -193,10 +261,17 @@ instance ToHtml Textarea where +@@ -197,10 +265,18 @@ instance ToHtml Textarea where textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea textareaField = Field { fieldParse = parseHelper $ Right . Textarea -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| -$newline never --<textarea id="#{theId}" name="#{name}" :isReq:required="" *{attrs}>#{either id unTextarea val} +-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val} -|] + , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_aJKe + -> do { id @@ -459,10 +459,11 @@ index 8173e78..68a284c 100644 + id ((Text.Blaze.Internal.preEscapedText . pack) ">"); + id (toHtml (either id unTextarea val)); + id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } ++ , fieldEnctype = UrlEncoded } -@@ -204,10 +279,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) +@@ -208,10 +284,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) => Field m p hiddenField = Field { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece @@ -486,7 +487,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } -@@ -215,20 +299,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex +@@ -219,20 +304,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex textField = Field { fieldParse = parseHelper $ Right , fieldView = \theId name attrs val isReq -> @@ -548,7 +549,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } -@@ -300,10 +417,24 @@ emailField = Field +@@ -304,10 +422,24 @@ emailField = Field case Email.canonicalizeEmail $ encodeUtf8 s of Just e -> Right $ decodeUtf8With lenientDecode e Nothing -> Left $ MsgInvalidEmail s @@ -577,7 +578,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } -@@ -318,10 +449,25 @@ multiEmailField = Field +@@ -322,10 +454,25 @@ multiEmailField = Field in case partitionEithers addrs of ([], good) -> Right good (bad, _) -> Left $ MsgInvalidEmail $ cat bad @@ -607,7 +608,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where -@@ -337,20 +483,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus +@@ -341,20 +488,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus searchField autoFocus = Field { fieldParse = parseHelper Right , fieldView = \theId name attrs val isReq -> do @@ -695,7 +696,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } -@@ -361,7 +562,28 @@ urlField = Field +@@ -365,7 +567,28 @@ urlField = Field Nothing -> Left $ MsgInvalidUrl s Just _ -> Right s , fieldView = \theId name attrs val isReq -> @@ -725,7 +726,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } -@@ -374,18 +596,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) +@@ -378,18 +601,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) a selectField = selectFieldHelper @@ -792,7 +793,7 @@ index 8173e78..68a284c 100644 multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] -@@ -408,11 +666,45 @@ multiSelectField ioptlist = +@@ -412,11 +671,45 @@ multiSelectField ioptlist = view theId name attrs val isReq = do opts <- fmap olOptions $ handlerToWidget ioptlist let selOpts = map (id &&& (optselected val)) opts @@ -843,7 +844,7 @@ index 8173e78..68a284c 100644 where optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals -@@ -435,54 +727,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) +@@ -439,54 +732,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) opts <- fmap olOptions $ handlerToWidget ioptlist let optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals @@ -1077,7 +1078,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } where -@@ -508,10 +942,24 @@ $newline never +@@ -512,10 +947,24 @@ $newline never checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool checkBoxField = Field { fieldParse = \e _ -> return $ checkBoxParser e @@ -1106,16 +1107,25 @@ index 8173e78..68a284c 100644 , fieldEnctype = UrlEncoded } -@@ -555,51 +1003,6 @@ optionsPairs opts = do +@@ -559,69 +1008,6 @@ optionsPairs opts = do optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] +-#if MIN_VERSION_persistent(2, 0, 0) -optionsPersist :: ( YesodPersist site, PersistEntity a - , PersistQuery (PersistEntityBackend a) - , PathPiece (Key a) - , RenderMessage site msg - , YesodPersistBackend site ~ PersistEntityBackend a - ) +-#else +-optionsPersist :: ( YesodPersist site, PersistEntity a +- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) +- , PathPiece (Key a) +- , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO)) +- , RenderMessage site msg +- ) +-#endif - => [Filter a] - -> [SelectOpt a] - -> (a -> msg) @@ -1133,6 +1143,7 @@ index 8173e78..68a284c 100644 --- the entire @Entity@. --- --- Since 1.3.2 +-#if MIN_VERSION_persistent(2, 0, 0) -optionsPersistKey - :: (YesodPersist site - , PersistEntity a @@ -1141,6 +1152,15 @@ index 8173e78..68a284c 100644 - , RenderMessage site msg - , YesodPersistBackend site ~ PersistEntityBackend a - ) +-#else +-optionsPersistKey +- :: (YesodPersist site +- , PersistEntity a +- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) +- , PathPiece (Key a) +- , RenderMessage site msg +- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)) +-#endif - => [Filter a] - -> [SelectOpt a] - -> (a -> msg) @@ -1154,11 +1174,10 @@ index 8173e78..68a284c 100644 - , optionInternalValue = key - , optionExternalValue = toPathPiece key - }) pairs -- + selectFieldHelper :: (Eq a, RenderMessage site FormMessage) - => (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ()) -@@ -642,9 +1045,21 @@ fileField = Field +@@ -665,9 +1051,21 @@ fileField = Field case files of [] -> Right Nothing file:_ -> Right $ Just file @@ -1183,7 +1202,7 @@ index 8173e78..68a284c 100644 , fieldEnctype = Multipart } -@@ -671,10 +1086,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do +@@ -694,10 +1092,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs , fvId = id' @@ -1207,7 +1226,7 @@ index 8173e78..68a284c 100644 , fvErrors = errs , fvRequired = True } -@@ -703,10 +1127,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do +@@ -726,10 +1133,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs , fvId = id' @@ -1971,14 +1990,11 @@ index a2b434d..75eb484 100644 - <td .errors>#{err} -|] diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs -index 2862678..7a0f25a 100644 +index 7e4af07..b59745a 100644 --- a/Yesod/Form/Nic.hs +++ b/Yesod/Form/Nic.hs -@@ -6,14 +6,24 @@ - -- | Provide the user with a rich text editor. - module Yesod.Form.Nic - ( YesodNic (..) -- , nicHtmlField +@@ -9,11 +9,22 @@ module Yesod.Form.Nic + , nicHtmlField ) where +import qualified Text.Blaze as Text.Blaze.Internal @@ -2002,40 +2018,69 @@ index 2862678..7a0f25a 100644 import Text.Blaze.Html.Renderer.String (renderHtml) import Data.Text (Text, pack) import Data.Maybe (listToMaybe) -@@ -22,33 +32,3 @@ class Yesod a => YesodNic a where - -- | NIC Editor Javascript file. - urlNicEdit :: a -> Either (Route a) Text - urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js" -- --nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html --nicHtmlField = Field -- { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e -- , fieldView = \theId name attrs val _isReq -> do +@@ -27,20 +38,52 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html + nicHtmlField = Field + { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e + , fieldView = \theId name attrs val isReq -> do - toWidget [shamlet| -$newline never -- <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val} +- <textarea id="#{theId}" *{attrs} name="#{name}" :isReq:required .html>#{showVal val} -|] -- addScript' urlNicEdit -- master <- getYesod -- toWidget $ -- case jsLoader master of ++ toWidget $ do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<textarea class=\"html\" id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))] ++ Nothing; ++ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } ++ + addScript' urlNicEdit + master <- getYesod + toWidget $ + case jsLoader master of - BottomOfHeadBlocking -> [julius| -bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")}); -|] - _ -> [julius| -(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})(); -|] -- , fieldEnctype = UrlEncoded -- } -- where -- showVal = either id (pack . renderHtml) -- --addScript' :: (MonadWidget m, HandlerSite m ~ site) -- => (site -> Either (Route site) Text) -- -> m () --addScript' f = do -- y <- getYesod -- addScriptEither $ f y ++ BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl ++ (\ _render_a2rMh ++ -> Data.Monoid.mconcat ++ [Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""), ++ Text.Julius.toJavascript (rawJS theId), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\")});")]) ++ ++ _ -> Text.Julius.asJavascriptUrl ++ (\ _render_a2rMm ++ -> Data.Monoid.mconcat ++ [Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""), ++ Text.Julius.toJavascript (rawJS theId), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\")})();")]) ++ + , fieldEnctype = UrlEncoded + } + where -- -1.7.10.4 +2.1.1 diff --git a/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch b/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch index f0c4dfaa4..76aad4e34 100644 --- a/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch +++ b/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch @@ -1,23 +1,23 @@ -From 85917e8b5da3c67c6ca0791fdad735ffb864ae3b Mon Sep 17 00:00:00 2001 +From e82ed4e6fd7b5ea6dbe474b5de2755ec5794161c Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 14 Oct 2014 02:50:19 +0000 -Subject: [PATCH] not needed +Date: Thu, 16 Oct 2014 02:23:50 +0000 +Subject: [PATCH] stub out --- - yesod-persistent.cabal | 10 ---------- + yesod-persistent.cabal | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal -index 2e5735d..438c76d 100644 +index b116f3a..017b184 100644 --- a/yesod-persistent.cabal +++ b/yesod-persistent.cabal @@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod. library build-depends: base >= 4 && < 5 -- , yesod-core >= 1.4.0 && < 1.5 -- , persistent >= 2.1 && < 2.2 -- , persistent-template >= 2.1 && < 2.2 +- , yesod-core >= 1.2.2 && < 1.3 +- , persistent >= 1.2 && < 2.1 +- , persistent-template >= 1.2 && < 2.1 - , transformers >= 0.2.2 - , blaze-builder - , conduit @@ -29,5 +29,5 @@ index 2e5735d..438c76d 100644 test-suite test -- -1.7.10.4 +2.1.1 diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch index b1c5c44b4..ebf8a786b 100644 --- a/standalone/no-th/haskell-patches/yesod_hack-TH.patch +++ b/standalone/no-th/haskell-patches/yesod_hack-TH.patch @@ -1,13 +1,13 @@ -From 1d12efe6c85c57bce44d0cd9389c5538f36f599e Mon Sep 17 00:00:00 2001 +From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 14 Oct 2014 03:40:28 +0000 -Subject: [PATCH] hack to build +Date: Thu, 16 Oct 2014 02:36:37 +0000 +Subject: [PATCH] hack TH --- - Yesod.hs | 19 ++++++++++++-- - Yesod/Default/Main.hs | 27 +------------------ - Yesod/Default/Util.hs | 69 ++----------------------------------------------- - 3 files changed, 20 insertions(+), 95 deletions(-) + Yesod.hs | 19 ++++++++++++-- + Yesod/Default/Main.hs | 31 +---------------------- + Yesod/Default/Util.hs | 69 ++------------------------------------------------- + 3 files changed, 20 insertions(+), 99 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index b367144..fbe309c 100644 @@ -41,7 +41,7 @@ index b367144..fbe309c 100644 +insert = undefined + diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs -index 44e094e..41c2df0 100644 +index 565ed35..bf46642 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@ @@ -64,7 +64,7 @@ index 44e094e..41c2df0 100644 import System.Log.FastLogger (LogStr, toLogStr) import Language.Haskell.TH.Syntax (qLocation) -@@ -55,29 +53,6 @@ defaultMain load getApp = do +@@ -55,33 +53,6 @@ defaultMain load getApp = do type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () @@ -89,11 +89,15 @@ index 44e094e..41c2df0 100644 - (toLogStr $ "Exception from Warp: " ++ show e) - } app - where -- shouldLog' = Warp.defaultShouldDisplayException -- +- shouldLog' = +-#if MIN_VERSION_warp(2,1,3) +- Warp.defaultShouldDisplayException +-#else +- const True +-#endif + -- | Run your application continously, listening for SIGINT and exiting -- when received - -- diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs index a10358e..0547424 100644 --- a/Yesod/Default/Util.hs @@ -191,5 +195,5 @@ index a10358e..0547424 100644 - else return $ Just ex - else return Nothing -- -1.7.10.4 +2.1.1 |