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

refresh android and no-th haskell patches to latest package versions from cabal

Browse source 
Added a cabal.config file; the result of running cabal freeze.
It's not used yet (needs a newer cabal than is in debian stable),
but the plan is that once the autbuilders are swiched to jessie,
this can be used to make cabal install the same versions of packages
that this patch got building, and so avoid breaking every time eg, yesod is
upgraded.

This commit was sponsored by Daniel Atlas.
This commit is contained in:
Joey Hess 2014-10-14 00:16:38 -04:00
parent c27f11a2c4
commit 375158f6b5
14 changed files with 439 additions and 187 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

159
standalone/android/cabal.config Normal file
View file

@ -0,0 +1,159 @@
constraints: Crypto ==4.2.5.1,
DAV ==1.0.2,
HTTP ==4000.2.18,
HUnit ==1.2.5.2,
IfElse ==0.85,
MissingH ==1.2.1.0,
MonadRandom ==0.3,
QuickCheck ==2.7.6,
SHA ==1.6.4.1,
SafeSemaphore ==0.10.1,
aeson ==0.6.2.1,
appar ==0.1.4,
array ==0.4.0.0,
asn1-encoding ==0.8.1.3,
asn1-parse ==0.8.1,
asn1-types ==0.2.3,
async ==2.0.1.6,
attoparsec ==0.11.1.0,
base ==4.5.0.0,
base64-bytestring ==1.0.0.1,
bifunctors ==4.1.1.1,
binary ==0.5.1.0,
blaze-builder ==0.3.1.0,
blaze-html ==0.7.0.3,
blaze-markup ==0.6.1.1,
bloomfilter ==2.0.0.0,
byteable ==0.1.1,
byteorder ==1.0.4,
bytestring ==0.9.2.1,
case-insensitive ==1.2.0.1,
cereal ==0.4.1.0,
cipher-aes ==0.2.8,
cipher-des ==0.0.6,
cipher-rc4 ==0.1.4,
comonad ==4.2.2,
conduit ==1.2.1,
conduit-extra ==1.1.4,
connection ==0.2.3,
containers ==0.4.2.1,
contravariant ==1.2,
cookie ==0.4.1.4,
cprng-aes ==0.5.2,
crypto-cipher-types ==0.0.9,
crypto-numbers ==0.2.3,
crypto-pubkey ==0.2.4,
crypto-pubkey-types ==0.4.2.2,
crypto-random ==0.0.8,
cryptohash ==0.11.6,
data-default ==0.5.3,
data-default-class ==0.0.1,
data-default-instances-base ==0.0.1,
data-default-instances-containers ==0.0.1,
data-default-instances-dlist ==0.0.1,
data-default-instances-old-locale ==0.0.1,
dataenc ==0.14.0.7,
deepseq ==1.3.0.0,
directory ==1.2.1.0,
distributive ==0.4.4,
dlist ==0.7.1,
dns ==1.4.4,
edit-distance ==0.2.1.2,
either ==4.3.1,
errors ==1.4.7,
exceptions ==0.6.1,
feed ==0.3.9.2,
filepath ==1.3.0.0,
free ==4.9,
ghc-prim ==0.2.0.0,
git-annex ==5.20141013,
gnuidn ==0.2.1,
gnutls ==0.1.5,
gsasl ==0.3.5,
hS3 ==0.5.9,
hashable ==1.2.2.0,
hinotify ==0.3.7,
hslogger ==1.2.4,
http-client ==0.4.0.1,
http-client-tls ==0.2.2,
http-conduit ==2.1.4.5,
http-types ==0.8.5,
hxt ==9.3.1.7,
hxt-charproperties ==9.2.0.0,
hxt-regex-xmlschema ==9.1.0,
hxt-unicode ==9.0.2.2,
integer-gmp ==0.4.0.0,
iproute ==1.3.1,
json ==0.7,
lens ==4.4.0.2,
libxml-sax ==0.7.5,
lifted-base ==0.2.3.0,
maccatcher ==2.1.5,
mime-types ==0.1.0.4,
mmorph ==1.0.4,
monad-control ==0.3.3.0,
monads-tf ==0.1.0.2,
mtl ==2.1.1,
nats ==0.2,
network ==2.5.0.0,
network-info ==0.2.0.5,
network-multicast ==0.0.11,
network-protocol-xmpp ==0.4.6,
network-uri ==2.5.0.0,
old-locale ==1.0.0.4,
old-time ==1.1.0.0,
parallel ==3.2.0.4,
parsec ==3.1.7,
pem ==0.2.2,
prelude-extras ==0.4,
pretty ==1.1.1.0,
primitive ==0.5.4.0,
process ==1.2.0.0,
profunctors ==4.2.0.1,
publicsuffixlist ==0.1,
random ==1.1,
reflection ==1.5.1,
regex-base ==0.93.2,
regex-compat ==0.95.1,
regex-posix ==0.95.2,
regex-tdfa ==1.2.0,
resourcet ==1.1.2.3,
rts ==1.0,
safe ==0.3.8,
scientific ==0.3.3.1,
securemem ==0.1.3,
semigroupoids ==4.2,
semigroups ==0.15.3,
shakespeare ==2.0.1.1,
socks ==0.5.4,
split ==0.2.2,
stm ==2.4.3,
streaming-commons ==0.1.5,
syb ==0.4.2,
system-fileio ==0.3.14,
system-filepath ==0.4.12,
tagged ==0.7.2,
template-haskell ==2.7.0.0,
text ==0.11.2.0,
tf-random ==0.5,
time ==1.4,
tls ==1.2.9,
transformers ==0.3.0.0,
transformers-base ==0.4.3,
transformers-compat ==0.3.3.4,
unix ==2.5.1.0,
unix-compat ==0.4.1.3,
unordered-containers ==0.2.5.1,
utf8-string ==0.3.7,
uuid ==1.2.4,
vector ==0.10.12.1,
void ==0.6.1,
x509 ==1.4.13,
x509-store ==1.4.4,
x509-system ==1.4.6,
x509-validation ==1.5.0,
xml ==1.3.13,
xml-conduit ==1.2.3,
xml-hamlet ==0.4.0.9,
xml-types ==0.3.4,
zlib ==0.5.4.1

