mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

updating haskell patches, part 2

Browse source
This commit is contained in:
Joey Hess 2014-05-21 16:42:22 +00:00
parent 5dfc43915a
commit e1a17fee88
8 changed files with 303 additions and 258 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
standalone/no-th/haskell-patches/lens_no-TH.patch
View file

@ -1,10 +1,10 @@
From 66fdbc0cb69036b61552a3bce7e995ea2a7f76c1 Mon Sep 17 00:00:00 2001
From 2109923a879a02c8a79e8e08573bf9e500d8afc8 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 7 Mar 2014 05:43:33 +0000
Subject: [PATCH] TH
Date: Wed, 21 May 2014 16:25:06 +0000
Subject: [PATCH] remove TH
---
lens.cabal | 19 +------------------
lens.cabal | 20 +-------------------
src/Control/Lens.hs | 8 ++------
src/Control/Lens/Cons.hs | 2 --
src/Control/Lens/Internal/Fold.hs | 2 --
@ -12,10 +12,10 @@ Subject: [PATCH] TH
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(-)
8 files changed, 4 insertions(+), 35 deletions(-)
diff --git a/lens.cabal b/lens.cabal
index 790a9d7..7cd3ff9 100644
index 03f64f5..3f6f6d2 100644
--- a/lens.cabal
+++ b/lens.cabal
@@ -10,7 +10,7 @@ stability: provisional
@ -27,7 +27,7 @@ index 790a9d7..7cd3ff9 100644
-- build-tools: cpphs
tested-with: GHC == 7.6.3
synopsis: Lenses, Folds and Traversals
@@ -177,7 +177,6 @@ flag lib-Werror
@@ -182,7 +182,6 @@ flag j
library
build-depends:
@ -35,7 +35,7 @@ index 790a9d7..7cd3ff9 100644
array >= 0.3.0.2 && < 0.6,
base >= 4.3 && < 5,
bifunctors >= 4 && < 5,
@@ -216,7 +215,6 @@ library
@@ -221,7 +220,6 @@ library
Control.Exception.Lens
Control.Lens
Control.Lens.Action
@ -43,7 +43,14 @@ index 790a9d7..7cd3ff9 100644
Control.Lens.Combinators
Control.Lens.Cons
Control.Lens.Each
@@ -251,22 +249,18 @@ library
@@ -249,29 +247,24 @@ library
Control.Lens.Internal.Reflection
Control.Lens.Internal.Review
Control.Lens.Internal.Setter
- Control.Lens.Internal.TH
Control.Lens.Internal.Zoom
Control.Lens.Iso
Control.Lens.Lens
Control.Lens.Level
Control.Lens.Loupe
Control.Lens.Operators
@ -66,7 +73,7 @@ index 790a9d7..7cd3ff9 100644
Data.Array.Lens
Data.Bits.Lens
Data.ByteString.Lens
@@ -289,17 +283,10 @@ library
@@ -294,17 +287,10 @@ library
Data.Typeable.Lens
Data.Vector.Lens
Data.Vector.Generic.Lens
@ -81,10 +88,10 @@ index 790a9d7..7cd3ff9 100644
- other-modules:
- Control.Lens.Internal.TupleIxedTH
-
if flag(safe)
cpp-options: -DSAFE=1
cpp-options: -traditional
@@ -396,7 +383,6 @@ test-suite doctests
if flag(safe)
@@ -406,7 +392,6 @@ test-suite doctests
deepseq,
doctest >= 0.9.1,
filepath,
@ -92,7 +99,7 @@ index 790a9d7..7cd3ff9 100644
mtl,
nats,
parallel,
@@ -434,7 +420,6 @@ benchmark plated
@@ -444,7 +429,6 @@ benchmark plated
comonad,
criterion,
deepseq,
@ -100,7 +107,7 @@ index 790a9d7..7cd3ff9 100644
lens,
transformers
@@ -469,7 +454,6 @@ benchmark unsafe
@@ -479,7 +463,6 @@ benchmark unsafe
comonads-fd,
criterion,
deepseq,
@ -108,7 +115,7 @@ index 790a9d7..7cd3ff9 100644
lens,
transformers
@@ -486,6 +470,5 @@ benchmark zipper
@@ -496,6 +479,5 @@ benchmark zipper
comonads-fd,
criterion,
deepseq,
@ -203,10 +210,10 @@ index bf09f2c..c9e112f 100644
reflectByte :: proxy s -> IntPtr
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
index 3e14c55..989eb92 100644
index 9992e63..631e8e6 100644
--- a/src/Control/Lens/Operators.hs
+++ b/src/Control/Lens/Operators.hs
@@ -110,7 +110,7 @@ module Control.Lens.Operators
@@ -111,7 +111,7 @@ module Control.Lens.Operators
, (<#~)
, (<#=)
-- * "Control.Lens.Plated"
@ -241,5 +248,5 @@ index ee942c6..2f37134 100644
prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
prim = iso internal primitive
--
1.9.0
2.0.0.rc2

26
standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch
View file

@ -1,24 +1,24 @@
From c9f40fae5f7f44c7c28b243bf924606ef4f26700 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 18 Dec 2013 04:17:59 +0000
Subject: [PATCH] avoid TH
From 7e85a025349877565a70c375ef55508f215eaaf8 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Wed, 21 May 2014 04:23:49 +0000
Subject: [PATCH] remove TH
---
process-conduit.cabal | 1 -
1 file changed, 1 deletion(-)
diff --git a/process-conduit.cabal b/process-conduit.cabal
index c917d90..4410e2c 100644
index e6988e0..a2e03e0 100644
--- a/process-conduit.cabal
+++ b/process-conduit.cabal
@@ -24,7 +24,6 @@ source-repository head
library
exposed-modules: Data.Conduit.Process
- System.Process.QQ
build-depends: base == 4.*
, template-haskell >= 2.4
library
exposed-modules: Data.Conduit.Process
- System.Process.QQ
build-depends: base == 4.*
, template-haskell >= 2.4
--
1.8.5.1
2.0.0.rc2

23
standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch
View file

@ -1,19 +1,19 @@
From 3eb7b0a42099721dc19363ac41319efeed4ac5f9 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 05:19:53 +0000
From 9a8637661270d3c6a15e6aeca5e8983fe126bd27 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Wed, 21 May 2014 05:27:36 +0000
Subject: [PATCH] don't really build
---
yesod-auth.cabal | 11 +----------
1 file changed, 1 insertion(+), 10 deletions(-)
yesod-auth.cabal | 10 ----------
1 file changed, 10 deletions(-)
diff --git a/yesod-auth.cabal b/yesod-auth.cabal
index 591ced5..11217be 100644
index 0872581..723cde0 100644
--- a/yesod-auth.cabal
+++ b/yesod-auth.cabal
@@ -52,16 +52,7 @@ library
, safe
, time
@@ -60,16 +60,6 @@ library
, byteable
, binary
- exposed-modules: Yesod.Auth
- Yesod.Auth.BrowserId
@ -21,14 +21,13 @@ index 591ced5..11217be 100644
- 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:
- Yesod.PasswordStore
ghc-options: -Wall
source-repository head
--
1.7.10.4
2.0.0.rc2

23
standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
View file

@ -1,9 +1,8 @@
From 8dd61c7ea1b852957c74dc264004a6f7d70044a9 Mon Sep 17 00:00:00 2001
From ccea70b3cb02c3a9e7fa43ebfbfcfdda76f9307f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Tue, 20 May 2014 21:39:04 +0000
Subject: [PATCH] remove and expand TH
Date: Wed, 21 May 2014 03:51:16 +0000
Subject: [PATCH] expand and remove TH
fix Loc from MonadLogger
---
Yesod/Core.hs | 30 +++---
Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++---------------
@ -485,7 +484,7 @@ index 59663a8..9408a95 100644
-- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It
-- reads port information from the PORT environment variable, as used by tools
diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
index e5cbc44..d583607 100644
index e5cbc44..db7c097 100644
--- a/Yesod/Core/Handler.hs
+++ b/Yesod/Core/Handler.hs
@@ -169,7 +169,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
@ -497,14 +496,14 @@ index e5cbc44..d583607 100644
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
@@ -550,6 +550,7 @@ sendFilePart ct fp off count = do
#else
handlerError $ HCSendFile ct fp $ Just $ W.FilePart off count
#endif
@@ -198,6 +198,7 @@ import Control.Exception (throwIO)
import Blaze.ByteString.Builder (Builder)
import Safe (headMay)
import Data.CaseInsensitive (CI)
+import qualified Text.Blaze.Internal
-- | Bypass remaining handler code and output the given content with a 200
-- status code.
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
#if MIN_VERSION_wai(2, 0, 0)
#else
@@ -806,19 +807,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
-> m a
redirectToPost url = do

322
standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
View file

@ -1,19 +1,19 @@
From 9f62992414f900fcafa00a838925e24c4365c50f Mon Sep 17 00:00:00 2001
From 38834f94992679d8c4d936fec12eb32b82073553 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 7 Feb 2014 23:11:31 +0000
Date: Wed, 21 May 2014 05:23:19 +0000
Subject: [PATCH] splice TH
---
Yesod/Form/Fields.hs | 771 +++++++++++++++++++++++++++++++++++------------
Yesod/Form/Functions.hs | 239 ++++++++++++---
Yesod/Form/Jquery.hs | 129 ++++++--
Yesod/Form/MassInput.hs | 233 +++++++++++---
Yesod/Form/Nic.hs | 65 +++-
yesod-form.cabal | 1 +
6 files changed, 1127 insertions(+), 311 deletions(-)
Yesod/Form/Fields.hs | 738 +++++++++++++++++++++++++++++++++---------------
Yesod/Form/Functions.hs | 289 +++++++++++++------
Yesod/Form/Jquery.hs | 129 +++++++--
Yesod/Form/MassInput.hs | 233 ++++++++++++---
Yesod/Form/Nic.hs | 65 ++++-
yesod-form.cabal | 1 -
6 files changed, 1054 insertions(+), 401 deletions(-)
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
index 97d0034..016c98b 100644
index cd67820..46b5d96 100644
--- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs
@@ -1,4 +1,3 @@
@ -21,7 +21,17 @@ index 97d0034..016c98b 100644
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -36,15 +35,11 @@ module Yesod.Form.Fields
@@ -18,9 +17,6 @@ module Yesod.Form.Fields
, timeField
, htmlField
, emailField
- , multiEmailField
- , searchField
- , AutoFocus
, urlField
, doubleField
, parseDate
@@ -37,15 +33,11 @@ module Yesod.Form.Fields
, selectFieldList
, radioField
, radioFieldList
@ -37,8 +47,8 @@ index 97d0034..016c98b 100644
, optionsPairs
, optionsEnum
) where
@@ -70,6 +65,15 @@ import Text.HTML.SanitizeXSS (sanitizeBalance)
import Control.Monad (when, unless)
@@ -72,6 +64,15 @@ import Control.Monad (when, unless)
import Data.Either (partitionEithers)
import Data.Maybe (listToMaybe, fromMaybe)
+import qualified Text.Blaze as Text.Blaze.Internal
@ -53,11 +63,11 @@ index 97d0034..016c98b 100644
import qualified Blaze.ByteString.Builder.Html.Utf8 as B
import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
@@ -82,14 +86,12 @@ import Data.Text (Text, unpack, pack)
@@ -84,15 +85,12 @@ import Data.Text as T (Text, concat, intercalate, unpack, pack, splitOn)
import qualified Data.Text.Read
import qualified Data.Map as Map
-import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery, YesodDB)
-import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery)
import Control.Arrow ((&&&))
import Control.Applicative ((<$>), (<|>))
@ -65,10 +75,11 @@ index 97d0034..016c98b 100644
import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly)
-import Yesod.Persist.Core
-
defaultFormMessage :: FormMessage -> Text
defaultFormMessage = englishFormMessage
@@ -102,10 +104,24 @@ intField = Field
@@ -104,10 +102,24 @@ intField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s
@ -97,7 +108,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
where
@@ -119,10 +135,24 @@ doubleField = Field
@@ -121,10 +133,24 @@ doubleField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidNumber s
@ -126,7 +137,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
@@ -130,10 +160,24 @@ $newline never
@@ -132,10 +158,24 @@ $newline never
dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day
dayField = Field
{ fieldParse = parseHelper $ parseDate . unpack
@ -155,7 +166,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
@@ -141,10 +185,23 @@ $newline never
@@ -143,10 +183,23 @@ $newline never
timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay
timeField = Field
{ fieldParse = parseHelper parseTime
@ -183,7 +194,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
where
@@ -157,10 +214,18 @@ $newline never
@@ -159,10 +212,18 @@ $newline never
htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html
htmlField = Field
{ fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
@ -206,16 +217,16 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . renderHtml)
@@ -169,8 +234,6 @@ $newline never
@@ -171,8 +232,6 @@ $newline never
-- br-tags.
newtype Textarea = Textarea { unTextarea :: Text }
deriving (Show, Read, Eq, PersistField, Ord)
deriving (Show, Read, Eq, PersistField, Ord, ToJSON, FromJSON)
-instance PersistFieldSql Textarea where
- sqlType _ = SqlString
instance ToHtml Textarea where
toHtml =
unsafeByteString
@@ -188,10 +251,18 @@ instance ToHtml Textarea where
@@ -190,10 +249,18 @@ instance ToHtml Textarea where
textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea
textareaField = Field
{ fieldParse = parseHelper $ Right . Textarea
@ -238,7 +249,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
@@ -199,10 +270,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
@@ -201,10 +268,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
=> Field m p
hiddenField = Field
{ fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
@ -262,7 +273,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
@@ -210,20 +290,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
@@ -212,20 +288,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
textField = Field
{ fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq ->
@ -326,7 +337,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
@@ -295,10 +410,24 @@ emailField = Field
@@ -297,57 +408,24 @@ emailField = Field
case Email.canonicalizeEmail $ encodeUtf8 s of
Just e -> Right $ decodeUtf8With lenientDecode e
Nothing -> Left $ MsgInvalidEmail s
@ -334,6 +345,8 @@ index 97d0034..016c98b 100644
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
-|]
- , fieldEnctype = UrlEncoded
- }
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arQe
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
@ -351,49 +364,43 @@ index 97d0034..016c98b 100644
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
@@ -307,20 +436,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus
searchField autoFocus = Field
{ fieldParse = parseHelper Right
, fieldView = \theId name attrs val isReq -> do
- [whamlet|\
--- |
---
--- Since 1.3.7
-multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m [Text]
-multiEmailField = Field
- { fieldParse = parseHelper $
- \s ->
- let addrs = map validate $ splitOn "," s
- in case partitionEithers addrs of
- ([], good) -> Right good
- (bad, _) -> Left $ MsgInvalidEmail $ cat bad
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}">
-|]
- , fieldEnctype = UrlEncoded
- }
- where
- -- report offending address along with error
- validate a = case Email.validate $ encodeUtf8 a of
- Left e -> Left $ T.concat [a, " (", pack e, ")"]
- Right r -> Right $ emailToText r
- cat = intercalate ", "
- emailToText = decodeUtf8With lenientDecode . Email.toByteString
-
-type AutoFocus = Bool
-searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus -> Field m Text
-searchField autoFocus = Field
- { fieldParse = parseHelper Right
- , fieldView = \theId name attrs val isReq -> do
- [whamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
-|]
+ do { (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\"");
+ Text.Hamlet.condH
+ [(isReq,
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ Text.Hamlet.condH
+ [(autoFocus,
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))]
+ Nothing;
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ (toHtml (either id id val));
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
when autoFocus $ do
-- we want this javascript to be placed immediately after the field
- when autoFocus $ do
- -- we want this javascript to be placed immediately after the field
- [whamlet|
-$newline never
-<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}
@ -402,51 +409,10 @@ index 97d0034..016c98b 100644
- ##{theId}
- -webkit-appearance: textfield
- |]
+ do { (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('");
+ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "').focus();}</script>") }
+
+ toWidget $ \ _render_arQv
+ -> (Text.Css.CssNoWhitespace
+ . (foldr ($) []))
+ [((++)
+ $ (map
+ Text.Css.TopBlock
+ (((Text.Css.Block
+ {Text.Css.blockSelector = Data.Monoid.mconcat
+ [(Text.Css.fromText
+ . Text.Css.pack)
+ "#",
+ toCss theId],
+ Text.Css.blockAttrs = (concat
+ $ ([Text.Css.Attr
+ (Data.Monoid.mconcat
+ [(Text.Css.fromText
+ . Text.Css.pack)
+ "-webkit-appearance"])
+ (Data.Monoid.mconcat
+ [(Text.Css.fromText
+ . Text.Css.pack)
+ "textfield"])]
+ :
+ (map
+ Text.Css.mixinAttrs
+ []))),
+ Text.Css.blockBlocks = (),
+ Text.Css.blockMixins = ()}
+ :)
+ . ((foldr (.) id [])
+ . (concatMap Text.Css.mixinBlocks [] ++)))
+ [])))]
+
, fieldEnctype = UrlEncoded
}
@@ -331,7 +518,30 @@ urlField = Field
@@ -358,7 +436,30 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s
, fieldView = \theId name attrs val isReq ->
@ -478,7 +444,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
@@ -344,18 +554,56 @@ selectField :: (Eq a, RenderMessage site FormMessage)
@@ -371,18 +472,56 @@ selectField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a
selectField = selectFieldHelper
@ -547,7 +513,7 @@ index 97d0034..016c98b 100644
multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
=> [(msg, a)]
@@ -378,11 +626,48 @@ multiSelectField ioptlist =
@@ -405,11 +544,48 @@ multiSelectField ioptlist =
view theId name attrs val isReq = do
opts <- fmap olOptions $ handlerToWidget ioptlist
let selOpts = map (id &&& (optselected val)) opts
@ -601,7 +567,7 @@ index 97d0034..016c98b 100644
where
optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
@@ -392,67 +677,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
@@ -419,67 +595,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
-> Field (HandlerT site IO) a
radioFieldList = radioField . optionsPairs
@ -732,6 +698,10 @@ index 97d0034..016c98b 100644
- $if not isReq
- <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
- <label for=#{theId}-none>_{MsgSelectNone}
-
-
-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
-<label for=#{theId}-yes>_{MsgBoolYes}
+ , fieldView = \theId name attrs val isReq -> do { Text.Hamlet.condH
+ [(not isReq,
+ do { (Yesod.Core.Widget.asWidgetT . toWidget)
@ -815,17 +785,13 @@ index 97d0034..016c98b 100644
+ (Yesod.Core.Widget.asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }
-
-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
-<label for=#{theId}-yes>_{MsgBoolYes}
-
-<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>
-<label for=#{theId}-no>_{MsgBoolNo}
-|]
, fieldEnctype = UrlEncoded
}
where
@@ -478,10 +868,25 @@ $newline never
@@ -505,10 +786,25 @@ $newline never
checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
checkBoxField = Field
{ fieldParse = \e _ -> return $ checkBoxParser e
@ -855,14 +821,14 @@ index 97d0034..016c98b 100644
, fieldEnctype = UrlEncoded
}
@@ -525,49 +930,7 @@ optionsPairs opts = do
@@ -552,50 +848,6 @@ optionsPairs opts = do
optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a)
optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
-optionsPersist :: ( YesodPersist site, PersistEntity a
- , PersistQuery (YesodDB site)
- , PersistQuery (YesodPersistBackend site (HandlerT site IO))
- , PathPiece (Key a)
- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)
- , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO))
- , RenderMessage site msg
- )
- => [Filter a]
@ -888,7 +854,7 @@ index 97d0034..016c98b 100644
- , PersistQuery (YesodPersistBackend site (HandlerT site IO))
- , PathPiece (Key a)
- , RenderMessage site msg
- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site))
- , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO)))
- => [Filter a]
- -> [SelectOpt a]
- -> (a -> msg)
@ -902,11 +868,11 @@ index 97d0034..016c98b 100644
- , optionInternalValue = key
- , optionExternalValue = toPathPiece key
- }) pairs
+
-
selectFieldHelper
:: (Eq a, RenderMessage site FormMessage)
@@ -611,9 +974,21 @@ fileField = Field
=> (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ())
@@ -638,9 +890,21 @@ fileField = Field
case files of
[] -> Right Nothing
file:_ -> Right $ Just file
@ -931,7 +897,7 @@ index 97d0034..016c98b 100644
, fieldEnctype = Multipart
}
@@ -640,10 +1015,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
@@ -667,10 +931,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage site langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs
, fvId = id'
@ -956,7 +922,7 @@ index 97d0034..016c98b 100644
, fvErrors = errs
, fvRequired = True
}
@@ -672,10 +1057,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
@@ -699,10 +973,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id'
@ -982,10 +948,18 @@ index 97d0034..016c98b 100644
, fvRequired = False
}
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
index 8a36710..8675a10 100644
index d84633e..9d9257f 100644
--- a/Yesod/Form/Functions.hs
+++ b/Yesod/Form/Functions.hs
@@ -53,12 +53,16 @@ import Text.Blaze (Markup, toMarkup)
@@ -25,7 +25,6 @@ module Yesod.Form.Functions
, generateFormPost
, generateFormGet
-- * More than one form on a handler
- , identifyForm
-- * Rendering
, FormRender
, renderTable
@@ -56,12 +55,16 @@ import Text.Blaze (Markup, toMarkup)
#define toHtml toMarkup
import Yesod.Core
import Network.Wai (requestMethod)
@ -1003,7 +977,7 @@ index 8a36710..8675a10 100644
-- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text
@@ -210,7 +214,14 @@ postHelper form env = do
@@ -213,7 +216,14 @@ postHelper form env = do
let token =
case reqToken req of
Nothing -> mempty
@ -1019,7 +993,7 @@ index 8a36710..8675a10 100644
m <- getYesod
langs <- languages
((res, xml), enctype) <- runFormGeneric (form token) m langs env
@@ -279,7 +290,12 @@ getHelper :: MonadHandler m
@@ -282,61 +292,17 @@ getHelper :: MonadHandler m
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
getHelper form env = do
@ -1033,7 +1007,61 @@ index 8a36710..8675a10 100644
langs <- languages
m <- getYesod
runFormGeneric (form fragment) m langs env
@@ -293,19 +309,66 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
--- | Creates a hidden field on the form that identifies it. This
--- identification is then used to distinguish between /missing/
--- and /wrong/ form data when a single handler contains more than
--- one form.
---
--- For instance, if you have the following code on your handler:
---
--- > ((fooRes, fooWidget), fooEnctype) <- runFormPost fooForm
--- > ((barRes, barWidget), barEnctype) <- runFormPost barForm
---
--- Then replace it with
---
--- > ((fooRes, fooWidget), fooEnctype) <- runFormPost $ identifyForm "foo" fooForm
--- > ((barRes, barWidget), barEnctype) <- runFormPost $ identifyForm "bar" barForm
---
--- Note that it's your responsibility to ensure that the
--- identification strings are unique (using the same one twice on a
--- single handler will not generate any errors). This allows you
--- to create a variable number of forms and still have them work
--- even if their number or order change between the HTML
--- generation and the form submission.
-identifyForm
- :: Monad m
- => Text -- ^ Form identification string.
- -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
- -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
-identifyForm identVal form = \fragment -> do
- -- Create hidden <input>.
- let fragment' =
- [shamlet|
- <input type=hidden name=#{identifyFormKey} value=#{identVal}>
- #{fragment}
- |]
-
- -- Check if we got its value back.
- mp <- askParams
- let missing = (mp >>= Map.lookup identifyFormKey) /= Just [identVal]
-
- -- Run the form proper (with our hidden <input>). If the
- -- data is missing, then do not provide any params to the
- -- form, which will turn its result into FormMissing. Also,
- -- doing this avoids having lots of fields with red errors.
- let eraseParams | missing = local (\(_, h, l) -> (Nothing, h, l))
- | otherwise = id
- eraseParams (form fragment')
-
-identifyFormKey :: Text
-identifyFormKey = "_formid"
-
type FormRender m a =
AForm m a
@@ -347,19 +313,66 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
renderTable aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
@ -1113,7 +1141,7 @@ index 8a36710..8675a10 100644
return (res, widget)
-- | render a field inside a div
@@ -318,19 +381,67 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
@@ -372,19 +385,67 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
renderDivsMaybeLabels withLabels aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
@ -1193,8 +1221,8 @@ index 8a36710..8675a10 100644
+
return (res, widget)
-- | Render a form using Bootstrap-friendly shamlet syntax.
@@ -354,19 +465,63 @@ renderBootstrap aform fragment = do
-- | Render a form using Bootstrap v2-friendly shamlet syntax.
@@ -410,19 +471,63 @@ renderBootstrap aform fragment = do
let views = views' []
has (Just _) = True
has Nothing = False
@ -1269,8 +1297,8 @@ index 8a36710..8675a10 100644
+ views }
+
return (res, widget)
{-# DEPRECATED renderBootstrap "Please use the Yesod.Form.Bootstrap3 module." #-}
check :: (Monad m, RenderMessage (HandlerSite m) msg)
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
index 2c4ae25..ed9b366 100644
--- a/Yesod/Form/Jquery.hs
@ -1436,7 +1464,7 @@ index 2c4ae25..ed9b366 100644
}
diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs
index 332eb66..5015e7b 100644
index a2b434d..6766ad8 100644
--- a/Yesod/Form/MassInput.hs
+++ b/Yesod/Form/MassInput.hs
@@ -9,6 +9,16 @@ module Yesod.Form.MassInput
@ -1455,7 +1483,7 @@ index 332eb66..5015e7b 100644
+
import Yesod.Form.Types
import Yesod.Form.Functions
import Yesod.Form.Fields (boolField)
import Yesod.Form.Fields (checkBoxField)
@@ -70,16 +80,28 @@ inputList label fixXml single mdef = formToAForm $ do
{ fvLabel = label
, fvTooltip = Nothing
@ -1512,7 +1540,7 @@ index 332eb66..5015e7b 100644
+ "\" value=\"yes\">") }
+
_ -> do
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
(_, xml2) <- aFormToForm $ areq checkBoxField FieldSettings
{ fsLabel = SomeMessage MsgDelete
@@ -121,32 +147,155 @@ fixme eithers =
massDivs, massTable
@ -1789,17 +1817,17 @@ index 2862678..04ddaba 100644
}
where
diff --git a/yesod-form.cabal b/yesod-form.cabal
index 1f6e0e1..4667861 100644
index 56a3053..e7a0729 100644
--- a/yesod-form.cabal
+++ b/yesod-form.cabal
@@ -19,6 +19,7 @@ library
, time >= 1.1.4
, hamlet >= 1.1 && < 1.2
, shakespeare-css >= 1.0 && < 1.1
+ , shakespeare
, shakespeare-js >= 1.0.2 && < 1.3
, persistent >= 1.2 && < 1.4
, template-haskell
@@ -43,7 +43,6 @@ library
exposed-modules: Yesod.Form
Yesod.Form.Types
Yesod.Form.Functions
- Yesod.Form.Bootstrap3
Yesod.Form.Input
Yesod.Form.Fields
Yesod.Form.Jquery
--
1.7.10.4
2.0.0.rc2

