diff options
| -rw-r--r-- | standalone/no-th/haskell-patches/hamlet_remove-TH.patch | 336 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/lens_no-TH.patch | 94 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/monad-logger_remove-TH.patch | 163 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/reflection_remove-TH.patch | 134 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch | 26 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/shakespeare_remove-th.patch (renamed from standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch) | 138 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/yesod-core_expand_TH.patch | 104 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/yesod-static_hack.patch | 142 | ||||
| -rw-r--r-- | standalone/no-th/haskell-patches/yesod_hack-TH.patch | 27 |
9 files changed, 501 insertions, 663 deletions
diff --git a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch index c5c352fe4..04989b148 100644 --- a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch +++ b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch @@ -1,17 +1,18 @@ -From f500a9e447912e68c12f011fe97b62e6a6c5c3ce Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 17 Dec 2013 16:16:32 +0000 +From 60d7ac8aa1b3282a06ea7b17680dfc32c61fcbf6 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 6 Mar 2014 23:19:40 +0000 Subject: [PATCH] remove TH --- - Text/Hamlet.hs | 310 ++++----------------------------------------------------- - 1 file changed, 17 insertions(+), 293 deletions(-) + 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 4f873f4..10d8ba6 100644 +index 9500ecb..ec8471a 100644 --- a/Text/Hamlet.hs +++ b/Text/Hamlet.hs -@@ -11,34 +11,34 @@ +@@ -11,36 +11,36 @@ module Text.Hamlet ( -- * Plain HTML Html @@ -27,10 +28,14 @@ index 4f873f4..10d8ba6 100644 , HtmlUrl - , hamlet - , hamletFile +- , hamletFileReload +- , ihamletFileReload - , xhamlet - , xhamletFile + --, hamlet + --, hamletFile ++ --, hamletFileReload ++ --, ihamletFileReload + --, xhamlet + --, xhamletFile -- * I18N Hamlet @@ -63,7 +68,7 @@ index 4f873f4..10d8ba6 100644 , CloseStyle (..) -- * Used by generated code , condH -@@ -100,47 +100,9 @@ type HtmlUrl url = Render url -> Html +@@ -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 @@ -111,255 +116,90 @@ index 4f873f4..10d8ba6 100644 mkConName :: DataConstr -> Name mkConName = mkName . conToStr -@@ -148,248 +110,10 @@ conToStr :: DataConstr -> String +@@ -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. ---- ---- For example: data R = C { f1, f2 :: Int } ---- C {..} is equivalent to C {f1=f1, f2=f2} ---- C {f1 = a, ..} is equivalent to C {f1=a, f2=f2} ---- C {f2 = a, ..} is equivalent to C {f1=f1, f2=a} --bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)]) --bindWildFields conName fields = do -- fieldNames <- recordToFieldNames conName -- let available n = nameBase n `notElem` map unIdent fields -- let remainingFields = filter available fieldNames -- let mkPat n = do -- e <- newName (nameBase n) -- return ((n,VarP e), (Ident (nameBase n), VarE e)) -- fmap unzip $ mapM mkPat remainingFields -- ---- Important note! reify will fail if the record type is defined in the ---- same module as the reify is used. This means quasi-quoted Hamlet ---- literals will not be able to use wildcards to match record types ---- defined in the same module. --recordToFieldNames :: DataConstr -> Q [Name] --recordToFieldNames conStr = do -- -- use 'lookupValueName' instead of just using 'mkName' so we reify the -- -- data constructor and not the type constructor if their names match. -- Just conName <- lookupValueName $ conToStr conStr -- DataConI _ _ typeName _ <- reify conName -- TyConI (DataD _ _ _ cons _) <- reify typeName -- [fields] <- return [fields | RecC name fields <- cons, name == conName] -- return [fieldName | (fieldName, _, _) <- fields] -- --docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp --docToExp env hr scope (DocForall list idents inside) = do -- let list' = derefToExp scope list -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- mh <- [|F.mapM_|] -- inside' <- docsToExp env hr scope' inside -- let lam = LamE [pat] inside' -- return $ mh `AppE` lam `AppE` list' --docToExp env hr scope (DocWith [] inside) = do -- inside' <- docsToExp env hr scope inside -- return $ inside' --docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do -- let deref' = derefToExp scope deref -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- inside' <- docToExp env hr scope' (DocWith dis inside) -- let lam = LamE [pat] inside' -- return $ lam `AppE` deref' --docToExp env hr scope (DocMaybe val idents inside mno) = do -- let val' = derefToExp scope val -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- inside' <- docsToExp env hr scope' inside -- let inside'' = LamE [pat] inside' -- ninside' <- case mno of -- Nothing -> [|Nothing|] -- Just no -> do -- no' <- docsToExp env hr scope no -- j <- [|Just|] -- return $ j `AppE` no' -- mh <- [|maybeH|] -- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside' --docToExp env hr scope (DocCond conds final) = do -- conds' <- mapM go conds -- final' <- case final of -- Nothing -> [|Nothing|] -- Just f -> do -- f' <- docsToExp env hr scope f -- j <- [|Just|] -- return $ j `AppE` f' -- ch <- [|condH|] -- return $ ch `AppE` ListE conds' `AppE` final' -- where -- go :: (Deref, [Doc]) -> Q Exp -- go (d, docs) = do -- let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d -- docs' <- docsToExp env hr scope docs -- return $ TupE [d', docs'] --docToExp env hr scope (DocCase deref cases) = do -- let exp_ = derefToExp scope deref -- matches <- mapM toMatch cases -- return $ CaseE exp_ matches -- where -- readMay s = -- case reads s of -- (x, ""):_ -> Just x -- _ -> Nothing -- toMatch :: (Binding, [Doc]) -> Q Match -- toMatch (idents, inside) = do -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- insideExp <- docsToExp env hr scope' inside -- return $ Match pat (NormalB insideExp) [] --docToExp env hr v (DocContent c) = contentToExp env hr v c -- --contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp --contentToExp _ hr _ (ContentRaw s) = do -- os <- [|preEscapedText . pack|] -- let s' = LitE $ StringL s -- return $ hrFromHtml hr `AppE` (os `AppE` s') --contentToExp _ hr scope (ContentVar d) = do -- str <- [|toHtml|] -- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d) --contentToExp env hr scope (ContentUrl hasParams d) = -- case urlRender env of -- Nothing -> error "URL interpolation used, but no URL renderer provided" -- Just wrender -> wrender $ \render -> do -- let render' = return render -- ou <- if hasParams -- then [|\(u, p) -> $(render') u p|] -- else [|\u -> $(render') u []|] -- let d' = derefToExp scope d -- pet <- [|toHtml|] -- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d')) --contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d --contentToExp env hr scope (ContentMsg d) = -- case msgRender env of -- Nothing -> error "Message interpolation used, but no message renderer provided" -- Just wrender -> wrender $ \render -> -- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d) --contentToExp _ hr scope (ContentAttrs d) = do -- html <- [|attrsToHtml . toAttributes|] -- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d) -- --shamlet :: QuasiQuoter --shamlet = hamletWithSettings htmlRules defaultHamletSettings -- --xshamlet :: QuasiQuoter --xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings -- --htmlRules :: Q HamletRules --htmlRules = do -- i <- [|id|] -- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b) -- --hamlet :: QuasiQuoter --hamlet = hamletWithSettings hamletRules defaultHamletSettings -- --xhamlet :: QuasiQuoter --xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings ++{- + -- 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|] -- let ur f = do -- r <- newName "_render" -- let env = Env -- { urlRender = Just ($ (VarE r)) -- , msgRender = Nothing -- } -- h <- f env -- return $ LamE [VarP r] h -- return $ HamletRules i ur em -- where -- em (Env (Just urender) Nothing) e = do -- asHtmlUrl' <- [|asHtmlUrl|] -- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur') -- em _ _ = error "bad Env" -- --ihamlet :: QuasiQuoter --ihamlet = hamletWithSettings ihamletRules defaultHamletSettings -- --ihamletRules :: Q HamletRules --ihamletRules = do -- i <- [|id|] -- let ur f = do -- u <- newName "_urender" -- m <- newName "_mrender" -- let env = Env -- { urlRender = Just ($ (VarE u)) -- , msgRender = Just ($ (VarE m)) -- } -- h <- f env -- return $ LamE [VarP m, VarP u] h -- return $ HamletRules i ur em -- where -- em (Env (Just urender) (Just mrender)) e = -- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur') -- em _ _ = error "bad Env" -- --hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter --hamletWithSettings hr set = -- QuasiQuoter -- { quoteExp = hamletFromString hr set -- } -- --data HamletRules = HamletRules -- { hrFromHtml :: Exp -- , hrWithEnv :: (Env -> Q Exp) -> Q Exp -- , hrEmbed :: Env -> Exp -> Q Exp -- } -- --data Env = Env -- { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp) -- , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp) -- } -- --hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp --hamletFromString qhr set s = do -- hr <- qhr -- case parseDoc set s of -- Error s' -> error s' -- Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d -- --hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp --hamletFileWithSettings qhr set fp = do --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp -- hamletFromString qhr set contents -- --hamletFile :: FilePath -> Q Exp --hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings -- --xhamletFile :: FilePath -> Q Exp --xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings -- --shamletFile :: FilePath -> Q Exp --shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings -- --xshamletFile :: FilePath -> Q Exp --xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings -- --ihamletFile :: FilePath -> Q Exp --ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings -- --varName :: Scope -> String -> Exp --varName _ "" = error "Illegal empty varName" --varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope -- --strToExp :: String -> Exp --strToExp s@(c:_) -- | all isDigit s = LitE $ IntegerL $ read s -- | isUpper c = ConE $ mkName s -- | otherwise = VarE $ mkName s --strToExp "" = error "strToExp on empty string" ++{- + hamletRules :: Q HamletRules + hamletRules = do + i <- [|id|] +@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp + hamletFromString qhr set s = do + hr <- qhr + hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s ++-} + + docFromString :: HamletSettings -> String -> [Doc] + docFromString set s = +@@ -367,6 +333,7 @@ docFromString set s = + Error s' -> error s' + Ok (_, d) -> d + ++{- + hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp + hamletFileWithSettings qhr set fp = do + #ifdef GHC_7_4 +@@ -408,6 +375,7 @@ strToExp s@(c:_) + | isUpper c = ConE $ mkName s + | otherwise = VarE $ mkName s + strToExp "" = error "strToExp on empty string" ++-} -- | Checks for truth in the left value in each pair in the first argument. If -- a true exists, then the corresponding right action is performed. Only the +@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings = + data HamletRuntimeRules = HamletRuntimeRules { + hrrI18n :: Bool + } +- ++{- + hamletFileReloadWithSettings :: HamletRuntimeRules + -> HamletSettings -> FilePath -> Q Exp + hamletFileReloadWithSettings hrr settings fp = do +@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do + c VTUrlParam = [|EUrlParam|] + c VTMixin = [|\r -> EMixin $ \c -> r c|] + c VTMsg = [|EMsg|] +- ++-} + -- move to Shakespeare.Base? + readFileUtf8 :: FilePath -> IO String + readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp +diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs +index b7e2954..1f14946 100644 +--- a/Text/Hamlet/Parse.hs ++++ b/Text/Hamlet/Parse.hs +@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines + | DefaultNewlineStyle + deriving Show + ++{- + instance Lift NewlineStyle where + lift NoNewlines = [|NoNewlines|] + lift NewlinesText = [|NewlinesText|] +@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where + + instance Lift HamletSettings where + lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|] +- ++-} + + htmlEmptyTags :: Set String + htmlEmptyTags = Set.fromAscList -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch index 81e370146..60600a375 100644 --- a/standalone/no-th/haskell-patches/lens_no-TH.patch +++ b/standalone/no-th/haskell-patches/lens_no-TH.patch @@ -1,20 +1,21 @@ -From b9b3cd52735f9ede1a83960968dc1f0e91e061d6 Mon Sep 17 00:00:00 2001 +From 66fdbc0cb69036b61552a3bce7e995ea2a7f76c1 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Fri, 7 Feb 2014 21:49:11 +0000 -Subject: [PATCH] avoid TH +Date: Fri, 7 Mar 2014 05:43:33 +0000 +Subject: [PATCH] TH --- - lens.cabal | 14 +------------- - src/Control/Lens.hs | 6 ++---- - src/Control/Lens/Cons.hs | 2 -- - src/Control/Lens/Internal/Fold.hs | 2 -- - src/Control/Lens/Internal/Reflection.hs | 2 -- - src/Control/Lens/Prism.hs | 2 -- - src/Control/Monad/Primitive/Lens.hs | 1 - - 7 files changed, 3 insertions(+), 26 deletions(-) + lens.cabal | 19 +------------------ + src/Control/Lens.hs | 8 ++------ + src/Control/Lens/Cons.hs | 2 -- + src/Control/Lens/Internal/Fold.hs | 2 -- + src/Control/Lens/Internal/Reflection.hs | 2 -- + src/Control/Lens/Operators.hs | 2 +- + src/Control/Lens/Prism.hs | 2 -- + src/Control/Monad/Primitive/Lens.hs | 1 - + 8 files changed, 4 insertions(+), 34 deletions(-) diff --git a/lens.cabal b/lens.cabal -index cee2da7..1e467c4 100644 +index 790a9d7..7cd3ff9 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional @@ -26,7 +27,15 @@ index cee2da7..1e467c4 100644 -- build-tools: cpphs tested-with: GHC == 7.6.3 synopsis: Lenses, Folds and Traversals -@@ -216,7 +216,6 @@ library +@@ -177,7 +177,6 @@ flag lib-Werror + + library + build-depends: +- aeson >= 0.7 && < 0.8, + array >= 0.3.0.2 && < 0.6, + base >= 4.3 && < 5, + bifunctors >= 4 && < 5, +@@ -216,7 +215,6 @@ library Control.Exception.Lens Control.Lens Control.Lens.Action @@ -34,7 +43,12 @@ index cee2da7..1e467c4 100644 Control.Lens.Combinators Control.Lens.Cons Control.Lens.Each -@@ -256,17 +255,14 @@ library +@@ -251,22 +249,18 @@ library + Control.Lens.Level + Control.Lens.Loupe + Control.Lens.Operators +- Control.Lens.Plated + Control.Lens.Prism Control.Lens.Reified Control.Lens.Review Control.Lens.Setter @@ -52,7 +66,7 @@ index cee2da7..1e467c4 100644 Data.Array.Lens Data.Bits.Lens Data.ByteString.Lens -@@ -289,12 +285,8 @@ library +@@ -289,17 +283,10 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens @@ -64,8 +78,13 @@ index cee2da7..1e467c4 100644 - Language.Haskell.TH.Lens Numeric.Lens - other-modules: -@@ -394,7 +386,6 @@ test-suite doctests +- other-modules: +- Control.Lens.Internal.TupleIxedTH +- + if flag(safe) + cpp-options: -DSAFE=1 + +@@ -396,7 +383,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, @@ -73,7 +92,7 @@ index cee2da7..1e467c4 100644 mtl, nats, parallel, -@@ -432,7 +423,6 @@ benchmark plated +@@ -434,7 +420,6 @@ benchmark plated comonad, criterion, deepseq, @@ -81,7 +100,7 @@ index cee2da7..1e467c4 100644 lens, transformers -@@ -467,7 +457,6 @@ benchmark unsafe +@@ -469,7 +454,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, @@ -89,7 +108,7 @@ index cee2da7..1e467c4 100644 lens, transformers -@@ -484,6 +473,5 @@ benchmark zipper +@@ -486,6 +470,5 @@ benchmark zipper comonads-fd, criterion, deepseq, @@ -97,7 +116,7 @@ index cee2da7..1e467c4 100644 lens, transformers diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs -index 7e15267..bb4d87b 100644 +index 7e15267..433f1fc 100644 --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs @@ -41,7 +41,6 @@ @@ -108,7 +127,12 @@ index 7e15267..bb4d87b 100644 , module Control.Lens.Cons , module Control.Lens.Each , module Control.Lens.Empty -@@ -58,7 +57,7 @@ module Control.Lens +@@ -53,12 +52,11 @@ module Control.Lens + , module Control.Lens.Lens + , module Control.Lens.Level + , module Control.Lens.Loupe +- , module Control.Lens.Plated + , module Control.Lens.Prism , module Control.Lens.Reified , module Control.Lens.Review , module Control.Lens.Setter @@ -117,7 +141,7 @@ index 7e15267..bb4d87b 100644 , module Control.Lens.TH #endif , module Control.Lens.Traversal -@@ -69,7 +68,6 @@ module Control.Lens +@@ -69,7 +67,6 @@ module Control.Lens ) where import Control.Lens.Action @@ -125,7 +149,12 @@ index 7e15267..bb4d87b 100644 import Control.Lens.Cons import Control.Lens.Each import Control.Lens.Empty -@@ -86,7 +84,7 @@ import Control.Lens.Prism +@@ -81,12 +78,11 @@ import Control.Lens.Iso + import Control.Lens.Lens + import Control.Lens.Level + import Control.Lens.Loupe +-import Control.Lens.Plated + import Control.Lens.Prism import Control.Lens.Reified import Control.Lens.Review import Control.Lens.Setter @@ -148,7 +177,7 @@ index a80e9c8..7d27b80 100644 -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs -index 00e4b66..03c9cd2 100644 +index ab09c6b..43aa905 100644 --- a/src/Control/Lens/Internal/Fold.hs +++ b/src/Control/Lens/Internal/Fold.hs @@ -37,8 +37,6 @@ import Data.Maybe @@ -173,6 +202,19 @@ index bf09f2c..c9e112f 100644 class Typeable s => B s where reflectByte :: proxy s -> IntPtr +diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs +index 3e14c55..989eb92 100644 +--- a/src/Control/Lens/Operators.hs ++++ b/src/Control/Lens/Operators.hs +@@ -110,7 +110,7 @@ module Control.Lens.Operators + , (<#~) + , (<#=) + -- * "Control.Lens.Plated" +- , (...) ++ --, (...) + -- * "Control.Lens.Review" + , ( # ) + -- * "Control.Lens.Setter" diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs index 9e0bec7..0cf6737 100644 --- a/src/Control/Lens/Prism.hs @@ -199,5 +241,5 @@ index ee942c6..2f37134 100644 prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) prim = iso internal primitive -- -1.7.10.4 +1.9.0 diff --git a/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch index 78cf7be35..c24fa5aa2 100644 --- a/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch +++ b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch @@ -1,150 +1,27 @@ -From 08aa9d495cb486c45998dfad95518c646b5fa8cc Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 17 Dec 2013 16:24:31 +0000 -Subject: [PATCH] remove TH +From 8e78a25ce0cc19e52d063f66bd4cd316462393d4 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 6 Mar 2014 23:27:06 +0000 +Subject: [PATCH] disable th --- - Control/Monad/Logger.hs | 109 ++++++++++-------------------------------------- - 1 file changed, 21 insertions(+), 88 deletions(-) + monad-logger.cabal | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) -diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs -index be756d7..d4979f8 100644 ---- a/Control/Monad/Logger.hs -+++ b/Control/Monad/Logger.hs -@@ -31,31 +31,31 @@ module Control.Monad.Logger - , withChannelLogger - , NoLoggingT (..) - -- * TH logging -- , logDebug -- , logInfo -- , logWarn -- , logError -- , logOther -+ --, logDebug -+ --, logInfo -+ --, logWarn -+ --, logError -+ --, logOther - -- * TH logging with source -- , logDebugS -- , logInfoS -- , logWarnS -- , logErrorS -- , logOtherS -+ --, logDebugS -+ --, logInfoS -+ --, logWarnS -+ --, logErrorS -+ --, logOtherS - -- * TH util -- , liftLoc -+ -- , liftLoc - -- * Non-TH logging -- , logDebugN -- , logInfoN -- , logWarnN -- , logErrorN -- , logOtherN -+ --, logDebugN -+ --, logInfoN -+ --, logWarnN -+ --, logErrorN -+ --, logOtherN - -- * Non-TH logging with source -- , logDebugNS -- , logInfoNS -- , logWarnNS -- , logErrorNS -- , logOtherNS -+ --, logDebugNS -+ --, logInfoNS -+ --, logWarnNS -+ --, logErrorNS -+ --, logOtherNS - ) where +diff --git a/monad-logger.cabal b/monad-logger.cabal +index b0aa271..cd56c0f 100644 +--- a/monad-logger.cabal ++++ b/monad-logger.cabal +@@ -14,8 +14,8 @@ cabal-version: >=1.8 - import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation) -@@ -115,13 +115,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) ) - data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text - deriving (Eq, Prelude.Show, Prelude.Read, Ord) + flag template_haskell { + Description: Enable Template Haskell support +- Default: True +- Manual: True ++ Default: False ++ Manual: False + } --instance Lift LogLevel where -- lift LevelDebug = [|LevelDebug|] -- lift LevelInfo = [|LevelInfo|] -- lift LevelWarn = [|LevelWarn|] -- lift LevelError = [|LevelError|] -- lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|] -- - type LogSource = Text - - class Monad m => MonadLogger m where -@@ -152,66 +145,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF - instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF - #undef DEF - --logTH :: LogLevel -> Q Exp --logTH level = -- [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) . (id :: Text -> Text)|] -- ---- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage: ---- ---- > $(logDebug) "This is a debug log message" --logDebug :: Q Exp --logDebug = logTH LevelDebug -- ---- | See 'logDebug' --logInfo :: Q Exp --logInfo = logTH LevelInfo ---- | See 'logDebug' --logWarn :: Q Exp --logWarn = logTH LevelWarn ---- | See 'logDebug' --logError :: Q Exp --logError = logTH LevelError -- ---- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage: ---- ---- > $(logOther "My new level") "This is a log message" --logOther :: Text -> Q Exp --logOther = logTH . LevelOther -- ---- | Lift a location into an Exp. ---- ---- Since 0.3.1 --liftLoc :: Loc -> Q Exp --liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc -- $(lift a) -- $(lift b) -- $(lift c) -- ($(lift d1), $(lift d2)) -- ($(lift e1), $(lift e2)) -- |] -- ---- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage: ---- ---- > $logDebugS "SomeSource" "This is a debug log message" --logDebugS :: Q Exp --logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|] -- ---- | See 'logDebugS' --logInfoS :: Q Exp --logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|] ---- | See 'logDebugS' --logWarnS :: Q Exp --logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|] ---- | See 'logDebugS' --logErrorS :: Q Exp --logErrorS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelError (b :: Text)|] -- ---- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage: ---- ---- > $logOtherS "SomeSource" "My new level" "This is a log message" --logOtherS :: Q Exp --logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|] -- - -- | Monad transformer that disables logging. - -- - -- Since 0.2.4 + library -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/reflection_remove-TH.patch b/standalone/no-th/haskell-patches/reflection_remove-TH.patch index 7c63f05fc..4f8b4bc20 100644 --- a/standalone/no-th/haskell-patches/reflection_remove-TH.patch +++ b/standalone/no-th/haskell-patches/reflection_remove-TH.patch @@ -1,17 +1,17 @@ -From 22c68b43dce437b3c22956f5a968f1b886e60e0c Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 17 Dec 2013 19:15:16 +0000 +From c0f5dcfd6ba7a05bb84b6adc4664c8dde109e6ac Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Fri, 7 Mar 2014 04:30:22 +0000 Subject: [PATCH] remove TH --- - fast/Data/Reflection.hs | 80 +------------------------------------------------ - 1 file changed, 1 insertion(+), 79 deletions(-) + fast/Data/Reflection.hs | 8 +++++--- + 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs -index 119d773..cf99efa 100644 +index ca57d35..d3f8356 100644 --- a/fast/Data/Reflection.hs +++ b/fast/Data/Reflection.hs -@@ -58,7 +58,7 @@ module Data.Reflection +@@ -59,7 +59,7 @@ module Data.Reflection , Given(..) , give -- * Template Haskell reflection @@ -20,94 +20,40 @@ index 119d773..cf99efa 100644 -- * Useful compile time naturals , Z, D, SD, PD ) where -@@ -151,87 +151,9 @@ instance Reifies n Int => Reifies (PD n) Int where - reflect = (\n -> n + n - 1) <$> retagPD reflect - {-# INLINE reflect #-} - ---- | This can be used to generate a template haskell splice for a type level version of a given 'int'. ---- ---- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used ---- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan. --int :: Int -> TypeQ --int n = case quotRem n 2 of -- (0, 0) -> conT ''Z -- (q,-1) -> conT ''PD `appT` int q -- (q, 0) -> conT ''D `appT` int q -- (q, 1) -> conT ''SD `appT` int q -- _ -> error "ghc is bad at math" -- ---- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate ---- a negative number results in a compile time error. Also the resulting sequence will consist entirely of ---- Z, D, and SD constructors representing the number in zeroless binary. --nat :: Int -> TypeQ --nat n -- | n >= 0 = int n -- | otherwise = error "nat: negative" -- --#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704 --instance Show (Q a) --instance Eq (Q a) --#endif --instance Num a => Num (Q a) where -- (+) = liftM2 (+) -- (*) = liftM2 (*) -- (-) = liftM2 (-) -- negate = fmap negate -- abs = fmap abs -- signum = fmap signum -- fromInteger = return . fromInteger +@@ -161,6 +161,7 @@ instance Reifies n Int => Reifies (PD n) Int where + -- instead of @$(int 3)@. Sometimes the two will produce the same + -- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor + -- directive). ++{- + int :: Int -> TypeQ + int n = case quotRem n 2 of + (0, 0) -> conT ''Z +@@ -176,7 +177,7 @@ nat :: Int -> TypeQ + nat n + | n >= 0 = int n + | otherwise = error "nat: negative" - --instance Fractional a => Fractional (Q a) where -- (/) = liftM2 (/) -- recip = fmap recip -- fromRational = return . fromRational -- ---- | This permits the use of $(5) as a type splice. --instance Num Type where --#ifdef USE_TYPE_LITS -- a + b = AppT (AppT (VarT ''(+)) a) b -- a * b = AppT (AppT (VarT ''(*)) a) b --#if MIN_VERSION_base(4,8,0) -- a - b = AppT (AppT (VarT ''(-)) a) b --#else -- (-) = error "Type.(-): undefined" --#endif -- fromInteger = LitT . NumTyLit --#else -- (+) = error "Type.(+): undefined" -- (*) = error "Type.(*): undefined" -- (-) = error "Type.(-): undefined" -- fromInteger n = case quotRem n 2 of -- (0, 0) -> ConT ''Z -- (q,-1) -> ConT ''PD `AppT` fromInteger q -- (q, 0) -> ConT ''D `AppT` fromInteger q -- (q, 1) -> ConT ''SD `AppT` fromInteger q -- _ -> error "ghc is bad at math" --#endif -- abs = error "Type.abs" -- signum = error "Type.signum" -- - plus, times, minus :: Num a => a -> a -> a - plus = (+) - times = (*) - minus = (-) - fract :: Fractional a => a -> a -> a - fract = (/) -- ---- | This permits the use of $(5) as an expression splice. --instance Num Exp where -- a + b = AppE (AppE (VarE 'plus) a) b -- a * b = AppE (AppE (VarE 'times) a) b -- a - b = AppE (AppE (VarE 'minus) a) b -- negate = AppE (VarE 'negate) -- signum = AppE (VarE 'signum) -- abs = AppE (VarE 'abs) -- fromInteger = LitE . IntegerL ++-} + #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704 + instance Show (Q a) + instance Eq (Q a) +@@ -195,6 +196,7 @@ instance Fractional a => Fractional (Q a) where + recip = fmap recip + fromRational = return . fromRational + ++{- + -- | This permits the use of $(5) as a type splice. + instance Num Type where + #ifdef USE_TYPE_LITS +@@ -254,7 +256,7 @@ instance Num Exp where + abs = onProxyType1 abs + signum = onProxyType1 signum + fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n) - --instance Fractional Exp where -- a / b = AppE (AppE (VarE 'fract) a) b -- recip = AppE (VarE 'recip) -- fromRational = LitE . RationalL ++-} + #ifdef USE_TYPE_LITS + addProxy :: Proxy a -> Proxy b -> Proxy (a + b) + addProxy _ _ = Proxy -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch deleted file mode 100644 index 51443b5d4..000000000 --- a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 4a75a2f0d77168aa3115b991284a5120484e18f0 Mon Sep 17 00:00:00 2001 -From: foo <foo@bar> -Date: Sun, 22 Sep 2013 04:59:21 +0000 -Subject: [PATCH] TH exports - ---- - Text/Shakespeare.hs | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index 9eb06a2..1290ab1 100644 ---- a/Text/Shakespeare.hs -+++ b/Text/Shakespeare.hs -@@ -23,6 +23,9 @@ module Text.Shakespeare - , Deref - , Parser - -+ -- used by TH -+ , pack' -+ - #ifdef TEST_EXPORT - , preFilter - #endif --- -1.7.10.4 - diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-th.patch index 38c2cb012..024ec2e20 100644 --- a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch +++ b/standalone/no-th/haskell-patches/shakespeare_remove-th.patch @@ -1,39 +1,44 @@ -From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001 +From 753f8ce37e096a343f1dd02a696a287bc91c24a0 Mon Sep 17 00:00:00 2001 From: Joey Hess <joey@kitenet.net> -Date: Tue, 17 Dec 2013 06:17:26 +0000 -Subject: [PATCH 2/2] remove TH +Date: Thu, 6 Mar 2014 22:34:03 +0000 +Subject: [PATCH] remove TH --- - Text/Shakespeare.hs | 131 +++-------------------------------------------- - Text/Shakespeare/Base.hs | 28 ---------- - 2 files changed, 6 insertions(+), 153 deletions(-) + Text/Shakespeare.hs | 73 ++++++++++-------------------------------------- + Text/Shakespeare/Base.hs | 28 ------------------- + 2 files changed, 14 insertions(+), 87 deletions(-) diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index f908ff4..55cd1d1 100644 +index 68e344f..aef741c 100644 --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs -@@ -12,14 +12,14 @@ module Text.Shakespeare +@@ -14,17 +14,20 @@ module Text.Shakespeare , WrapInsertion (..) , PreConversion (..) , defaultShakespeareSettings - , shakespeare - , shakespeareFile - , shakespeareFileReload -+ --, shakespeare -+ --, shakespeareFile ++ -- , shakespeare ++ -- , shakespeareFile + -- , shakespeareFileReload -- * low-level - , shakespeareFromString - , shakespeareUsedIdentifiers + -- , shakespeareFromString -+ --, shakespeareUsedIdentifiers ++ -- , shakespeareUsedIdentifiers , RenderUrl -- , VarType -+ --, VarType + , VarType (..) , Deref , Parser -@@ -151,38 +151,6 @@ defaultShakespeareSettings = ShakespeareSettings { ++ -- used by TH ++ , pack' ++ + #ifdef TEST_EXPORT + , preFilter + #endif +@@ -154,38 +157,6 @@ defaultShakespeareSettings = ShakespeareSettings { , modifyFinalValue = Nothing } @@ -72,85 +77,46 @@ index f908ff4..55cd1d1 100644 type QueryParameters = [(TS.Text, TS.Text)] type RenderUrl url = (url -> QueryParameters -> TS.Text) -@@ -346,77 +314,12 @@ pack' = TS.pack +@@ -349,6 +320,7 @@ pack' = TS.pack {-# NOINLINE pack' #-} #endif --contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp --contentsToShakespeare rs a = do -- r <- newName "_render" -- c <- mapM (contentToBuilder r) a -- compiledTemplate <- case c of -- -- Make sure we convert this mempty using toBuilder to pin down the -- -- type appropriately -- [] -> fmap (AppE $ wrap rs) [|mempty|] -- [x] -> return x -- _ -> do -- mc <- [|mconcat|] -- return $ mc `AppE` ListE c -- fmap (maybe id AppE $ modifyFinalValue rs) $ -- if justVarInterpolation rs -- then return compiledTemplate -- else return $ LamE [VarP r] compiledTemplate -- where -- contentToBuilder :: Name -> Content -> Q Exp -- contentToBuilder _ (ContentRaw s') = do -- ts <- [|fromText . pack'|] -- return $ wrap rs `AppE` (ts `AppE` LitE (StringL s')) -- contentToBuilder _ (ContentVar d) = -- return $ (toBuilder rs `AppE` derefToExp [] d) -- contentToBuilder r (ContentUrl d) = do -- ts <- [|fromText|] -- return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE [])) -- contentToBuilder r (ContentUrlParam d) = do -- ts <- [|fromText|] -- up <- [|\r' (u, p) -> r' u p|] -- return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d)) -- contentToBuilder r (ContentMix d) = -- return $ derefToExp [] d `AppE` VarE r -- --shakespeare :: ShakespeareSettings -> QuasiQuoter --shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r } -- --shakespeareFromString :: ShakespeareSettings -> String -> Q Exp --shakespeareFromString r str = do -- s <- qRunIO $ preFilter Nothing r $ --#ifdef WINDOWS -- filter (/='\r') --#endif -- str -- contentsToShakespeare r $ contentFromString r s -- --shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp --shakespeareFile r fp = do --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- readFileQ fp >>= shakespeareFromString r -- --data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin -- --getVars :: Content -> [(Deref, VarType)] --getVars ContentRaw{} = [] --getVars (ContentVar d) = [(d, VTPlain)] --getVars (ContentUrl d) = [(d, VTUrl)] --getVars (ContentUrlParam d) = [(d, VTUrlParam)] --getVars (ContentMix d) = [(d, VTMixin)] ++{- + contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp + contentsToShakespeare rs a = do + r <- newName "_render" +@@ -400,16 +372,19 @@ shakespeareFile r fp = + qAddDependentFile fp >> + #endif + readFileQ fp >>= shakespeareFromString r ++-} + + data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + ++{- + getVars :: Content -> [(Deref, VarType)] + getVars ContentRaw{} = [] + getVars (ContentVar d) = [(d, VTPlain)] + getVars (ContentUrl d) = [(d, VTUrl)] + getVars (ContentUrlParam d) = [(d, VTUrlParam)] + getVars (ContentMix d) = [(d, VTMixin)] ++-} data VarExp url = EPlain Builder | EUrl url - | EUrlParam (url, [(TS.Text, TS.Text)]) - | EMixin (Shakespeare url) +@@ -418,8 +393,10 @@ data VarExp url = EPlain Builder + + -- | Determine which identifiers are used by the given template, useful for + -- creating systems like yesod devel. ++{- + shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)] + shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings ++-} ---- | Determine which identifiers are used by the given template, useful for ---- creating systems like yesod devel. --shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)] --shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings -- type MTime = UTCTime - {-# NOINLINE reloadMapRef #-} -@@ -432,28 +335,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] +@@ -436,28 +413,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef (\reloadMap -> (M.insert fp (mt, content) reloadMap, content)) @@ -180,7 +146,7 @@ index f908ff4..55cd1d1 100644 diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs -index 9573533..49f1995 100644 +index a0e983c..23b4692 100644 --- a/Text/Shakespeare/Base.hs +++ b/Text/Shakespeare/Base.hs @@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident @@ -219,5 +185,5 @@ index 9573533..49f1995 100644 derefParens = between (char '(') (char ')') parseDeref derefCurlyBrackets = between (char '{') (char '}') parseDeref -- -1.8.5.1 +1.9.0 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 adf0679ea..5609fb459 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,19 @@ -From 5f30a68faaa379ac3fe9f0b016dd1a20969d548f Mon Sep 17 00:00:00 2001 +From be8d5895522da0397fd594d5553ed7d3641eb399 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Fri, 7 Feb 2014 23:04:06 +0000 +Date: Fri, 7 Mar 2014 01:40:29 +0000 Subject: [PATCH] remove and expand TH +fix Loc from MonadLogger --- - Yesod/Core.hs | 30 +++--- - Yesod/Core/Class/Yesod.hs | 248 ++++++++++++++++++++++++++++++-------------- - Yesod/Core/Dispatch.hs | 37 ++----- - Yesod/Core/Handler.hs | 25 ++--- - Yesod/Core/Internal/Run.hs | 4 +- - Yesod/Core/Internal/TH.hs | 111 -------------------- - Yesod/Core/Widget.hs | 32 +----- - 7 files changed, 209 insertions(+), 278 deletions(-) + Yesod/Core.hs | 30 +++--- + Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++--------------- + Yesod/Core/Dispatch.hs | 37 ++----- + Yesod/Core/Handler.hs | 25 ++--- + Yesod/Core/Internal/Run.hs | 8 +- + Yesod/Core/Internal/TH.hs | 111 -------------------- + Yesod/Core/Types.hs | 3 +- + Yesod/Core/Widget.hs | 32 +----- + 8 files changed, 215 insertions(+), 288 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 12e59d5..2817a69 100644 @@ -67,10 +69,10 @@ index 12e59d5..2817a69 100644 , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs -index 140600b..6c718e2 100644 +index 140600b..75daabc 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 @@ -87,7 +89,23 @@ index 140600b..6c718e2 100644 import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) -@@ -94,18 +98,27 @@ class RenderRoute site => Yesod site where + 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 qualified Data.ByteString.Char8 as S8 + 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) +-import Language.Haskell.TH.Syntax (Loc (..)) + import Network.HTTP.Types (encodePath) + import qualified Network.Wai as W + import Data.Default (def) +@@ -94,18 +97,27 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage @@ -127,7 +145,7 @@ index 140600b..6c718e2 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 -@@ -374,45 +387,103 @@ widgetToPageContent w = do +@@ -374,45 +386,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 @@ -270,7 +288,7 @@ index 140600b..6c718e2 100644 return $ PageContent title headAll $ case jsLoader master of -@@ -442,10 +513,13 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" @@ -288,7 +306,7 @@ index 140600b..6c718e2 100644 provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. -@@ -455,10 +529,11 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" @@ -304,7 +322,7 @@ index 140600b..6c718e2 100644 provideRep $ do -- 401 *MUST* include a WWW-Authenticate header -@@ -480,10 +555,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do +@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -322,7 +340,7 @@ index 140600b..6c718e2 100644 provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) -@@ -492,30 +570,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do +@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" @@ -380,6 +398,16 @@ index 140600b..6c718e2 100644 provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text) +@@ -682,8 +771,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 +-fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++ +- ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc) +- where +- line = show . fst . loc_start +- char = show . snd . loc_start ++fileLocationToString loc = "unknown" diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs index e6f489d..3ff37c1 100644 --- a/Yesod/Core/Dispatch.hs @@ -506,18 +534,29 @@ index 7c561c5..847d475 100644 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs -index 10871a2..6ed631e 100644 +index 10871a2..e8d1907 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs -@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) +@@ -15,8 +15,8 @@ import qualified Control.Exception as E + import Control.Exception.Lifted (catch) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) - import Control.Monad.Logger (LogLevel (LevelError), LogSource, +-import Control.Monad.Logger (LogLevel (LevelError), LogSource, - liftLoc) ++import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource, + ) import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 +@@ -30,7 +30,7 @@ import qualified Data.Text as T + import Data.Text.Encoding (encodeUtf8) + import Data.Text.Encoding (decodeUtf8With) + import Data.Text.Encoding.Error (lenientDecode) +-import Language.Haskell.TH.Syntax (Loc, qLocation) ++import Language.Haskell.TH.Syntax (qLocation) + import qualified Network.HTTP.Types as H + import Network.Wai + #if MIN_VERSION_wai(2, 0, 0) @@ -131,8 +131,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp @@ -646,6 +685,27 @@ index 7e84c1c..a273c29 100644 - [innerFun] - ] - return $ LetE [fun] (VarE helper) +diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs +index de09f78..9183a64 100644 +--- a/Yesod/Core/Types.hs ++++ b/Yesod/Core/Types.hs +@@ -17,6 +17,7 @@ import Control.Exception (Exception) + import Control.Monad (liftM, ap) + import Control.Monad.Base (MonadBase (liftBase)) + import Control.Monad.IO.Class (MonadIO (liftIO)) ++import qualified Control.Monad.Logger + import Control.Monad.Logger (LogLevel, LogSource, + MonadLogger (..)) + import Control.Monad.Trans.Control (MonadBaseControl (..)) +@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv + , rheRoute :: !(Maybe (Route site)) + , rheSite :: !site + , rheUpload :: !(RequestBodyLength -> FileUpload) +- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ()) ++ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + , rheOnError :: !(ErrorResponse -> YesodApp) + -- ^ How to respond when an error is thrown internally. + -- diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs index a972efa..156cd45 100644 --- a/Yesod/Core/Widget.hs @@ -707,5 +767,5 @@ index a972efa..156cd45 100644 ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -1.7.10.4 +1.9.0 diff --git a/standalone/no-th/haskell-patches/yesod-static_hack.patch b/standalone/no-th/haskell-patches/yesod-static_hack.patch index 678b8439b..4cf977bae 100644 --- a/standalone/no-th/haskell-patches/yesod-static_hack.patch +++ b/standalone/no-th/haskell-patches/yesod-static_hack.patch @@ -1,17 +1,17 @@ -From 4ea1e94794b59ba4eb0dab7384c4195a224f468d Mon Sep 17 00:00:00 2001 -From: androidbuilder <androidbuilder@example.com> -Date: Fri, 27 Dec 2013 00:28:51 -0400 +From 885cc873196f535de7cd1ac2ccfa217d10308d1f Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Fri, 7 Mar 2014 02:28:34 +0000 Subject: [PATCH] avoid building with jsmin jsmin needs language-javascript, which fails to build for android due to a problem or incompatability with happy. This also avoids all the TH code. - --- - Yesod/EmbeddedStatic/Generators.hs | 3 +-- - yesod-static.cabal | 7 ------- - 2 files changed, 1 insertion(+), 9 deletions(-) + Yesod/EmbeddedStatic/Generators.hs | 3 +-- + Yesod/Static.hs | 29 ++++++++++++++++++----------- + yesod-static.cabal | 7 ------- + 3 files changed, 19 insertions(+), 20 deletions(-) diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs index e83785d..6b1c10e 100644 @@ -34,8 +34,132 @@ index e83785d..6b1c10e 100644 -- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript. -- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@ +diff --git a/Yesod/Static.hs b/Yesod/Static.hs +index dd21791..37f7e00 100644 +--- a/Yesod/Static.hs ++++ b/Yesod/Static.hs +@@ -37,8 +37,8 @@ module Yesod.Static + , staticDevel + -- * Combining CSS/JS + -- $combining +- , combineStylesheets' +- , combineScripts' ++ --, combineStylesheets' ++ --, combineScripts' + -- ** Settings + , CombineSettings + , csStaticDir +@@ -48,13 +48,13 @@ module Yesod.Static + , csJsPreProcess + , csCombinedFolder + -- * Template Haskell helpers +- , staticFiles +- , staticFilesList +- , publicFiles ++ --, staticFiles ++ --, staticFilesList ++ --, publicFiles + -- * Hashing + , base64md5 + -- * Embed +- , embed ++ --, embed + #ifdef TEST_EXPORT + , getFileListPieces + #endif +@@ -64,7 +64,7 @@ import Prelude hiding (FilePath) + import qualified Prelude + import System.Directory + import Control.Monad +-import Data.FileEmbed (embedDir) ++import Data.FileEmbed + + import Yesod.Core + import Yesod.Core.Types +@@ -135,6 +135,7 @@ staticDevel dir = do + hashLookup <- cachedETagLookupDevel dir + return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup + ++{- + -- | Produce a 'Static' based on embedding all of the static files' contents in the + -- executable at compile time. + -- +@@ -149,6 +150,7 @@ staticDevel dir = do + -- This will cause yesod to embed those assets into the generated HTML file itself. + embed :: Prelude.FilePath -> Q Exp + embed fp = [|Static (embeddedSettings $(embedDir fp))|] ++-} + + instance RenderRoute Static where + -- | A route on the static subsite (see also 'staticFiles'). +@@ -214,6 +216,7 @@ getFileListPieces = flip evalStateT M.empty . flip go id + put $ M.insert s s m + return s + ++{- + -- | Template Haskell function that automatically creates routes + -- for all of your static files. + -- +@@ -266,7 +269,7 @@ staticFilesList dir fs = + -- see if their copy is up-to-date. + publicFiles :: Prelude.FilePath -> Q [Dec] + publicFiles dir = mkStaticFiles' dir "StaticRoute" False +- ++-} + + mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString) + mkHashMap dir = do +@@ -309,6 +312,7 @@ cachedETagLookup dir = do + etags <- mkHashMap dir + return $ (\f -> return $ M.lookup f etags) + ++{- + mkStaticFiles :: Prelude.FilePath -> Q [Dec] + mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True + +@@ -356,6 +360,7 @@ mkStaticFilesList fp fs routeConName makeHash = do + [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) [] + ] + ] ++-} + + base64md5File :: Prelude.FilePath -> IO String + base64md5File = fmap (base64 . encode) . hashFile +@@ -394,7 +399,7 @@ base64 = map tr + -- single static file at compile time. + + data CombineType = JS | CSS +- ++{- + combineStatics' :: CombineType + -> CombineSettings + -> [Route Static] -- ^ files to combine +@@ -428,7 +433,7 @@ combineStatics' combineType CombineSettings {..} routes = do + case combineType of + JS -> "js" + CSS -> "css" +- ++-} + -- | Data type for holding all settings for combining files. + -- + -- This data type is a settings type. For more information, see: +@@ -504,6 +509,7 @@ instance Default CombineSettings where + errorIntro :: [FilePath] -> [Char] -> [Char] + errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s + ++{- + liftRoutes :: [Route Static] -> Q Exp + liftRoutes = + fmap ListE . mapM go +@@ -550,4 +556,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining + -> Q Exp + combineScripts' development cs con routes + | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |] +- | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |] ++ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a ++-} diff --git a/yesod-static.cabal b/yesod-static.cabal -index df05ecf..31abe1a 100644 +index 3423149..416aae6 100644 --- a/yesod-static.cabal +++ b/yesod-static.cabal @@ -48,18 +48,12 @@ library @@ -66,5 +190,5 @@ index df05ecf..31abe1a 100644 , filepath , resourcet -- -1.7.10.4 +1.9.0 diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch index 4ee8aa5bb..b8991b86e 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 69398345ff1e63bcc6a23fce18e42390328b78d2 Mon Sep 17 00:00:00 2001 +From 369c99b9de0c82578f5221fdabc42ea9ba59ddea Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 17 Dec 2013 18:48:56 +0000 -Subject: [PATCH] hack for TH +Date: Fri, 7 Mar 2014 04:10:02 +0000 +Subject: [PATCH] hack to TH --- - Yesod.hs | 19 ++++++++++++-- - Yesod/Default/Main.hs | 23 ----------------- - Yesod/Default/Util.hs | 69 ++----------------------------------------------- - 3 files changed, 19 insertions(+), 92 deletions(-) + Yesod.hs | 19 ++++++++++++-- + Yesod/Default/Main.hs | 25 +------------------ + Yesod/Default/Util.hs | 69 ++------------------------------------------------- + 3 files changed, 20 insertions(+), 93 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 0780539..2c73800 100644 +index 0780539..ad99ccd 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@ @@ -55,6 +55,15 @@ index 0780539..2c73800 100644 , defaultRunner , defaultDevelApp , LogFunc +@@ -22,7 +20,7 @@ import Control.Monad (when) + import System.Environment (getEnvironment) + import Data.Maybe (fromMaybe) + import Safe (readMay) +-import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) ++import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError)) + import System.Log.FastLogger (LogStr, toLogStr) + import Language.Haskell.TH.Syntax (qLocation) + @@ -54,27 +52,6 @@ defaultMain load getApp = do type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () @@ -180,5 +189,5 @@ index a10358e..0547424 100644 - else return $ Just ex - else return Nothing -- -1.7.10.4 +1.9.0 |