14
standalone/android/haskell-patches/dns_use-android-net.dns1-command-instead-of-resolv.conf.patch
View file

@ -1,6 +1,6 @@
From aaef1aadb21a198475a656132ef4488b85b8fd1b Mon Sep 17 00:00:00 2001
From 99f349066fc960bfa60b4e369bb21431c87d9b59 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 3 Jul 2014 23:22:47 +0000
Date: Tue, 14 Oct 2014 03:54:57 +0000
Subject: [PATCH] use android net.dns1 command instead of resolv.conf file
Android has no /etc/resolv.conf. Some might have /system/etc/resolv.conf,
@ -14,7 +14,7 @@ since it only uses this library for occasional SRV lookups.
2 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs
index e4124b8..7aca431 100644
index 9e8342b..4c6c380 100644
--- a/Network/DNS/Resolver.hs
+++ b/Network/DNS/Resolver.hs
@@ -19,7 +19,7 @@ module Network.DNS.Resolver (
@ -23,10 +23,10 @@ index e4124b8..7aca431 100644
import Control.Applicative ((<$>), (<*>), pure)
-import Control.Exception (bracket)
+import Control.Exception (bracket, catch, IOException)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (isPrefixOf)
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(
import Data.Maybe (fromMaybe)
@@ -33,6 +33,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(
import Prelude hiding (lookup)
import System.Random (getStdRandom, randomR)
import System.Timeout (timeout)
@ -34,7 +34,7 @@ index e4124b8..7aca431 100644
#if mingw32_HOST_OS == 1
import Network.Socket (send)
@@ -132,7 +133,13 @@ makeResolvSeed conf = ResolvSeed <$> addr
@@ -133,7 +134,13 @@ makeResolvSeed conf = ResolvSeed <$> addr
addr = case resolvInfo conf of
RCHostName numhost -> makeAddrInfo numhost Nothing
RCHostPort numhost mport -> makeAddrInfo numhost $ Just mport
@ -50,7 +50,7 @@ index e4124b8..7aca431 100644
in extract l
extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
diff --git a/dns.cabal b/dns.cabal
index 0a08a9e..724a3e0 100644
index fd7d7a3..5ad8a84 100644
--- a/dns.cabal
+++ b/dns.cabal
@@ -38,6 +38,7 @@ Library

25
standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch
View file

@ -1,16 +1,16 @@
From add5feeb9ee9b4ffa1b43e4ba04b63e5ac2bfaf7 Mon Sep 17 00:00:00 2001
From 9569708b67df79185dde603f1305eb84d168eba6 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Mon, 14 Jul 2014 20:45:24 +0000
Date: Tue, 14 Oct 2014 01:07:34 +0000
Subject: [PATCH] hack for bionic
---
Data/UnixTime/Types.hsc | 12 ------------
cbits/conv.c | 2 +-
unix-time.cabal | 1 -
3 files changed, 1 insertion(+), 14 deletions(-)
unix-time.cabal | 2 --
3 files changed, 1 insertion(+), 15 deletions(-)
diff --git a/Data/UnixTime/Types.hsc b/Data/UnixTime/Types.hsc
index 2ad0623..04fd766 100644
index aa64970..ddca145 100644
--- a/Data/UnixTime/Types.hsc
+++ b/Data/UnixTime/Types.hsc
@@ -12,8 +12,6 @@ import Data.Binary
@ -21,8 +21,8 @@ index 2ad0623..04fd766 100644
-
-- |
-- Data structure for Unix time.
data UnixTime = UnixTime {
@@ -23,16 +21,6 @@ data UnixTime = UnixTime {
--
@@ -33,16 +31,6 @@ data UnixTime = UnixTime {
, utMicroSeconds :: {-# UNPACK #-} !Int32
} deriving (Eq,Ord,Show)
@ -40,10 +40,10 @@ index 2ad0623..04fd766 100644
instance Binary UnixTime where
put (UnixTime (CTime sec) msec) = do
diff --git a/cbits/conv.c b/cbits/conv.c
index ec31fef..b7bc0f9 100644
index 669cfda..8fa5f9a 100644
--- a/cbits/conv.c
+++ b/cbits/conv.c
@@ -96,7 +96,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
@@ -98,7 +98,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
#else
strptime(src, fmt, &dst);
#endif
@ -53,14 +53,15 @@ index ec31fef..b7bc0f9 100644
size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
diff --git a/unix-time.cabal b/unix-time.cabal
index 5de3f7c..7a0c244 100644
index 1061602..588499a 100644
--- a/unix-time.cabal
+++ b/unix-time.cabal
@@ -15,7 +15,6 @@ Extra-Tmp-Files: config.log config.status autom4te.cache cbits/config.h
@@ -15,8 +15,6 @@ Extra-Tmp-Files: config.log config.status autom4te.cache cbits/config.h
Library
Default-Language: Haskell2010
GHC-Options: -Wall
- CC-Options: -fPIC
- if impl(ghc >= 7.8)
- CC-Options: -fPIC
Exposed-Modules: Data.UnixTime
Other-Modules: Data.UnixTime.Conv
Data.UnixTime.Diff

29
standalone/android/haskell-patches/x509-system_support-Android-cert-store.patch
View file

@ -1,36 +1,27 @@
From 2c736615e38ee4f582af9d98d7169cf07b84d875 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 10 Feb 2014 23:27:32 +0000
From 61d0e47cd038f25157e48385fc080d0d374b214d Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Tue, 14 Oct 2014 02:07:57 +0000
Subject: [PATCH] support Android cert store
Android puts it in a different place and has only hashed files.
Android has only hashsed cert files.
See https://github.com/vincenthz/hs-certificate/issues/19
---
System/X509/Unix.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
System/X509/Unix.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/System/X509/Unix.hs b/System/X509/Unix.hs
index cbf9bbe..cab4f4a 100644
index 9df3331..a30da26 100644
--- a/System/X509/Unix.hs
+++ b/System/X509/Unix.hs
@@ -34,7 +34,7 @@ import qualified Control.Exception as E
import Data.Char
defaultSystemPath :: FilePath
-defaultSystemPath = "/etc/ssl/certs/"
+defaultSystemPath = "/system/etc/security/cacerts/"
envPathOverride :: String
envPathOverride = "SYSTEM_CERTIFICATE_PATH"
@@ -46,7 +46,7 @@ listDirectoryCerts path = (map (path </>) . filter isCert <$> getDirectoryConten
@@ -56,7 +56,7 @@ listDirectoryCerts path = do
&& isDigit (s !! 9)
&& (s !! 8) == '.'
&& all isHexDigit (take 8 s)
- isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x)
+ isCert x = (not $ isPrefixOf "." x)
getSystemCertificateStore :: IO CertificateStore
getSystemCertificateStore = makeCertificateStore . concat <$> (getSystemPath >>= listDirectoryCerts >>= mapM readCertificates)
getDirContents = E.catch (Just <$> getDirectoryContents path) emptyPaths
where emptyPaths :: E.IOException -> IO (Maybe [FilePath])
--
1.7.10.4

2
standalone/android/install-haskell-packages
View file

@ -83,7 +83,6 @@ install_pkgs () {
rm -rf tmp
mkdir tmp
cd tmp
patched network
patched unix-time
patched lifted-base
@ -105,6 +104,7 @@ install_pkgs () {
patched x509-system
patched persistent-template
patched system-filepath
patched optparse-applicative
patched wai-app-static
patched shakespeare
patched shakespeare-css

21
standalone/no-th/haskell-patches/DAV_build-without-TH.patch
View file

@ -1,16 +1,16 @@
From 8e115228601a97b19d3f713ccf2d13f58838d927 Mon Sep 17 00:00:00 2001
From 438479e3573d4a9fa2e001b8f7ec5f9a595d7514 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Mon, 26 May 2014 01:48:22 +0000
Subject: [PATCH] expand TH
Date: Tue, 14 Oct 2014 03:48:07 +0000
Subject: [PATCH] avoid TH
---
DAV.cabal | 24 +---
Network/Protocol/HTTP/DAV.hs | 96 ++++++++++++----
DAV.cabal | 25 +----
Network/Protocol/HTTP/DAV.hs | 92 +++++++++++++---
Network/Protocol/HTTP/DAV/TH.hs | 232 ++++++++++++++++++++++++++++++++++++++-
3 files changed, 307 insertions(+), 45 deletions(-)
3 files changed, 306 insertions(+), 43 deletions(-)
diff --git a/DAV.cabal b/DAV.cabal
index 5d50e39..f2abf89 100644
index f8fdd40..92945c3 100644
--- a/DAV.cabal
+++ b/DAV.cabal
@@ -43,30 +43,7 @@ library
@ -26,7 +26,7 @@ index 5d50e39..f2abf89 100644
- , case-insensitive >= 0.4
- , containers
- , data-default
- , either >= 4.1
- , either >= 4.3
- , errors
- , exceptions
- , http-client >= 0.2
@ -35,7 +35,7 @@ index 5d50e39..f2abf89 100644
- , lens >= 3.0
- , mtl >= 2.1
- , network >= 2.3
- , optparse-applicative >= 0.5.0
- , optparse-applicative >= 0.10.0
- , transformers >= 0.3
- , transformers-base
- , utf8-string
@ -412,3 +412,6 @@ index 0ecd476..1653bf6 100644
+ __userAgent_a3kh)
+ Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg))
+{-# INLINE userAgent #-}
--
1.7.10.4

33
standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch Normal file
View file

@ -0,0 +1,33 @@
From b128590966d4946219e45e2efd88acf7a354abc2 Mon Sep 17 00:00:00 2001
From: androidbuilder <androidbuilder@example.com>
Date: Tue, 14 Oct 2014 02:28:02 +0000
Subject: [PATCH] remove ANN
---
Options/Applicative.hs | 2 --
Options/Applicative/Help/Core.hs | 2 --
2 files changed, 4 deletions(-)
diff --git a/Options/Applicative.hs b/Options/Applicative.hs
index bd4129d..f412062 100644
--- a/Options/Applicative.hs
+++ b/Options/Applicative.hs
@@ -34,5 +34,3 @@ import Options.Applicative.Common
import Options.Applicative.Builder
import Options.Applicative.Builder.Completer
import Options.Applicative.Extra
-
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
diff --git a/Options/Applicative/Help/Core.hs b/Options/Applicative/Help/Core.hs
index 0a79169..3f1ce3f 100644
--- a/Options/Applicative/Help/Core.hs
+++ b/Options/Applicative/Help/Core.hs
@@ -139,5 +139,3 @@ parserUsage pprefs p progn = hsep
[ string "Usage:"
, string progn
, align (extractChunk (briefDesc pprefs p)) ]
-
-{-# ANN footerHelp "HLint: ignore Eta reduce" #-}
--
1.7.10.4

18
standalone/no-th/haskell-patches/persistent-template_stub-out.patch
View file

@ -1,22 +1,22 @@
From 4b958f97bffdeedc0c946d5fdc9749d2cc566fcc Mon Sep 17 00:00:00 2001
From 97e13262aa53cd3cc4f3997ac9156007ca1b9ce0 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 26 Dec 2013 15:54:37 -0400
Subject: [PATCH] stub out
Date: Tue, 14 Oct 2014 02:18:08 +0000
Subject: [PATCH] unused
---
persistent-template.cabal | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/persistent-template.cabal b/persistent-template.cabal
index c4aee68..7905278 100644
index e247f6b..68184af 100644
--- a/persistent-template.cabal
+++ b/persistent-template.cabal
@@ -24,7 +24,7 @@ library
, aeson
, monad-logger
, unordered-containers
@@ -29,7 +29,7 @@ library
, tagged
, path-pieces
, ghc-prim
- exposed-modules: Database.Persist.TH
+ exposed-modules:
+ exposed-modules:
ghc-options: -Wall
if impl(ghc >= 7.4)
cpp-options: -DGHC_7_4

48
standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
View file

@ -1,41 +1,43 @@
From efd18199fa245e51e6137036062ded8b0b26f78c Mon Sep 17 00:00:00 2001
From ec2543b2156dc968530ad98e33d26f741a479e31 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Tue, 17 Dec 2013 18:08:22 +0000
Subject: [PATCH] disable TH
Date: Tue, 14 Oct 2014 01:23:56 +0000
Subject: [PATCH] hack to build
---
Database/Persist/Sql/Raw.hs | 4 +---
1 file changed, 1 insertion(+), 3 deletions(-)
Database/Persist/Sql/Raw.hs | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
index 73189dd..d432790 100644
index 319d75f..db3ee43 100644
--- a/Database/Persist/Sql/Raw.hs
+++ b/Database/Persist/Sql/Raw.hs
@@ -11,7 +11,7 @@ import Data.IORef (writeIORef, readIORef, newIORef)
@@ -15,7 +15,7 @@ import Data.IORef (writeIORef, readIORef, newIORef)
import Control.Exception (throwIO)
import Control.Monad (when, liftM)
import Data.Text (Text, pack)
-import Control.Monad.Logger (logDebugS)
+--import Control.Monad.Logger (logDebugS)
-import Control.Monad.Logger (logDebugS, runLoggingT)
+-- import Control.Monad.Logger (logDebugS, runLoggingT)
import Data.Int (Int64)
import Control.Monad.Trans.Class (lift)
import qualified Data.Text as T
@@ -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
import Data.Conduit
@@ -39,8 +39,6 @@ rawQueryRes
rawQueryRes sql vals = do
conn <- ask
let make = do
- runLoggingT ($logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals)
- (connLogFunc conn)
getStmtConn conn sql
return $ do
stmt <- mkAcquire make stmtReset
@@ -52,8 +50,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y
rawExecuteCount :: MonadIO m => Text -> [PersistValue] -> ReaderT Connection m Int64
rawExecuteCount sql vals = do
- $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
conn <- ask
- runLoggingT ($logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals)
- (connLogFunc conn)
stmt <- getStmt sql
res <- liftIO $ stmtExecute stmt vals
liftIO $ stmtReset stmt
--
1.8.5.1
1.7.10.4

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

@ -1,24 +1,24 @@
From 7e85a025349877565a70c375ef55508f215eaaf8 Mon Sep 17 00:00:00 2001
From ed77588c57704030a9d412dd49f11c172c6268ab 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
Date: Tue, 14 Oct 2014 03:46:03 +0000
Subject: [PATCH] unused
---
process-conduit.cabal | 1 -
process-conduit.cabal | 1 -
1 file changed, 1 deletion(-)
diff --git a/process-conduit.cabal b/process-conduit.cabal
index e6988e0..a2e03e0 100644
index 34bb168..2f137a8 100644
--- a/process-conduit.cabal
+++ b/process-conduit.cabal
@@ -24,7 +24,6 @@ source-repository head
@@ -22,7 +22,6 @@ source-repository head
library
exposed-modules: Data.Conduit.Process
exposed-modules: Data.Conduit.ProcessOld
- System.Process.QQ
build-depends: base == 4.*
, template-haskell >= 2.4
--
2.0.0.rc2
1.7.10.4

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

@ -1,18 +1,18 @@
From 9feb37d13dc8449dc4445db83485780caee4b7ff Mon Sep 17 00:00:00 2001
From e163ab104cf2f8d2bac07ab389caec49dfc39665 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Tue, 10 Jun 2014 17:44:52 +0000
Date: Tue, 14 Oct 2014 02:49:19 +0000
Subject: [PATCH] expand and remove TH
---
Yesod/Core.hs | 30 +++---
Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++---------------
Yesod/Core/Dispatch.hs | 38 ++-----
Yesod/Core/Handler.hs | 25 ++---
Yesod/Core/Internal/Run.hs | 8 +-
Yesod/Core/Internal/TH.hs | 111 --------------------
Yesod/Core/Types.hs | 3 +-
Yesod/Core/Widget.hs | 32 +-----
8 files changed, 215 insertions(+), 289 deletions(-)
Yesod/Core.hs | 30 +++---
Yesod/Core/Class/Yesod.hs | 256 +++++++++++++++++++++++++++++---------------
Yesod/Core/Dispatch.hs | 38 ++-----
Yesod/Core/Handler.hs | 25 ++---
Yesod/Core/Internal/Run.hs | 6 +-
Yesod/Core/Internal/TH.hs | 111 -------------------
Yesod/Core/Types.hs | 3 +-
Yesod/Core/Widget.hs | 32 +-----
8 files changed, 213 insertions(+), 288 deletions(-)
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
index 9b29317..7c0792d 100644
@ -68,10 +68,10 @@ index 9b29317..7c0792d 100644
, renderCssUrl
) where
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
index 140600b..75daabc 100644
index 5dbaff2..edd98a5 100644
--- a/Yesod/Core/Class/Yesod.hs
+++ b/Yesod/Core/Class/Yesod.hs
@@ -5,18 +5,22 @@
@@ -5,11 +5,15 @@
{-# LANGUAGE CPP #-}
module Yesod.Core.Class.Yesod where
@ -88,15 +88,16 @@ index 140600b..75daabc 100644
import Blaze.ByteString.Builder (Builder)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import Control.Arrow ((***), second)
@@ -17,7 +21,7 @@ import Control.Arrow ((***), second)
import Control.Exception (bracket)
import Control.Monad (forM, when, void)
import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
+import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther),
LogSource)
import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE
@@ -35,7 +39,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)
@ -104,11 +105,11 @@ index 140600b..75daabc 100644
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
@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where
defaultLayout w = do
p <- widgetToPageContent w
mmsg <- getMessage
- giveUrlRenderer [hamlet|
- withUrlRenderer [hamlet|
- $newline never
- $doctype 5
- <html>
@ -120,7 +121,7 @@ index 140600b..75daabc 100644
- <p .message>#{msg}
- ^{pageBody p}
- |]
+ giveUrlRenderer $ \ _render_aHra
+ withUrlRenderer $ \ _render_aHra
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<!DOCTYPE html>\n<html><head><title>");
@ -140,11 +141,10 @@ index 140600b..75daabc 100644
+ 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
@@ -374,45 +386,103 @@ widgetToPageContent w = do
@@ -373,45 +384,103 @@ widgetToPageContent w = do
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
-- the asynchronous loader means your page doesn't have to wait for all the js to load
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
@ -287,7 +287,7 @@ index 140600b..75daabc 100644
return $ PageContent title headAll $
case jsLoader master of
@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do
@@ -441,10 +510,13 @@ defaultErrorHandler NotFound = selectRep $ do
r <- waiRequest
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
setTitle "Not Found"
@ -305,7 +305,7 @@ index 140600b..75daabc 100644
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
-- For API requests.
@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do
@@ -454,10 +526,11 @@ defaultErrorHandler NotFound = selectRep $ do
defaultErrorHandler NotAuthenticated = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Not logged in"
@ -321,7 +321,7 @@ index 140600b..75daabc 100644
provideRep $ do
-- 401 *MUST* include a WWW-Authenticate header
@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
@@ -479,10 +552,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Permission Denied"
@ -339,7 +339,7 @@ index 140600b..75daabc 100644
provideRep $
return $ object $ [
"message" .= ("Permission Denied. " <> msg)
@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
@@ -491,30 +567,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Invalid Arguments"
@ -397,7 +397,7 @@ index 140600b..75daabc 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
@@ -653,8 +741,4 @@ loadClientSession key getCachedDate sessionName req = load
-- turn the TH Loc loaction information into a human readable string
-- leaving out the loc_end parameter
fileLocationToString :: Loc -> String
@ -408,7 +408,7 @@ index 140600b..75daabc 100644
- char = show . snd . loc_start
+fileLocationToString loc = "unknown"
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
index e0d1f0e..cc23fdd 100644
index ad56452..d3d58ee 100644
--- a/Yesod/Core/Dispatch.hs
+++ b/Yesod/Core/Dispatch.hs
@@ -1,4 +1,3 @@
@ -445,7 +445,7 @@ index e0d1f0e..cc23fdd 100644
, PathMultiPiece (..)
, Texts
-- * Convert to WAI
@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do
@@ -130,13 +129,6 @@ toWaiAppLogger logger site = do
, yreSite = site
, yreSessionBackend = sb
}
@ -459,10 +459,10 @@ index e0d1f0e..cc23fdd 100644
middleware <- mkDefaultMiddlewares logger
return $ middleware $ toWaiAppYre yre
@@ -170,14 +162,7 @@ warp port site = do
]
-}
, Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
@@ -156,14 +148,7 @@ warp port site = do
Network.Wai.Handler.Warp.setPort port $
Network.Wai.Handler.Warp.setServerName serverValue $
Network.Wai.Handler.Warp.setOnException (\_ e ->
- when (shouldLog' e) $
- messageLoggerSource
- site
@ -470,12 +470,12 @@ index e0d1f0e..cc23fdd 100644
- $(qLocation >>= liftLoc)
- "yesod-core"
- LevelError
- (toLogStr $ "Exception from Warp: " ++ show e)
+ when (shouldLog' e) $ error (show e)
}
- (toLogStr $ "Exception from Warp: " ++ show e)) $
+ when (shouldLog' e) $ error (show e)) $
Network.Wai.Handler.Warp.defaultSettings)
where
shouldLog' =
@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException
@@ -197,7 +182,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
-- | Deprecated synonym for 'warp'.
warpDebug :: YesodDispatch site => Int -> site -> IO ()
warpDebug = warp
@ -484,10 +484,10 @@ index e0d1f0e..cc23fdd 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 2e5d7cb..83f93bf 100644
index 36f8f5c..948de5f 100644
--- a/Yesod/Core/Handler.hs
+++ b/Yesod/Core/Handler.hs
@@ -172,7 +172,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
@@ -171,7 +171,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as TL
import qualified Text.Blaze.Html.Renderer.Text as RenderText
@ -496,7 +496,7 @@ index 2e5d7cb..83f93bf 100644
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
@@ -201,6 +201,7 @@ import Control.Exception (throwIO)
@@ -199,6 +199,7 @@ import Control.Exception (throwIO)
import Blaze.ByteString.Builder (Builder)
import Safe (headMay)
import Data.CaseInsensitive (CI)
@ -504,11 +504,11 @@ index 2e5d7cb..83f93bf 100644
import qualified Data.Conduit.List as CL
import Control.Monad (unless)
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
@@ -847,19 +848,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
@@ -803,19 +804,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
-> m a
redirectToPost url = do
urlText <- toTextUrl url
- giveUrlRenderer [hamlet|
- withUrlRenderer [hamlet|
-$newline never
-$doctype 5
-
@ -521,7 +521,7 @@ index 2e5d7cb..83f93bf 100644
- <p>Javascript has been disabled; please click on the button below to be redirected.
- <input type="submit" value="Continue">
-|] >>= sendResponse
+ giveUrlRenderer $ \ _render_awps
+ withUrlRenderer $ \ _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=\"");
@ -534,20 +534,18 @@ index 2e5d7cb..83f93bf 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 09b4609..e1ef568 100644
index fdb2261..12ed4fc 100644
--- a/Yesod/Core/Internal/Run.hs
+++ b/Yesod/Core/Internal/Run.hs
@@ -16,8 +16,8 @@ import Control.Exception.Lifted (catch)
@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch)
import Control.Monad (mplus)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (LogLevel (LevelError), LogSource,
- liftLoc)
+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource,
+ )
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
liftLoc)
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
@@ -31,7 +31,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Encoding (decodeUtf8With)
@ -556,7 +554,7 @@ index 09b4609..e1ef568 100644
+import Language.Haskell.TH.Syntax (qLocation)
import qualified Network.HTTP.Types as H
import Network.Wai
#if MIN_VERSION_wai(2, 0, 0)
import Network.Wai.Internal
@@ -157,8 +157,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ErrorResponse
-> YesodApp
@ -686,18 +684,18 @@ index 7e84c1c..a273c29 100644
- ]
- return $ LetE [fun] (VarE helper)
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
index 7e3fd0d..994d322 100644
index 4d4474b..61ddb20 100644
--- a/Yesod/Core/Types.hs
+++ b/Yesod/Core/Types.hs
@@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..))
@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase))
import Control.Monad.Catch (MonadCatch (..))
import Control.Monad.Catch (MonadMask (..))
#endif
import Control.Monad.IO.Class (MonadIO (liftIO))
+import qualified Control.Monad.Logger
import Control.Monad.Logger (LogLevel, LogSource,
MonadLogger (..))
import Control.Monad.Trans.Control (MonadBaseControl (..))
@@ -187,7 +188,7 @@ data RunHandlerEnv site = RunHandlerEnv
@@ -174,7 +175,7 @@ data RunHandlerEnv site = RunHandlerEnv
, rheRoute :: !(Maybe (Route site))
, rheSite :: !site
, rheUpload :: !(RequestBodyLength -> FileUpload)
@ -767,5 +765,5 @@ index 481199e..8489fbe 100644
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m))
--
2.0.0
1.7.10.4

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