31
standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch
View file

@ -1,26 +1,33 @@
From 03819615edb1c5f7414768dae84234d6791bd758 Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 04:11:46 +0000
From b232effd092b03c6ad4235e5aa0c5750461af02d Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Wed, 21 May 2014 04:47:44 +0000
Subject: [PATCH] do not really build
---
yesod-persistent.cabal | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
yesod-persistent.cabal | 10 ----------
1 file changed, 10 deletions(-)
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
index 98c2146..11960cf 100644
index 3560dd9..d01be4a 100644
--- a/yesod-persistent.cabal
+++ b/yesod-persistent.cabal
@@ -23,8 +23,7 @@ library
, lifted-base
, pool-conduit
, resourcet
@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod.
library
build-depends: base >= 4 && < 5
- , yesod-core >= 1.2.2 && < 1.3
- , persistent >= 1.2 && < 1.4
- , persistent-template >= 1.2 && < 1.4
- , transformers >= 0.2.2 && < 0.4
- , blaze-builder
- , conduit
- , resourcet >= 0.4.5
- , resource-pool
- exposed-modules: Yesod.Persist
- Yesod.Persist.Core
+ exposed-modules:
ghc-options: -Wall
test-suite test
--
1.7.10.4
2.0.0.rc2

61
standalone/no-th/haskell-patches/yesod-static_hack.patch
View file

