allow building webapp with EvilSplicer for non-android arm

Was able to reuse many of the android patches, but several had to be
re-done. On Android, ghc is a stage2 build, so can compile, but not run TH
code. But debian's ghc on armel cannot even compile TH code, so it has
to be patched out.

Some haskell packages have been updated to new versions, including yesod
and DAV, and their patches had to be redone.

The Makefile now has 2 new targets. The first is run on a companion x86
system to do the build and get TH splices. Then the second target is run
the same source tree on the arm system to build without needing TH.

This commit was sponsored by Svenne Krap.
This commit is contained in:
Joey Hess 2013-12-18 21:41:17 +00:00
parent 0027cef395
commit ccef06da41
37 changed files with 4494 additions and 1095 deletions

View file

@ -1,385 +0,0 @@
From 41706061810410cc38f602ccc9a4c9560502251f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Sat, 19 Oct 2013 01:44:52 +0000
Subject: [PATCH] hackity
---
lens.cabal | 12 +-----------
src/Control/Exception/Lens.hs | 2 +-
src/Control/Lens.hs | 6 +++---
src/Control/Lens/Equality.hs | 4 ++--
src/Control/Lens/Fold.hs | 6 +++---
src/Control/Lens/Internal.hs | 2 +-
src/Control/Lens/Internal/Exception.hs | 26 +-------------------------
src/Control/Lens/Internal/Instances.hs | 14 --------------
src/Control/Lens/Internal/Zipper.hs | 2 +-
src/Control/Lens/Iso.hs | 2 --
src/Control/Lens/Lens.hs | 2 +-
src/Control/Lens/Operators.hs | 2 +-
src/Control/Lens/Plated.hs | 2 +-
src/Control/Lens/Prism.hs | 2 --
src/Control/Lens/Setter.hs | 2 --
src/Control/Lens/TH.hs | 2 +-
src/Data/Data/Lens.hs | 6 +++---
17 files changed, 20 insertions(+), 74 deletions(-)
diff --git a/lens.cabal b/lens.cabal
index b25adf4..3e5c30c 100644
--- a/lens.cabal
+++ b/lens.cabal
@@ -10,7 +10,7 @@ stability: provisional
homepage: http://github.com/ekmett/lens/
bug-reports: http://github.com/ekmett/lens/issues
copyright: Copyright (C) 2012-2013 Edward A. Kmett
-build-type: Custom
+build-type: Simple
tested-with: GHC == 7.6.3
synopsis: Lenses, Folds and Traversals
description:
@@ -235,14 +235,12 @@ library
Control.Lens.Review
Control.Lens.Setter
Control.Lens.Simple
- Control.Lens.TH
Control.Lens.Traversal
Control.Lens.Tuple
Control.Lens.Type
Control.Lens.Wrapped
Control.Lens.Zipper
Control.Lens.Zoom
- Control.Monad.Error.Lens
Control.Parallel.Strategies.Lens
Control.Seq.Lens
Data.Array.Lens
@@ -266,12 +264,8 @@ library
Data.Typeable.Lens
Data.Vector.Lens
Data.Vector.Generic.Lens
- Generics.Deriving.Lens
- GHC.Generics.Lens
System.Exit.Lens
System.FilePath.Lens
- System.IO.Error.Lens
- Language.Haskell.TH.Lens
Numeric.Lens
if flag(safe)
@@ -370,7 +364,6 @@ test-suite doctests
deepseq,
doctest >= 0.9.1,
filepath,
- generic-deriving,
mtl,
nats,
parallel,
@@ -396,7 +389,6 @@ benchmark plated
comonad,
criterion,
deepseq,
- generic-deriving,
lens,
transformers
@@ -431,7 +423,6 @@ benchmark unsafe
comonads-fd,
criterion,
deepseq,
- generic-deriving,
lens,
transformers
@@ -448,6 +439,5 @@ benchmark zipper
comonads-fd,
criterion,
deepseq,
- generic-deriving,
lens,
transformers
diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs
index 0619335..c97ad9b 100644
--- a/src/Control/Exception/Lens.hs
+++ b/src/Control/Exception/Lens.hs
@@ -112,7 +112,7 @@ import Prelude
, Maybe(..), Either(..), Functor(..), String, IO
)
-{-# ANN module "HLint: ignore Use Control.Exception.catch" #-}
+
-- $setup
-- >>> :set -XNoOverloadedStrings
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
index 242c3c1..2ab9cdb 100644
--- a/src/Control/Lens.hs
+++ b/src/Control/Lens.hs
@@ -59,7 +59,7 @@ module Control.Lens
, module Control.Lens.Review
, module Control.Lens.Setter
, module Control.Lens.Simple
-#ifndef DISABLE_TEMPLATE_HASKELL
+#if 0
, module Control.Lens.TH
#endif
, module Control.Lens.Traversal
@@ -89,7 +89,7 @@ import Control.Lens.Reified
import Control.Lens.Review
import Control.Lens.Setter
import Control.Lens.Simple
-#ifndef DISABLE_TEMPLATE_HASKELL
+#if 0
import Control.Lens.TH
#endif
import Control.Lens.Traversal
@@ -99,4 +99,4 @@ import Control.Lens.Wrapped
import Control.Lens.Zipper
import Control.Lens.Zoom
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+
diff --git a/src/Control/Lens/Equality.hs b/src/Control/Lens/Equality.hs
index 982c2d7..3a3fe1a 100644
--- a/src/Control/Lens/Equality.hs
+++ b/src/Control/Lens/Equality.hs
@@ -28,8 +28,8 @@ module Control.Lens.Equality
import Control.Lens.Internal.Setter
import Control.Lens.Type
-{-# ANN module "HLint: ignore Use id" #-}
-{-# ANN module "HLint: ignore Eta reduce" #-}
+
+
-- $setup
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs
index 32a4073..cc7da1e 100644
--- a/src/Control/Lens/Fold.hs
+++ b/src/Control/Lens/Fold.hs
@@ -163,9 +163,9 @@ import Data.Traversable
-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
-- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force
-{-# ANN module "HLint: ignore Eta reduce" #-}
-{-# ANN module "HLint: ignore Use camelCase" #-}
-{-# ANN module "HLint: ignore Use curry" #-}
+
+
+
infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?!
diff --git a/src/Control/Lens/Internal.hs b/src/Control/Lens/Internal.hs
index 295662e..539642d 100644
--- a/src/Control/Lens/Internal.hs
+++ b/src/Control/Lens/Internal.hs
@@ -43,4 +43,4 @@ import Control.Lens.Internal.Review
import Control.Lens.Internal.Setter
import Control.Lens.Internal.Zoom
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+
diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs
index 387203e..8bea89b 100644
--- a/src/Control/Lens/Internal/Exception.hs
+++ b/src/Control/Lens/Internal/Exception.hs
@@ -36,6 +36,7 @@ import Data.Monoid
import Data.Proxy
import Data.Reflection
import Data.Typeable
+import Data.Typeable
import System.IO.Unsafe
------------------------------------------------------------------------------
@@ -128,18 +129,6 @@ class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where
handler_ l = handler l . const
{-# INLINE handler_ #-}
-instance Handleable SomeException IO Exception.Handler where
- handler = handlerIO
-
-instance Handleable SomeException m (CatchIO.Handler m) where
- handler = handlerCatchIO
-
-handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r
-handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a)
-
-handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r
-handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a)
-
------------------------------------------------------------------------------
-- Helpers
------------------------------------------------------------------------------
@@ -159,21 +148,8 @@ supply = unsafePerformIO $ newIORef 0
-- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does.
newtype Handling a s (m :: * -> *) = Handling a
--- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap.
--- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep.
-instance Typeable (Handling a s m) where
- typeOf _ = unsafePerformIO $ do
- i <- atomicModifyIORef supply $ \a -> let a' = a + 1 in a' `seq` (a', a)
- return $ mkTyConApp (mkTyCon3 "lens" "Control.Lens.Internal.Exception" ("Handling" ++ show i)) []
- {-# INLINE typeOf #-}
-
-- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here.
instance Show (Handling a s m) where
showsPrec d _ = showParen (d > 10) $ showString "Handling ..."
{-# INLINE showsPrec #-}
-instance Reifies s (SomeException -> Maybe a) => Exception (Handling a s m) where
- toException _ = SomeException HandlingException
- {-# INLINE toException #-}
- fromException = fmap Handling . reflect (Proxy :: Proxy s)
- {-# INLINE fromException #-}
diff --git a/src/Control/Lens/Internal/Instances.hs b/src/Control/Lens/Internal/Instances.hs
index 6783f33..17715ce 100644
--- a/src/Control/Lens/Internal/Instances.hs
+++ b/src/Control/Lens/Internal/Instances.hs
@@ -24,26 +24,12 @@ import Data.Traversable
-- Orphan Instances
-------------------------------------------------------------------------------
-instance Foldable ((,) b) where
- foldMap f (_, a) = f a
-
instance Foldable1 ((,) b) where
foldMap1 f (_, a) = f a
-instance Traversable ((,) b) where
- traverse f (b, a) = (,) b <$> f a
-
instance Traversable1 ((,) b) where
traverse1 f (b, a) = (,) b <$> f a
-instance Foldable (Either a) where
- foldMap _ (Left _) = mempty
- foldMap f (Right a) = f a
-
-instance Traversable (Either a) where
- traverse _ (Left b) = pure (Left b)
- traverse f (Right a) = Right <$> f a
-
instance Foldable (Const m) where
foldMap _ _ = mempty
diff --git a/src/Control/Lens/Internal/Zipper.hs b/src/Control/Lens/Internal/Zipper.hs
index 95875b7..76060be 100644
--- a/src/Control/Lens/Internal/Zipper.hs
+++ b/src/Control/Lens/Internal/Zipper.hs
@@ -53,7 +53,7 @@ import Data.Profunctor.Unsafe
-- >>> import Control.Lens
-- >>> import Data.Char
-{-# ANN module "HLint: ignore Use foldl" #-}
+
------------------------------------------------------------------------------
-- * Jacket
diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs
index 1152af4..80c3175 100644
--- a/src/Control/Lens/Iso.hs
+++ b/src/Control/Lens/Iso.hs
@@ -82,8 +82,6 @@ import Data.Maybe
import Data.Profunctor
import Data.Profunctor.Unsafe
-{-# ANN module "HLint: ignore Use on" #-}
-
-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs
index b26cc06..6f84943 100644
--- a/src/Control/Lens/Lens.hs
+++ b/src/Control/Lens/Lens.hs
@@ -126,7 +126,7 @@ import Data.Profunctor.Rep
import Data.Profunctor.Unsafe
import Data.Void
-{-# ANN module "HLint: ignore Use ***" #-}
+
-- $setup
-- >>> :set -XNoOverloadedStrings
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
index 11868e0..475c945 100644
--- a/src/Control/Lens/Operators.hs
+++ b/src/Control/Lens/Operators.hs
@@ -108,4 +108,4 @@ import Control.Lens.Review
import Control.Lens.Setter
import Control.Lens.Zipper
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+
diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs
index a8c4d20..cef574e 100644
--- a/src/Control/Lens/Plated.hs
+++ b/src/Control/Lens/Plated.hs
@@ -95,7 +95,7 @@ import Data.Data.Lens
import Data.Monoid
import Data.Tree
-{-# ANN module "HLint: ignore Reduce duplication" #-}
+
-- | A 'Plated' type is one where we know how to extract its immediate self-similar children.
--
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
index 45b5cfe..88c7ff9 100644
--- a/src/Control/Lens/Prism.hs
+++ b/src/Control/Lens/Prism.hs
@@ -53,8 +53,6 @@ import Unsafe.Coerce
import Data.Profunctor.Unsafe
#endif
-{-# ANN module "HLint: ignore Use camelCase" #-}
-
-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs
index 2acbfa6..4a12c6b 100644
--- a/src/Control/Lens/Setter.hs
+++ b/src/Control/Lens/Setter.hs
@@ -87,8 +87,6 @@ import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Unsafe
-{-# ANN module "HLint: ignore Avoid lambda" #-}
-
-- $setup
-- >>> import Control.Lens
-- >>> import Control.Monad.State
diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs
index a05eb07..49218b5 100644
--- a/src/Control/Lens/TH.hs
+++ b/src/Control/Lens/TH.hs
@@ -87,7 +87,7 @@ import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lens
-{-# ANN module "HLint: ignore Use foldl" #-}
+
-- | Flags for 'Lens' construction
data LensFlag
diff --git a/src/Data/Data/Lens.hs b/src/Data/Data/Lens.hs
index cf1e7c9..b39dacf 100644
--- a/src/Data/Data/Lens.hs
+++ b/src/Data/Data/Lens.hs
@@ -65,9 +65,9 @@ import Data.Monoid
import GHC.Exts (realWorld#)
#endif
-{-# ANN module "HLint: ignore Eta reduce" #-}
-{-# ANN module "HLint: ignore Use foldl" #-}
-{-# ANN module "HLint: ignore Reduce duplication" #-}
+
+
+
-- $setup
-- >>> :set -XNoOverloadedStrings
--
1.7.10.4

View file

@ -1,25 +0,0 @@
From 0b9df0de3aa45918a2a9226a2da6be4680276419 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 03:31:55 +0000
Subject: [PATCH] stub out
---
persistent-template.cabal | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/persistent-template.cabal b/persistent-template.cabal
index 8216ce7..f23234b 100644
--- a/persistent-template.cabal
+++ b/persistent-template.cabal
@@ -23,7 +23,7 @@ library
, containers
, aeson
, monad-logger
- exposed-modules: Database.Persist.TH
+ exposed-modules:
ghc-options: -Wall
if impl(ghc >= 7.4)
cpp-options: -DGHC_7_4
--
1.7.10.4

View file

@ -1,32 +0,0 @@
From 760fa2c5044ae38bee8114ff84c625ac59f35c6f Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 00:03:55 +0000
Subject: [PATCH] disable TH
---
Database/Persist/Sql/Raw.hs | 2 --
1 file changed, 2 deletions(-)
diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
index 73189dd..6efebea 100644
--- a/Database/Persist/Sql/Raw.hs
+++ b/Database/Persist/Sql/Raw.hs
@@ -22,7 +22,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m)
-> [PersistValue]
-> Source m [PersistValue]
rawQuery sql vals = do
- lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
conn <- lift askSqlConn
bracketP
(getStmtConn conn sql)
@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y
rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
rawExecuteCount sql vals = do
- $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
stmt <- getStmt sql
res <- liftIO $ stmtExecute stmt vals
liftIO $ stmtReset stmt
--
1.7.10.4

View file

@ -1,26 +0,0 @@
From 392602f5ff14c0b5a801397d075ddcbcd890aa83 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Apr 2013 17:50:59 -0400
Subject: [PATCH] fix cross build
---
src/Data/Profunctor/Unsafe.hs | 3 ---
1 file changed, 3 deletions(-)
diff --git a/src/Data/Profunctor/Unsafe.hs b/src/Data/Profunctor/Unsafe.hs
index 025c7c4..0249274 100644
--- a/src/Data/Profunctor/Unsafe.hs
+++ b/src/Data/Profunctor/Unsafe.hs
@@ -40,9 +40,6 @@ import Data.Tagged
import Prelude hiding (id,(.),sequence)
import Unsafe.Coerce
-{-# ANN module "Hlint: ignore Redundant lambda" #-}
-{-# ANN module "Hlint: ignore Collapse lambdas" #-}
-
infixr 9 #.
infixl 8 .#
--
1.8.2.rc3

View file

@ -1,148 +0,0 @@
From 05d0b6e6d2f84cd8ff53b8ee3e42021fa02fe8e4 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sat, 21 Sep 2013 23:21:52 +0000
Subject: [PATCH] remove TH
---
Text/Cassius.hs | 23 -----------------------
Text/CssCommon.hs | 4 ----
Text/Lucius.hs | 30 +-----------------------------
3 files changed, 1 insertion(+), 56 deletions(-)
diff --git a/Text/Cassius.hs b/Text/Cassius.hs
index ce05374..ae56b0a 100644
--- a/Text/Cassius.hs
+++ b/Text/Cassius.hs
@@ -13,10 +13,6 @@ module Text.Cassius
, renderCss
, renderCssUrl
-- * Parsing
- , cassius
- , cassiusFile
- , cassiusFileDebug
- , cassiusFileReload
-- * ToCss instances
-- ** Color
, Color (..)
@@ -27,11 +23,8 @@ module Text.Cassius
, AbsoluteUnit (..)
, AbsoluteSize (..)
, absoluteSize
- , EmSize (..)
- , ExSize (..)
, PercentageSize (..)
, percentageSize
- , PixelSize (..)
-- * Internal
, cassiusUsedIdentifiers
) where
@@ -42,25 +35,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import qualified Data.Text.Lazy as TL
import Text.CssCommon
-import Text.Lucius (lucius)
import qualified Text.Lucius
import Text.IndentToBrace (i2b)
-cassius :: QuasiQuoter
-cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }
-
-cassiusFile :: FilePath -> Q Exp
-cassiusFile fp = do
-#ifdef GHC_7_4
- qAddDependentFile fp
-#endif
- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
- quoteExp cassius contents
-
-cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp
-cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels
-cassiusFileReload = cassiusFileDebug
-
-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
diff --git a/Text/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 89328bd..0a1cf5e 100644
--- a/Text/Lucius.hs
+++ b/Text/Lucius.hs
@@ -8,12 +8,8 @@
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Lucius
( -- * Parsing
- lucius
- , luciusFile
- , luciusFileDebug
- , luciusFileReload
-- ** Mixins
- , luciusMixin
+ luciusMixin
, Mixin
-- ** Runtime
, luciusRT
@@ -40,11 +36,8 @@ module Text.Lucius
, AbsoluteUnit (..)
, AbsoluteSize (..)
, absoluteSize
- , EmSize (..)
- , ExSize (..)
, PercentageSize (..)
, percentageSize
- , PixelSize (..)
-- * Internal
, parseTopLevels
, luciusUsedIdentifiers
@@ -66,18 +59,6 @@ import Data.Monoid (mconcat)
import Data.List (isSuffixOf)
import Control.Arrow (second)
--- |
---
--- >>> renderCss ([lucius|foo{bar:baz}|] undefined)
--- "foo{bar:baz}"
-lucius :: QuasiQuoter
-lucius = QuasiQuoter { quoteExp = luciusFromString }
-
-luciusFromString :: String -> Q Exp
-luciusFromString s =
- topLevelsToCassius
- $ either (error . show) id $ parse parseTopLevels s s
-
whiteSpace :: Parser ()
whiteSpace = many whiteSpace1 >> return ()
@@ -217,15 +198,6 @@ parseComment = do
_ <- manyTill anyChar $ try $ string "*/"
return $ ContentRaw ""
-luciusFile :: FilePath -> Q Exp
-luciusFile fp = do
- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
- luciusFromString contents
-
-luciusFileDebug, luciusFileReload :: FilePath -> Q Exp
-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
-luciusFileReload = luciusFileDebug
-
parseTopLevels :: Parser [TopLevel Unresolved]
parseTopLevels =
go id
--
1.7.10.4

View file

@ -1,26 +0,0 @@
From 23e96f0d948e7a26febf1745a4c373faf579c8ee Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 15 Apr 2013 16:32:31 -0400
Subject: [PATCH] expose modules used by TH
---
shakespeare-css.cabal | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal
index de2497b..468353a 100644
--- a/shakespeare-css.cabal
+++ b/shakespeare-css.cabal
@@ -39,8 +39,8 @@ library
exposed-modules: Text.Cassius
Text.Lucius
- other-modules: Text.MkSizeType
Text.Css
+ other-modules: Text.MkSizeType
Text.IndentToBrace
Text.CssCommon
ghc-options: -Wall
--
1.8.2.rc3

View file

@ -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

View file

@ -1,54 +0,0 @@
From 432a8fc47bb11cf8fd0a832e033cfb94a6332dbe Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 07:29:39 +0000
Subject: [PATCH] deal with TH
Export modules referenced by it.
Should not need these icons in git-annex, so not worth using the Evil
Splicer.
---
Network/Wai/Application/Static.hs | 4 ----
wai-app-static.cabal | 2 +-
2 files changed, 1 insertion(+), 5 deletions(-)
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
index 3f07391..75709b7 100644
--- a/Network/Wai/Application/Static.hs
+++ b/Network/Wai/Application/Static.hs
@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
import Blaze.ByteString.Builder (toByteString)
-import Data.FileEmbed (embedFile)
-
import Data.Text (Text)
import qualified Data.Text as T
@@ -198,8 +196,6 @@ staticAppPieces _ _ req
H.status405
[("Content-Type", "text/plain")]
"Only GET is supported"
-staticAppPieces _ [".hidden", "folder.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]
-staticAppPieces _ [".hidden", "haskell.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]
staticAppPieces ss rawPieces req = liftIO $ do
case toPieces rawPieces of
Just pieces -> checkPieces ss pieces req >>= response
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
index ec22813..e944caa 100644
--- a/wai-app-static.cabal
+++ b/wai-app-static.cabal
@@ -56,9 +56,9 @@ library
WaiAppStatic.Storage.Embedded
WaiAppStatic.Listing
WaiAppStatic.Types
- other-modules: Util
WaiAppStatic.Storage.Embedded.Runtime
WaiAppStatic.Storage.Embedded.TH
+ other-modules: Util
ghc-options: -Wall
extensions: CPP
--
1.7.10.4

View file

@ -1,34 +0,0 @@
From 3eb7b0a42099721dc19363ac41319efeed4ac5f9 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 05:19:53 +0000
Subject: [PATCH] don't really build
---
yesod-auth.cabal | 11 +----------
1 file changed, 1 insertion(+), 10 deletions(-)
diff --git a/yesod-auth.cabal b/yesod-auth.cabal
index 591ced5..11217be 100644
--- a/yesod-auth.cabal
+++ b/yesod-auth.cabal
@@ -52,16 +52,7 @@ library
, safe
, time
- exposed-modules: Yesod.Auth
- Yesod.Auth.BrowserId
- Yesod.Auth.Dummy
- Yesod.Auth.Email
- Yesod.Auth.OpenId
- Yesod.Auth.Rpxnow
- Yesod.Auth.HashDB
- Yesod.Auth.Message
- Yesod.Auth.GoogleEmail
- other-modules: Yesod.Auth.Routes
+ exposed-modules:
ghc-options: -Wall
source-repository head
--
1.7.10.4

View file

@ -1,411 +0,0 @@
From 7583457fb410d07f480a2aa7d6c2f174324b3592 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Sat, 19 Oct 2013 02:03:18 +0000
Subject: [PATCH] hackity
---
Yesod/Core.hs | 2 -
Yesod/Core/Class/Yesod.hs | 247 ++++++++++++++++++++++++++++++--------------
Yesod/Core/Dispatch.hs | 7 --
Yesod/Core/Handler.hs | 24 ++---
Yesod/Core/Internal/Run.hs | 2 -
5 files changed, 179 insertions(+), 103 deletions(-)
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
index 12e59d5..f1ff21c 100644
--- a/Yesod/Core.hs
+++ b/Yesod/Core.hs
@@ -94,8 +94,6 @@ module Yesod.Core
, JavascriptUrl
, renderJavascriptUrl
-- ** Cassius/Lucius
- , cassius
- , lucius
, CssUrl
, renderCssUrl
) where
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
index cf02a1a..3f1e88e 100644
--- a/Yesod/Core/Class/Yesod.hs
+++ b/Yesod/Core/Class/Yesod.hs
@@ -9,6 +9,10 @@ import Yesod.Core.Content
import Yesod.Core.Handler
import Yesod.Routes.Class
+import qualified Text.Blaze.Internal
+import qualified Control.Monad.Logger
+import qualified Text.Hamlet
+import qualified Data.Foldable
import Blaze.ByteString.Builder (Builder)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
@@ -87,18 +91,27 @@ class RenderRoute site => Yesod site where
defaultLayout w = do
p <- widgetToPageContent w
mmsg <- getMessage
- giveUrlRenderer [hamlet|
- $newline never
- $doctype 5
- <html>
- <head>
- <title>#{pageTitle p}
- ^{pageHead p}
- <body>
- $maybe msg <- mmsg
- <p .message>#{msg}
- ^{pageBody p}
- |]
+ giveUrlRenderer $ \ _render_aHra
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<!DOCTYPE html>\n<html><head><title>");
+ id (TBH.toHtml (pageTitle p));
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</title>");
+ Text.Hamlet.asHtmlUrl (pageHead p) _render_aHra;
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</head><body>");
+ Text.Hamlet.maybeH
+ mmsg
+ (\ msg_aHrb
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<p class=\"message\">");
+ id (TBH.toHtml msg_aHrb);
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") })
+ Nothing;
+ Text.Hamlet.asHtmlUrl (pageBody p) _render_aHra;
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</body></html>") }
+
-- | 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
@@ -356,45 +369,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
- regularScriptLoad = [hamlet|
- $newline never
- $forall s <- scripts
- ^{mkScriptTag s}
- $maybe j <- jscript
- $maybe s <- jsLoc
- <script src="#{s}">
- $nothing
- <script>^{jelper j}
- |]
-
- headAll = [hamlet|
- $newline never
- \^{head'}
- $forall s <- stylesheets
- ^{mkLinkTag s}
- $forall s <- css
- $maybe t <- right $ snd s
- $maybe media <- fst s
- <link rel=stylesheet media=#{media} href=#{t}>
- $nothing
- <link rel=stylesheet href=#{t}>
- $maybe content <- left $ snd s
- $maybe media <- fst s
- <style media=#{media}>#{content}
- $nothing
- <style>#{content}
- $case jsLoader master
- $of BottomOfBody
- $of BottomOfHeadAsync asyncJsLoader
- ^{asyncJsLoader asyncScripts mcomplete}
- $of BottomOfHeadBlocking
- ^{regularScriptLoad}
- |]
- let bodyScript = [hamlet|
- $newline never
- ^{body}
- ^{regularScriptLoad}
- |]
+ regularScriptLoad = \ _render_aHsO
+ -> do { Data.Foldable.mapM_
+ (\ s_aHsP
+ -> Text.Hamlet.asHtmlUrl (mkScriptTag s_aHsP) _render_aHsO)
+ scripts;
+ Text.Hamlet.maybeH
+ jscript
+ (\ j_aHsQ
+ -> Text.Hamlet.maybeH
+ jsLoc
+ (\ s_aHsR
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<script src=\"");
+ id (TBH.toHtml s_aHsR);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\"></script>") })
+ (Just
+ (do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script>");
+ Text.Hamlet.asHtmlUrl (jelper j_aHsQ) _render_aHsO;
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</script>") })))
+ Nothing }
+
+
+ headAll = \ _render_aHsW
+ -> do { Text.Hamlet.asHtmlUrl head' _render_aHsW;
+ Data.Foldable.mapM_
+ (\ s_aHsX -> Text.Hamlet.asHtmlUrl (mkLinkTag s_aHsX) _render_aHsW)
+ stylesheets;
+ Data.Foldable.mapM_
+ (\ s_aHsY
+ -> do { Text.Hamlet.maybeH
+ (right (snd s_aHsY))
+ (\ t_aHsZ
+ -> Text.Hamlet.maybeH
+ (fst s_aHsY)
+ (\ media_aHt0
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<link rel=\"stylesheet\" media=\"");
+ id (TBH.toHtml media_aHt0);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\" href=\"");
+ id (TBH.toHtml t_aHsZ);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\">") })
+ (Just
+ (do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<link rel=\"stylesheet\" href=\"");
+ id (TBH.toHtml t_aHsZ);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\">") })))
+ Nothing;
+ Text.Hamlet.maybeH
+ (left (snd s_aHsY))
+ (\ content_aHt1
+ -> Text.Hamlet.maybeH
+ (fst s_aHsY)
+ (\ media_aHt2
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<style media=\"");
+ id (TBH.toHtml media_aHt2);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\">");
+ id (TBH.toHtml content_aHt1);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</style>") })
+ (Just
+ (do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<style>");
+ id (TBH.toHtml content_aHt1);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</style>") })))
+ Nothing })
+ css;
+ case jsLoader master of {
+ BottomOfBody -> return ()
+ ; BottomOfHeadAsync asyncJsLoader_aHt3
+ -> Text.Hamlet.asHtmlUrl
+ (asyncJsLoader_aHt3 asyncScripts mcomplete) _render_aHsW
+ ; BottomOfHeadBlocking
+ -> Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHsW } }
+
+ let bodyScript = \ _render_aHt8 -> do { Text.Hamlet.asHtmlUrl body _render_aHt8;
+ Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHt8 }
+
return $ PageContent title headAll $
case jsLoader master of
@@ -424,10 +495,13 @@ defaultErrorHandler NotFound = selectRep $ do
r <- waiRequest
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
setTitle "Not Found"
- toWidget [hamlet|
- <h1>Not Found
- <p>#{path'}
- |]
+ toWidget $ \ _render_aHte
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<h1>Not Found</h1>\n<p>");
+ id (TBH.toHtml path');
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }
+
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
-- For API requests.
@@ -437,10 +511,11 @@ defaultErrorHandler NotFound = selectRep $ do
defaultErrorHandler NotAuthenticated = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Not logged in"
- toWidget [hamlet|
- <h1>Not logged in
- <p style="display:none;">Set the authRoute and the user will be redirected there.
- |]
+ toWidget $ \ _render_aHti
+ -> id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<h1>Not logged in</h1>\n<p style=\"none;\">Set the authRoute and the user will be redirected there.</p>")
+
provideRep $ do
-- 401 *MUST* include a WWW-Authenticate header
@@ -462,10 +537,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Permission Denied"
- toWidget [hamlet|
- <h1>Permission denied
- <p>#{msg}
- |]
+ toWidget $ \ _render_aHtq
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<h1>Permission denied</h1>\n<p>");
+ id (TBH.toHtml msg);
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }
+
provideRep $
return $ object $ [
"message" .= ("Permission Denied. " <> msg)
@@ -474,30 +552,43 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Invalid Arguments"
- toWidget [hamlet|
- <h1>Invalid Arguments
- <ul>
- $forall msg <- ia
- <li>#{msg}
- |]
+ toWidget $ \ _render_aHtv
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<h1>Invalid Arguments</h1>\n<ul>");
+ Data.Foldable.mapM_
+ (\ msg_aHtw
+ -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "<li>");
+ id (TBH.toHtml msg_aHtw);
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</li>") })
+ ia;
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</ul>") }
+
provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia]
defaultErrorHandler (InternalError e) = do
- $logErrorS "yesod-core" e
selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Internal Server Error"
- toWidget [hamlet|
- <h1>Internal Server Error
- <pre>#{e}
- |]
+ toWidget $ \ _render_aHtC
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<h1>Internal Server Error</h1>\n<pre>");
+ id (TBH.toHtml e);
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</pre>") }
+
provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
defaultErrorHandler (BadMethod m) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle"Bad Method"
- toWidget [hamlet|
- <h1>Method Not Supported
- <p>Method <code>#{S8.unpack m}</code> not supported
- |]
+ toWidget $ \ _render_aHtH
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<h1>Method Not Supported</h1>\n<p>Method <code>");
+ id (TBH.toHtml (S8.unpack m));
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</code> not supported</p>") }
+
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= m]
asyncHelper :: (url -> [x] -> Text)
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
index 335a15c..4ca05da 100644
--- a/Yesod/Core/Dispatch.hs
+++ b/Yesod/Core/Dispatch.hs
@@ -123,13 +123,6 @@ toWaiApp site = do
, yreSite = site
, yreSessionBackend = sb
}
- messageLoggerSource
- site
- logger
- $(qLocation >>= liftLoc)
- "yesod-core"
- LevelInfo
- (toLogStr ("Application launched" :: S.ByteString))
middleware <- mkDefaultMiddlewares logger
return $ middleware $ toWaiAppYre yre
diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
index f3b1799..d819b04 100644
--- a/Yesod/Core/Handler.hs
+++ b/Yesod/Core/Handler.hs
@@ -152,7 +152,7 @@ import qualified Control.Monad.Trans.Writer as Writer
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Resource (MonadResource, liftResourceT)
-
+import qualified Text.Blaze.Internal
import qualified Network.HTTP.Types as H
import qualified Network.Wai as W
import Control.Monad.Trans.Class (lift)
@@ -710,19 +710,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
-> m a
redirectToPost url = do
urlText <- toTextUrl url
- giveUrlRenderer [hamlet|
-$newline never
-$doctype 5
-
-<html>
- <head>
- <title>Redirecting...
- <body onload="document.getElementById('form').submit()">
- <form id="form" method="post" action=#{urlText}>
- <noscript>
- <p>Javascript has been disabled; please click on the button below to be redirected.
- <input type="submit" value="Continue">
-|] >>= sendResponse
+ giveUrlRenderer $ \ _render_awps
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<!DOCTYPE html>\n<html><head><title>Redirecting...</title></head><body onload=\"document.getElementById('form').submit()\"><form id=\"form\" method=\"post\" action=\"");
+ id (toHtml urlText);
+ id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\"><noscript><p>Javascript has been disabled; please click on the button below to be redirected.</p></noscript><input type=\"submit\" value=\"Continue\"></form></body></html>") }
+ >>= sendResponse
-- | 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 35f1d3f..8b92e99 100644
--- a/Yesod/Core/Internal/Run.hs
+++ b/Yesod/Core/Internal/Run.hs
@@ -122,8 +122,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ErrorResponse
-> YesodApp
safeEh log' er req = do
- liftIO $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError
- $ toLogStr $ "Error handler errored out: " ++ show er
return $ YRPlain
H.status500
[]
--
1.7.10.4

File diff suppressed because it is too large Load diff

View file

@ -1,26 +0,0 @@
From 03819615edb1c5f7414768dae84234d6791bd758 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 04:11:46 +0000
Subject: [PATCH] do not really build
---
yesod-persistent.cabal | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
index 98c2146..11960cf 100644
--- a/yesod-persistent.cabal
+++ b/yesod-persistent.cabal
@@ -23,8 +23,7 @@ library
, lifted-base
, pool-conduit
, resourcet
- exposed-modules: Yesod.Persist
- Yesod.Persist.Core
+ exposed-modules:
ghc-options: -Wall
test-suite test
--
1.7.10.4

View file

@ -1,29 +0,0 @@
From f6bfe8e01d8fe6d129ad3819070aa17934094a0a Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 06:24:09 +0000
Subject: [PATCH] export module referenced by TH splices
---
yesod-routes.cabal | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/yesod-routes.cabal b/yesod-routes.cabal
index 0b245f2..a97582a 100644
--- a/yesod-routes.cabal
+++ b/yesod-routes.cabal
@@ -27,11 +27,11 @@ library
Yesod.Routes.Class
Yesod.Routes.Parse
Yesod.Routes.Overlap
+ Yesod.Routes.TH.Types
other-modules: Yesod.Routes.TH.Dispatch
Yesod.Routes.TH.RenderRoute
Yesod.Routes.TH.ParseRoute
Yesod.Routes.TH.RouteAttrs
- Yesod.Routes.TH.Types
ghc-options: -Wall
test-suite runtests
--
1.7.10.4

View file

@ -1,74 +0,0 @@
From 8bf7c428a42b984f63f435bb34f22743202ae449 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 05:24:19 +0000
Subject: [PATCH] hacked up for Android
---
Yesod.hs | 2 --
Yesod/Default/Util.hs | 17 -----------------
2 files changed, 19 deletions(-)
diff --git a/Yesod.hs b/Yesod.hs
index b367144..3050bf5 100644
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -5,9 +5,7 @@ module Yesod
( -- * Re-exports from yesod-core
module Yesod.Core
, module Yesod.Form
- , module Yesod.Persist
) where
import Yesod.Core
import Yesod.Form
-import Yesod.Persist
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
index a10358e..c5a4e58 100644
--- a/Yesod/Default/Util.hs
+++ b/Yesod/Default/Util.hs
@@ -8,7 +8,6 @@ module Yesod.Default.Util
, widgetFileNoReload
, widgetFileReload
, TemplateLanguage (..)
- , defaultTemplateLanguages
, WidgetFileSettings
, wfsLanguages
, wfsHamletSettings
@@ -20,9 +19,6 @@ import Yesod.Core -- purposely using complete import so that Haddock will see ad
import Control.Monad (when, unless)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Language.Haskell.TH.Syntax
-import Text.Lucius (luciusFile, luciusFileReload)
-import Text.Julius (juliusFile, juliusFileReload)
-import Text.Cassius (cassiusFile, cassiusFileReload)
import Text.Hamlet (HamletSettings, defaultHamletSettings)
import Data.Maybe (catMaybes)
import Data.Default (Default (def))
@@ -69,24 +65,11 @@ data TemplateLanguage = TemplateLanguage
, tlReload :: FilePath -> Q Exp
}
-defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
-defaultTemplateLanguages hset =
- [ TemplateLanguage False "hamlet" whamletFile' whamletFile'
- , TemplateLanguage True "cassius" cassiusFile cassiusFileReload
- , TemplateLanguage True "julius" juliusFile juliusFileReload
- , TemplateLanguage True "lucius" luciusFile luciusFileReload
- ]
- where
- whamletFile' = whamletFileWithSettings hset
-
data WidgetFileSettings = WidgetFileSettings
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
, wfsHamletSettings :: HamletSettings
}
-instance Default WidgetFileSettings where
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
-
widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs
--
1.7.10.4

View file

@ -1,41 +0,0 @@
From 7e815b11f242d6836f9615439e32f9937bf2feaf Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 13:59:34 +0000
Subject: [PATCH] hack around missing symbols
---
Yesod.hs | 17 +++++++++++++++++
1 file changed, 17 insertions(+)
diff --git a/Yesod.hs b/Yesod.hs
index 3050bf5..fbe309c 100644
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -5,7 +5,24 @@ module Yesod
( -- * Re-exports from yesod-core
module Yesod.Core
, module Yesod.Form
+ , insertBy
+ , replace
+ , deleteBy
+ , delete
+ , insert
+ , Key
) where
import Yesod.Core
import Yesod.Form
+
+-- These symbols are usually imported from persistent,
+-- But it is not built on Android. Still export them
+-- just so that hiding them will work.
+data Key = DummyKey
+insertBy = undefined
+replace = undefined
+deleteBy = undefined
+delete = undefined
+insert = undefined
+
--
1.7.10.4