@ -1,3 +1,17 @@
From 98077d391b930a4c1f69e3b8810409fd261eee34 Mon Sep 17 00:00:00 2001
From: androidbuilder <androidbuilder@example.com>
Date: Tue, 14 Oct 2014 03:17:38 +0000
Subject: [PATCH] expand and remove TH
---
Yesod/Form/Bootstrap3.hs | 186 +++++++++--
Yesod/Form/Fields.hs | 797 +++++++++++++++++++++++++++++++++++-----------
Yesod/Form/Functions.hs | 257 ++++++++++++---
Yesod/Form/Jquery.hs | 134 ++++++--
Yesod/Form/MassInput.hs | 226 ++++++++++---
Yesod/Form/Nic.hs | 46 +--
6 files changed, 1279 insertions(+), 367 deletions(-)
diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs
index 84e85fc..1954fb4 100644
--- a/Yesod/Form/Bootstrap3.hs
@ -215,7 +229,7 @@ index 84e85fc..1954fb4 100644
, fvTooltip = Nothing
, fvId = bootstrapSubmitId
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
index 8173e78..8ee847d 100644
index 8173e78..68a284c 100644
--- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs
@@ -1,4 +1,3 @@
@ -426,10 +440,11 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . renderHtml)
@@ -194,9 +262,17 @@ textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m
@@ -193,10 +261,17 @@ instance ToHtml Textarea where
textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea
textareaField = Field
{ fieldParse = parseHelper $ Right . Textarea
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<textarea id="#{theId}" name="#{name}" :isReq:required="" *{attrs}>#{either id unTextarea val}
-|]
@ -447,7 +462,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -204,10 +280,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
@@ -204,10 +279,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
=> Field m p
hiddenField = Field
{ fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
@ -471,7 +486,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -215,20 +300,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
@@ -215,20 +299,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
textField = Field
{ fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq ->
@ -533,7 +548,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -300,10 +418,24 @@ emailField = Field
@@ -300,10 +417,24 @@ emailField = Field
case Email.canonicalizeEmail $ encodeUtf8 s of
Just e -> Right $ decodeUtf8With lenientDecode e
Nothing -> Left $ MsgInvalidEmail s
@ -562,7 +577,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -318,10 +450,25 @@ multiEmailField = Field
@@ -318,10 +449,25 @@ multiEmailField = Field
in case partitionEithers addrs of
([], good) -> Right good
(bad, _) -> Left $ MsgInvalidEmail $ cat bad
@ -592,7 +607,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
where
@@ -337,20 +484,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus
@@ -337,20 +483,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus
searchField autoFocus = Field
{ fieldParse = parseHelper Right
, fieldView = \theId name attrs val isReq -> do
@ -680,7 +695,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -361,7 +563,28 @@ urlField = Field
@@ -361,7 +562,28 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s
, fieldView = \theId name attrs val isReq ->
@ -710,7 +725,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -374,18 +597,54 @@ selectField :: (Eq a, RenderMessage site FormMessage)
@@ -374,18 +596,54 @@ selectField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a
selectField = selectFieldHelper
@ -777,7 +792,7 @@ index 8173e78..8ee847d 100644
multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
=> [(msg, a)]
@@ -408,11 +667,45 @@ multiSelectField ioptlist =
@@ -408,11 +666,45 @@ multiSelectField ioptlist =
view theId name attrs val isReq = do
opts <- fmap olOptions $ handlerToWidget ioptlist
let selOpts = map (id &&& (optselected val)) opts
@ -828,7 +843,7 @@ index 8173e78..8ee847d 100644
where
optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
@@ -435,54 +728,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
@@ -435,54 +727,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
opts <- fmap olOptions $ handlerToWidget ioptlist
let optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
@ -976,9 +991,6 @@ index 8173e78..8ee847d 100644
- <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 { condH
+ [(not isReq,
+ do { (asWidgetT . toWidget)
@ -1056,13 +1068,16 @@ index 8173e78..8ee847d 100644
+ (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
@@ -508,10 +943,24 @@ $newline never
@@ -508,10 +942,24 @@ $newline never
checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
checkBoxField = Field
{ fieldParse = \e _ -> return $ checkBoxParser e
@ -1091,7 +1106,59 @@ index 8173e78..8ee847d 100644
, fieldEnctype = UrlEncoded
}
@@ -642,9 +1091,21 @@ fileField = Field
@@ -555,51 +1003,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 (PersistEntityBackend a)
- , PathPiece (Key a)
- , RenderMessage site msg
- , YesodPersistBackend site ~ PersistEntityBackend a
- )
- => [Filter a]
- -> [SelectOpt a]
- -> (a -> msg)
- -> HandlerT site IO (OptionList (Entity a))
-optionsPersist filts ords toDisplay = fmap mkOptionList $ do
- mr <- getMessageRender
- pairs <- runDB $ selectList filts ords
- return $ map (\(Entity key value) -> Option
- { optionDisplay = mr (toDisplay value)
- , optionInternalValue = Entity key value
- , optionExternalValue = toPathPiece key
- }) pairs
-
--- | An alternative to 'optionsPersist' which returns just the @Key@ instead of
--- the entire @Entity@.
---
--- Since 1.3.2
-optionsPersistKey
- :: (YesodPersist site
- , PersistEntity a
- , PersistQuery (PersistEntityBackend a)
- , PathPiece (Key a)
- , RenderMessage site msg
- , YesodPersistBackend site ~ PersistEntityBackend a
- )
- => [Filter a]
- -> [SelectOpt a]
- -> (a -> msg)
- -> HandlerT site IO (OptionList (Key a))
-
-optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do
- mr <- getMessageRender
- pairs <- runDB $ selectList filts ords
- return $ map (\(Entity key value) -> Option
- { optionDisplay = mr (toDisplay value)
- , optionInternalValue = key
- , optionExternalValue = toPathPiece key
- }) pairs
-
selectFieldHelper
:: (Eq a, RenderMessage site FormMessage)
=> (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ())
@@ -642,9 +1045,21 @@ fileField = Field
case files of
[] -> Right Nothing
file:_ -> Right $ Just file
@ -1116,7 +1183,7 @@ index 8173e78..8ee847d 100644
, fieldEnctype = Multipart
}
@@ -671,10 +1132,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
@@ -671,10 +1086,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage site langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs
, fvId = id'
@ -1140,7 +1207,7 @@ index 8173e78..8ee847d 100644
, fvErrors = errs
, fvRequired = True
}
@@ -703,10 +1173,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
@@ -703,10 +1127,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id'
@ -1969,3 +2036,6 @@ index 2862678..7a0f25a 100644
-addScript' f = do
- y <- getYesod
- addScriptEither $ f y
--
1.7.10.4

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

@ -1,23 +1,23 @@
From 92a34bc2b09572a58a4e696e0d8a0a61475535f7 Mon Sep 17 00:00:00 2001
From 85917e8b5da3c67c6ca0791fdad735ffb864ae3b Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Tue, 10 Jun 2014 19:09:56 +0000
Subject: [PATCH] do not really build
Date: Tue, 14 Oct 2014 02:50:19 +0000
Subject: [PATCH] not needed
---
yesod-persistent.cabal | 10 ----------
yesod-persistent.cabal | 10 ----------
1 file changed, 10 deletions(-)
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
index b44499b..ef33863 100644
index 2e5735d..438c76d 100644
--- a/yesod-persistent.cabal
+++ b/yesod-persistent.cabal
@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod.
library
build-depends: base >= 4 && < 5
- , yesod-core >= 1.2.2 && < 1.3
- , persistent >= 1.2 && < 1.4
- , persistent-template >= 1.2 && < 1.4
- , yesod-core >= 1.4.0 && < 1.5
- , persistent >= 2.1 && < 2.2
- , persistent-template >= 2.1 && < 2.2
- , transformers >= 0.2.2
- , blaze-builder
- , conduit
@ -29,5 +29,5 @@ index b44499b..ef33863 100644
test-suite test
--
2.0.0
1.7.10.4

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

@ -1,13 +1,13 @@
From da032b804c0a35c2831664e28c9211f4fe712593 Mon Sep 17 00:00:00 2001
From 1d12efe6c85c57bce44d0cd9389c5538f36f599e Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Tue, 10 Jun 2014 20:39:42 +0000
Subject: [PATCH] avoid TH
Date: Tue, 14 Oct 2014 03:40:28 +0000
Subject: [PATCH] hack to build
---
Yesod.hs | 19 ++++++++++++--
Yesod/Default/Main.hs | 32 +-----------------------
Yesod/Default/Util.hs | 69 ++-------------------------------------------------
3 files changed, 20 insertions(+), 100 deletions(-)
Yesod.hs | 19 ++++++++++++--
Yesod/Default/Main.hs | 27 +------------------
Yesod/Default/Util.hs | 69 ++-----------------------------------------------
3 files changed, 20 insertions(+), 95 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 565ed35..41c2df0 100644
index 44e094e..41c2df0 100644
--- a/Yesod/Default/Main.hs
+++ b/Yesod/Default/Main.hs
@@ -1,10 +1,8 @@
@ -64,7 +64,7 @@ index 565ed35..41c2df0 100644
import System.Log.FastLogger (LogStr, toLogStr)
import Language.Haskell.TH.Syntax (qLocation)
@@ -55,34 +53,6 @@ defaultMain load getApp = do
@@ -55,29 +53,6 @@ defaultMain load getApp = do
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
@ -89,12 +89,7 @@ index 565ed35..41c2df0 100644
- (toLogStr $ "Exception from Warp: " ++ show e)
- } app
- where
- shouldLog' =
-#if MIN_VERSION_warp(2,1,3)
- Warp.defaultShouldDisplayException
-#else
- const True
-#endif
- shouldLog' = Warp.defaultShouldDisplayException
-
-- | Run your application continously, listening for SIGINT and exiting
-- when received
@ -196,5 +191,5 @@ index a10358e..0547424 100644
- else return $ Just ex
- else return Nothing
--
2.0.0
1.7.10.4