@ -1,31 +1,27 @@
From 885cc873196f535de7cd1ac2ccfa217d10308d1f Mon Sep 17 00:00:00 2001
From 606c5f4f4b2d476d274907eb2bb8c12b60fc451f 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
Date: Wed, 21 May 2014 04:43:30 +0000
Subject: [PATCH] remove TH
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.hs | 29 ++++++++++++++++++-----------
yesod-static.cabal | 7 -------
3 files changed, 19 insertions(+), 20 deletions(-)
yesod-static.cabal | 9 ---------
3 files changed, 19 insertions(+), 22 deletions(-)
diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs
index e83785d..6b1c10e 100644
index 08febb9..e3a6d51 100644
--- a/Yesod/EmbeddedStatic/Generators.hs
+++ b/Yesod/EmbeddedStatic/Generators.hs
@@ -43,7 +43,6 @@ import Language.Haskell.TH
@@ -42,7 +42,6 @@ import Language.Haskell.TH
import Network.Mime (defaultMimeLookup)
import System.Directory (doesDirectoryExist, getDirectoryContents, findExecutable)
import System.FilePath ((</>))
-import Text.Jasmine (minifym)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Conduit.List as C
import qualified Data.Text as T
@@ -158,7 +157,7 @@ concatFilesWith loc process files = do
import Data.Conduit.Binary (sourceHandle)
@@ -162,7 +161,7 @@ concatFilesWith loc process files = do
-- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.
jasmine :: BL.ByteString -> IO BL.ByteString
@ -35,7 +31,7 @@ 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
index 725ebf4..33eaffd 100644
--- a/Yesod/Static.hs
+++ b/Yesod/Static.hs
@@ -37,8 +37,8 @@ module Yesod.Static
@ -74,9 +70,9 @@ index dd21791..37f7e00 100644
-import Data.FileEmbed (embedDir)
+import Data.FileEmbed
import Control.Monad.Trans.Resource (runResourceT)
import Yesod.Core
import Yesod.Core.Types
@@ -135,6 +135,7 @@ staticDevel dir = do
@@ -136,6 +136,7 @@ staticDevel dir = do
hashLookup <- cachedETagLookupDevel dir
return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup
@ -84,7 +80,7 @@ index dd21791..37f7e00 100644
-- | 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
@@ -150,6 +151,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))|]
@ -92,7 +88,7 @@ index dd21791..37f7e00 100644
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
@@ -215,6 +217,7 @@ getFileListPieces = flip evalStateT M.empty . flip go id
put $ M.insert s s m
return s
@ -100,7 +96,7 @@ index dd21791..37f7e00 100644
-- | Template Haskell function that automatically creates routes
-- for all of your static files.
--
@@ -266,7 +269,7 @@ staticFilesList dir fs =
@@ -267,7 +270,7 @@ staticFilesList dir fs =
-- see if their copy is up-to-date.
publicFiles :: Prelude.FilePath -> Q [Dec]
publicFiles dir = mkStaticFiles' dir "StaticRoute" False
@ -109,7 +105,7 @@ index dd21791..37f7e00 100644
mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)
mkHashMap dir = do
@@ -309,6 +312,7 @@ cachedETagLookup dir = do
@@ -310,6 +313,7 @@ cachedETagLookup dir = do
etags <- mkHashMap dir
return $ (\f -> return $ M.lookup f etags)
@ -117,7 +113,7 @@ index dd21791..37f7e00 100644
mkStaticFiles :: Prelude.FilePath -> Q [Dec]
mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
@@ -356,6 +360,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
@@ -357,6 +361,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
[ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
]
]
@ -125,7 +121,7 @@ index dd21791..37f7e00 100644
base64md5File :: Prelude.FilePath -> IO String
base64md5File = fmap (base64 . encode) . hashFile
@@ -394,7 +399,7 @@ base64 = map tr
@@ -395,7 +400,7 @@ base64 = map tr
-- single static file at compile time.
data CombineType = JS | CSS
@ -134,7 +130,7 @@ index dd21791..37f7e00 100644
combineStatics' :: CombineType
-> CombineSettings
-> [Route Static] -- ^ files to combine
@@ -428,7 +433,7 @@ combineStatics' combineType CombineSettings {..} routes = do
@@ -429,7 +434,7 @@ combineStatics' combineType CombineSettings {..} routes = do
case combineType of
JS -> "js"
CSS -> "css"
@ -143,7 +139,7 @@ index dd21791..37f7e00 100644
-- | 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
@@ -505,6 +510,7 @@ instance Default CombineSettings where
errorIntro :: [FilePath] -> [Char] -> [Char]
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
@ -151,7 +147,7 @@ index dd21791..37f7e00 100644
liftRoutes :: [Route Static] -> Q Exp
liftRoutes =
fmap ListE . mapM go
@@ -550,4 +556,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
@@ -551,4 +557,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
-> Q Exp
combineScripts' development cs con routes
| development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
@ -159,36 +155,39 @@ index dd21791..37f7e00 100644
+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a
+-}
diff --git a/yesod-static.cabal b/yesod-static.cabal
index 3423149..416aae6 100644
index 2582a95..5df03b3 100644
--- a/yesod-static.cabal
+++ b/yesod-static.cabal
@@ -48,18 +48,12 @@ library
@@ -49,7 +49,6 @@ library
, data-default
, shakespeare-css >= 1.0.3
, mime-types >= 0.1
- , hjsmin
, process-conduit >= 1.0 && < 1.1
, filepath >= 1.3
, resourcet >= 0.4
, unordered-containers >= 0.2
@@ -62,13 +61,6 @@ library
, hashable >= 1.1
exposed-modules: Yesod.Static
- Yesod.EmbeddedStatic
- Yesod.EmbeddedStatic.Generators
- Yesod.EmbeddedStatic.Types
- Yesod.EmbeddedStatic.Css.AbsoluteUrl
-
- other-modules: Yesod.EmbeddedStatic.Internal
- Yesod.EmbeddedStatic.Css.Util
ghc-options: -Wall
extensions: TemplateHaskell
@@ -99,7 +93,6 @@ test-suite tests
@@ -108,7 +100,6 @@ test-suite tests
, data-default
, shakespeare-css
, mime-types
- , hjsmin
, process-conduit
, filepath
, resourcet
, unordered-containers
--
1.9.0
2.0.0.rc2

30
standalone/no-th/haskell-patches/yesod_hack-TH.patch
View file

@ -1,13 +1,13 @@
From 369c99b9de0c82578f5221fdabc42ea9ba59ddea Mon Sep 17 00:00:00 2001
From 86264ab2a76568585cacca9145e440d6c06edbe3 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 7 Mar 2014 04:10:02 +0000
Subject: [PATCH] hack to TH
Date: Wed, 21 May 2014 06:30:03 +0000
Subject: [PATCH] avoid TH
---
Yesod.hs | 19 ++++++++++++--
Yesod/Default/Main.hs | 25 +------------------
Yesod/Default/Main.hs | 31 +----------------------
Yesod/Default/Util.hs | 69 ++-------------------------------------------------
3 files changed, 20 insertions(+), 93 deletions(-)
3 files changed, 20 insertions(+), 99 deletions(-)
diff --git a/Yesod.hs b/Yesod.hs
index b367144..fbe309c 100644
@ -41,7 +41,7 @@ index b367144..fbe309c 100644
+insert = undefined
+
diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs
index 0780539..ad99ccd 100644
index e273de2..bf46642 100644
--- a/Yesod/Default/Main.hs
+++ b/Yesod/Default/Main.hs
@@ -1,10 +1,8 @@
@ -55,7 +55,7 @@ index 0780539..ad99ccd 100644
, defaultRunner
, defaultDevelApp
, LogFunc
@@ -22,7 +20,7 @@ import Control.Monad (when)
@@ -23,7 +21,7 @@ import Control.Monad (when)
import System.Environment (getEnvironment)
import Data.Maybe (fromMaybe)
import Safe (readMay)
@ -64,7 +64,7 @@ index 0780539..ad99ccd 100644
import System.Log.FastLogger (LogStr, toLogStr)
import Language.Haskell.TH.Syntax (qLocation)
@@ -54,27 +52,6 @@ defaultMain load getApp = do
@@ -55,33 +53,6 @@ defaultMain load getApp = do
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
@ -82,16 +82,22 @@ index 0780539..ad99ccd 100644
- runSettings defaultSettings
- { settingsPort = appPort config
- , settingsHost = appHost config
- , settingsOnException = const $ \e -> logFunc
- , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc
- $(qLocation >>= liftLoc)
- "yesod"
- LevelError
- (toLogStr $ "Exception from Warp: " ++ show e)
- } app
-
- where
- shouldLog' =
-#if MIN_VERSION_wai(2,1,3)
- Warp.defaultShouldDisplayException
-#else
- const True
-#endif
-- | Run your application continously, listening for SIGINT and exiting
-- when received
--
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
index a10358e..0547424 100644
--- a/Yesod/Default/Util.hs
@ -189,5 +195,5 @@ index a10358e..0547424 100644
- else return $ Just ex
- else return Nothing
--
1.9.0
2.0.0.rc2