diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-07-02 23:04:35 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-07-02 23:04:35 -0400 |
commit | ba77c902bc7c83eefe73058cbcd82435562ef34f (patch) | |
tree | d39553b361edd253ac811fba00d4730f3017d83b /standalone | |
parent | 0bf027f0a2abe492b12cd12d94379e92ced24c59 (diff) | |
parent | d6afecc10c1d647daebac46f2cba26d646a9e308 (diff) |
Merge orca:/tmp/android
Diffstat (limited to 'standalone')
17 files changed, 1907 insertions, 644 deletions
diff --git a/standalone/android/haskell-patches/dns_use-android-net.dns1-command-instead-of-resolv.conf.patch b/standalone/android/haskell-patches/dns_use-android-net.dns1-command-instead-of-resolv.conf.patch index 962a64207..2b23c6d24 100644 --- a/standalone/android/haskell-patches/dns_use-android-net.dns1-command-instead-of-resolv.conf.patch +++ b/standalone/android/haskell-patches/dns_use-android-net.dns1-command-instead-of-resolv.conf.patch @@ -1,6 +1,6 @@ -From 087f1ae5e17f0e6d7c9f6b4092a5bb5bb6f5bf60 Mon Sep 17 00:00:00 2001 +From e5072d9b721cc25fa1017df97d71bf926a78d4e5 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:59:11 +0000 +Date: Fri, 3 Jul 2015 02:24:19 +0000 Subject: [PATCH] port --- @@ -9,48 +9,48 @@ Subject: [PATCH] port 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs -index 5721e03..c4400d1 100644 +index 31f6373..6487c7b 100644 --- a/Network/DNS/Resolver.hs +++ b/Network/DNS/Resolver.hs -@@ -19,7 +19,7 @@ module Network.DNS.Resolver ( +@@ -18,7 +18,7 @@ module Network.DNS.Resolver ( + , fromDNSFormat ) where - 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(..), defaultHints, getAddrInfo + import Data.Maybe (fromMaybe) +@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber( import Prelude hiding (lookup) import System.Random (getStdRandom, randomR) import System.Timeout (timeout) +import System.Process - #if mingw32_HOST_OS == 1 - import Network.Socket (send) -@@ -130,10 +131,12 @@ makeResolvSeed conf = ResolvSeed <$> addr - where + #if __GLASGOW_HASKELL__ < 709 + import Control.Applicative ((<$>), (<*>), pure) +@@ -136,10 +137,12 @@ makeResolvSeed conf = ResolvSeed <$> addr addr = case resolvInfo conf of - RCHostName numhost -> makeAddrInfo numhost -- RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo + RCHostName numhost -> makeAddrInfo numhost Nothing + RCHostPort numhost mport -> makeAddrInfo numhost $ Just mport +- RCFilePath file -> toAddr <$> readFile file >>= \i -> makeAddrInfo i Nothing - toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs - in extract l - extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11 + RCFilePath file -> do + -- Android has no /etc/resolv.conf; use getprop command. + ls <- catch (lines <$> readProcess "getprop" ["net.dns1"] []) (const (return []) :: IOException -> IO [String]) -+ makeAddrInfo $ case ls of ++ flip makeAddrInfo Nothing $ case ls of + [] -> "8.8.8.8" -- google public dns as a fallback only + (l:_) -> l - makeAddrInfo :: HostName -> IO AddrInfo - makeAddrInfo addr = do + makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo + makeAddrInfo addr mport = do diff --git a/dns.cabal b/dns.cabal -index ceaf5f4..cd15e61 100644 +index 0745754..8cf4b67 100644 --- a/dns.cabal +++ b/dns.cabal -@@ -37,6 +37,7 @@ Library +@@ -39,6 +39,7 @@ Library , network >= 2.3 , random , resourcet @@ -59,5 +59,5 @@ index ceaf5f4..cd15e61 100644 Build-Depends: base >= 4 && < 5 , attoparsec -- -2.1.1 +2.1.4 diff --git a/standalone/android/haskell-patches/iproute_1.2.11_0001-build-without-IPv6-stuff.patch b/standalone/android/haskell-patches/iproute_1.2.11_0001-build-without-IPv6-stuff.patch index bb9caec77..13cfbd232 100644 --- a/standalone/android/haskell-patches/iproute_1.2.11_0001-build-without-IPv6-stuff.patch +++ b/standalone/android/haskell-patches/iproute_1.2.11_0001-build-without-IPv6-stuff.patch @@ -1,31 +1,31 @@ -From 7beec2e707d59f9573aa2dc7c57bd2a62f16b480 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Wed, 15 May 2013 19:06:03 -0400 +From b2b88224426fe6c7c72ebdec2946fd1ddbacbfaf Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 2 Jul 2015 20:42:50 +0000 Subject: [PATCH] build without IPv6 stuff --- - Data/IP.hs | 2 +- - Data/IP/Addr.hs | 3 +++ + Data/IP.hs | 2 +- + Data/IP/Addr.hs | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/Data/IP.hs b/Data/IP.hs -index cffef93..ea486c9 100644 +index 306a488..e3f252e 100644 --- a/Data/IP.hs +++ b/Data/IP.hs @@ -6,7 +6,7 @@ module Data.IP ( -- ** IP data IP (..) , IPv4, toIPv4, fromIPv4, fromHostAddress, toHostAddress -- , IPv6, toIPv6, fromIPv6, fromHostAddress6, toHostAddress6 -+ , IPv6, toIPv6, fromIPv6 -- , fromHostAddress6, toHostAddress6 +- , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b, fromHostAddress6, toHostAddress6 ++ , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b -- , fromHostAddress6, toHostAddress6 -- ** IP range data , IPRange (..) , AddrRange (addr, mask, mlen) diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs -index faaf0c7..5b556fb 100644 +index 8d4131e..868a572 100644 --- a/Data/IP/Addr.hs +++ b/Data/IP/Addr.hs -@@ -312,6 +312,7 @@ toHostAddress (IP4 addr4) +@@ -376,6 +376,7 @@ toHostAddress (IP4 addr4) | byteOrder == LittleEndian = fixByteOrder addr4 | otherwise = addr4 @@ -33,7 +33,7 @@ index faaf0c7..5b556fb 100644 -- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'. fromHostAddress6 :: HostAddress6 -> IPv6 fromHostAddress6 = IP6 -@@ -320,6 +321,8 @@ fromHostAddress6 = IP6 +@@ -384,6 +385,8 @@ fromHostAddress6 = IP6 toHostAddress6 :: IPv6 -> HostAddress6 toHostAddress6 (IP6 addr6) = addr6 @@ -43,5 +43,5 @@ index faaf0c7..5b556fb 100644 fixByteOrder s = d1 .|. d2 .|. d3 .|. d4 where -- -1.7.10.4 +2.1.4 diff --git a/standalone/android/haskell-patches/network_2.4.1.0_0002-remove-Network.BSD-symbols-not-available-in-bionic.patch b/standalone/android/haskell-patches/network_2.4.1.0_0002-remove-Network.BSD-symbols-not-available-in-bionic.patch index 5b07f233b..e4ebc3ef4 100644 --- a/standalone/android/haskell-patches/network_2.4.1.0_0002-remove-Network.BSD-symbols-not-available-in-bionic.patch +++ b/standalone/android/haskell-patches/network_2.4.1.0_0002-remove-Network.BSD-symbols-not-available-in-bionic.patch @@ -1,17 +1,17 @@ -From 7861b133bb269b50fcf709291449cb0473818902 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Sun, 29 Dec 2013 21:29:23 +0000 +From 508b4701c1610d9772564b97a74b5fa01dab48e2 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 2 Jul 2015 20:12:59 +0000 Subject: [PATCH] remove Network.BSD symbols not available in bionic --- - Network/BSD.hsc | 98 ------------------------------------------------------- - 1 file changed, 98 deletions(-) + Network/BSD.hsc | 100 -------------------------------------------------------- + 1 file changed, 100 deletions(-) diff --git a/Network/BSD.hsc b/Network/BSD.hsc -index d6dae85..27910f4 100644 +index b5e9a26..f085f2a 100644 --- a/Network/BSD.hsc +++ b/Network/BSD.hsc -@@ -30,15 +30,6 @@ module Network.BSD +@@ -27,15 +27,6 @@ module Network.BSD , getHostByAddr , hostAddress @@ -27,7 +27,7 @@ index d6dae85..27910f4 100644 -- * Service names , ServiceEntry(..) , ServiceName -@@ -64,14 +55,6 @@ module Network.BSD +@@ -61,14 +52,6 @@ module Network.BSD , getProtocolNumber , defaultProtocol @@ -42,7 +42,7 @@ index d6dae85..27910f4 100644 -- * Port numbers , PortNumber -@@ -83,11 +66,7 @@ module Network.BSD +@@ -80,11 +63,7 @@ module Network.BSD #if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) , getNetworkByName , getNetworkByAddr @@ -52,9 +52,9 @@ index d6dae85..27910f4 100644 - , getNetworkEntry - , endNetworkEntry #endif - ) where -@@ -303,31 +282,6 @@ getProtocolNumber proto = do + #if defined(HAVE_IF_NAMETOINDEX) +@@ -298,31 +277,6 @@ getProtocolNumber proto = do (ProtocolEntry _ _ num) <- getProtocolByName proto return num @@ -62,18 +62,18 @@ index d6dae85..27910f4 100644 -getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB -getProtocolEntry = withLock $ do - ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry" -- $ trySysCall c_getprotoent +- $ c_getprotoent - peek ent - -foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry) - -setProtocolEntry :: Bool -> IO () -- Keep DB Open ? --setProtocolEntry flg = withLock $ trySysCall $ c_setprotoent (fromBool flg) +-setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg) - -foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO () - -endProtocolEntry :: IO () --endProtocolEntry = withLock $ trySysCall $ c_endprotoent +-endProtocolEntry = withLock $ c_endprotoent - -foreign import ccall unsafe "endprotoent" c_endprotoent :: IO () - @@ -86,7 +86,7 @@ index d6dae85..27910f4 100644 -- --------------------------------------------------------------------------- -- Host lookups -@@ -402,31 +356,6 @@ getHostByAddr family addr = do +@@ -397,31 +351,6 @@ getHostByAddr family addr = do foreign import CALLCONV safe "gethostbyaddr" c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry) @@ -94,13 +94,13 @@ index d6dae85..27910f4 100644 -getHostEntry :: IO HostEntry -getHostEntry = withLock $ do - throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry" -- $ trySysCall $ c_gethostent +- $ c_gethostent - >>= peek - -foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry) - -setHostEntry :: Bool -> IO () --setHostEntry flg = withLock $ trySysCall $ c_sethostent (fromBool flg) +-setHostEntry flg = withLock $ c_sethostent (fromBool flg) - -foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO () - @@ -118,14 +118,14 @@ index d6dae85..27910f4 100644 -- --------------------------------------------------------------------------- -- Accessing network information -@@ -488,33 +417,6 @@ getNetworkByAddr addr family = withLock $ do +@@ -483,35 +412,6 @@ getNetworkByAddr addr family = withLock $ do foreign import ccall unsafe "getnetbyaddr" c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry) -getNetworkEntry :: IO NetworkEntry -getNetworkEntry = withLock $ do - throwNoSuchThingIfNull "getNetworkEntry" "no more network entries" -- $ trySysCall $ c_getnetent +- $ c_getnetent - >>= peek - -foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry) @@ -134,13 +134,13 @@ index d6dae85..27910f4 100644 --- whether a connection is maintained open between various --- networkEntry calls -setNetworkEntry :: Bool -> IO () --setNetworkEntry flg = withLock $ trySysCall $ c_setnetent (fromBool flg) +-setNetworkEntry flg = withLock $ c_setnetent (fromBool flg) - -foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO () - --- | Close the connection to the network name database. -endNetworkEntry :: IO () --endNetworkEntry = withLock $ trySysCall $ c_endnetent +-endNetworkEntry = withLock $ c_endnetent - -foreign import ccall unsafe "endnetent" c_endnetent :: IO () - @@ -149,9 +149,11 @@ index d6dae85..27910f4 100644 -getNetworkEntries stayOpen = do - setNetworkEntry stayOpen - getEntries (getNetworkEntry) (endNetworkEntry) - #endif +-#endif +- + -- --------------------------------------------------------------------------- + -- Interface names - -- Mutex for name service lockdown -- -1.7.10.4 +2.1.4 diff --git a/standalone/android/haskell-patches/network_2.4.1.0_0003-configure-misdetects-accept4.patch b/standalone/android/haskell-patches/network_2.4.1.0_0003-configure-misdetects-accept4.patch index 084d355ba..932bfe3da 100644 --- a/standalone/android/haskell-patches/network_2.4.1.0_0003-configure-misdetects-accept4.patch +++ b/standalone/android/haskell-patches/network_2.4.1.0_0003-configure-misdetects-accept4.patch @@ -1,6 +1,6 @@ -From 478fc7ae42030c1345e75727e54e1f8f895d3e22 Mon Sep 17 00:00:00 2001 +From 21af25e922b00171c07f951a235ff7d7edbbd2be Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Wed, 15 Oct 2014 15:16:21 +0000 +Date: Thu, 2 Jul 2015 20:14:40 +0000 Subject: [PATCH] avoid accept4 --- @@ -8,19 +8,19 @@ Subject: [PATCH] avoid accept4 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Network/Socket.hsc b/Network/Socket.hsc -index 2fe62ee..94db7a4 100644 +index 6553bfc..802a7e9 100644 --- a/Network/Socket.hsc +++ b/Network/Socket.hsc -@@ -511,7 +511,7 @@ accept sock@(MkSocket s family stype protocol status) = do +@@ -489,7 +489,7 @@ accept sock@(MkSocket s family stype protocol status) = do + return new_sock #else with (fromIntegral sz) $ \ ptr_len -> do - new_sock <- -# ifdef HAVE_ACCEPT4 +#if 0 - throwSocketErrorIfMinus1RetryMayBlock "accept" + new_sock <- throwSocketErrorIfMinus1RetryMayBlock "accept" (threadWaitRead (fromIntegral s)) (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK)) -@@ -1602,7 +1602,7 @@ foreign import CALLCONV SAFE_ON_WIN "connect" +@@ -1565,7 +1565,7 @@ foreign import CALLCONV SAFE_ON_WIN "connect" c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV unsafe "accept" c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt @@ -30,5 +30,5 @@ index 2fe62ee..94db7a4 100644 c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt #endif -- -2.1.1 +2.1.4 diff --git a/standalone/android/haskell-patches/network_2.4.1.0_0006-build-fixes.patch b/standalone/android/haskell-patches/network_2.4.1.0_0006-build-fixes.patch new file mode 100644 index 000000000..f7cf7c747 --- /dev/null +++ b/standalone/android/haskell-patches/network_2.4.1.0_0006-build-fixes.patch @@ -0,0 +1,24 @@ +From cf110acc7f5863bb80ba835a009a7f59d3453239 Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Thu, 2 Jul 2015 20:19:14 +0000 +Subject: [PATCH] fix build + +--- + Network/BSD.hsc | 1 - + 1 file changed, 1 deletion(-) + +diff --git a/Network/BSD.hsc b/Network/BSD.hsc +index e11ac71..039d0f1 100644 +--- a/Network/BSD.hsc ++++ b/Network/BSD.hsc +@@ -396,7 +396,6 @@ instance Storable NetworkEntry where + poke _p = error "Storable.poke(BSD.NetEntry) not implemented" + + +-#if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32) + getNetworkByName :: NetworkName -> IO NetworkEntry + getNetworkByName name = withLock $ do + withCString name $ \ name_cstr -> do +-- +2.1.4 + diff --git a/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch b/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch index 16c4f92a2..3f7d2aae7 100644 --- a/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch +++ b/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch @@ -1,6 +1,6 @@ -From db9eb179885874af342bb2c3adef7185496ba1f1 Mon Sep 17 00:00:00 2001 +From da127aa3b2c6cbf679950eb593eb8c88384cc26b Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Wed, 15 Oct 2014 16:37:32 +0000 +Date: Thu, 2 Jul 2015 20:34:05 +0000 Subject: [PATCH] hack for bionic --- @@ -9,10 +9,10 @@ Subject: [PATCH] hack for bionic 2 files changed, 1 insertion(+), 13 deletions(-) diff --git a/Data/UnixTime/Types.hsc b/Data/UnixTime/Types.hsc -index d30f39b..ec7ca4c 100644 +index 6253b27..fb5b3fa 100644 --- a/Data/UnixTime/Types.hsc +++ b/Data/UnixTime/Types.hsc -@@ -9,8 +9,6 @@ import Foreign.Storable +@@ -12,8 +12,6 @@ import Data.Binary #include <sys/time.h> @@ -20,8 +20,8 @@ index d30f39b..ec7ca4c 100644 - -- | -- Data structure for Unix time. - data UnixTime = UnixTime { -@@ -20,16 +18,6 @@ data UnixTime = UnixTime { + -- +@@ -33,16 +31,6 @@ data UnixTime = UnixTime { , utMicroSeconds :: {-# UNPACK #-} !Int32 } deriving (Eq,Ord,Show) @@ -35,14 +35,14 @@ index d30f39b..ec7ca4c 100644 - (#poke struct timeval, tv_sec) ptr (utSeconds ut) - (#poke struct timeval, tv_usec) ptr (utMicroSeconds ut) - - -- | - -- Format of the strptime()/strftime() style. - type Format = ByteString + #if __GLASGOW_HASKELL__ >= 704 + 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 @@ -52,5 +52,5 @@ index ec31fef..b7bc0f9 100644 size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) { -- -2.1.1 +2.1.4 diff --git a/standalone/android/haskell-patches/uuid_build-without-v1-uuid-which-needs-network-info.patch b/standalone/android/haskell-patches/uuid_build-without-v1-uuid-which-needs-network-info.patch index 12cb2a922..048a87fab 100644 --- a/standalone/android/haskell-patches/uuid_build-without-v1-uuid-which-needs-network-info.patch +++ b/standalone/android/haskell-patches/uuid_build-without-v1-uuid-which-needs-network-info.patch @@ -1,16 +1,15 @@ -From 87283f9b6f992a7f0e36c7b1bafc288bf2bf106a Mon Sep 17 00:00:00 2001 -From: androidbuilder <androidbuilder@example.com> -Date: Mon, 11 Nov 2013 02:46:27 +0000 -Subject: [PATCH] build without v1 uuid which needs network-ino +From 04a1230cf4d740d37ab427165eef4b4db2a3898f Mon Sep 17 00:00:00 2001 +From: dummy <dummy@example.com> +Date: Fri, 3 Jul 2015 02:20:42 +0000 +Subject: [PATCH] build without v1 uuid which needs network-info --- - Data/UUID/Util.hs | 11 ----------- - Data/UUID/V1.hs | 2 -- - uuid.cabal | 2 -- - 3 files changed, 15 deletions(-) + Data/UUID/Util.hs | 11 ----------- + uuid.cabal | 2 -- + 2 files changed, 13 deletions(-) diff --git a/Data/UUID/Util.hs b/Data/UUID/Util.hs -index 581391a..399e508 100644 +index 8817f51..0d43b01 100644 --- a/Data/UUID/Util.hs +++ b/Data/UUID/Util.hs @@ -3,7 +3,6 @@ module Data.UUID.Util ( @@ -24,49 +23,37 @@ index 581391a..399e508 100644 @@ -13,7 +12,6 @@ import Data.Word import Data.Word.Util import Data.Bits - import Data.UUID.Internal + import Data.UUID.Types.Internal -import Network.Info import Data.Int (Int64) version :: UUID -> Int -@@ -43,12 +41,3 @@ extractTime uuid = +@@ -42,12 +40,3 @@ extractTime uuid = + timeAndVersionToTime :: Word16 -> Word16 timeAndVersionToTime tv = tv .&. 0x0FFF - +- -extractMac :: UUID -> Maybe MAC --extractMac uuid = +-extractMac uuid = - if version uuid == 1 -- then Just $ +- then Just $ - MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked) - else Nothing - where - unpacked = unpack uuid -- -diff --git a/Data/UUID/V1.hs b/Data/UUID/V1.hs -index 067e729..ca4c235 100644 ---- a/Data/UUID/V1.hs -+++ b/Data/UUID/V1.hs -@@ -37,8 +37,6 @@ import System.IO.Unsafe - - import qualified System.Random as R - --import Network.Info -- - import Data.UUID.Builder - import Data.UUID.Internal - diff --git a/uuid.cabal b/uuid.cabal -index 0a53059..57b1b86 100644 +index 2fa548b..9d86fd2 100644 --- a/uuid.cabal +++ b/uuid.cabal -@@ -32,14 +32,12 @@ Library +@@ -30,7 +30,6 @@ Library + binary >= 0.4 && < 0.8, + bytestring >= 0.9 && < 0.11, cryptohash >= 0.7 && < 0.12, - deepseq == 1.3.*, - hashable (>= 1.1.1.0 && < 1.2.0) || (>= 1.2.1 && < 1.3), - network-info == 0.2.*, - random >= 1.0.1 && < 1.1, - time >= 1.1 && < 1.5 - + random >= 1.0.1 && < 1.2, + time >= 1.1 && < 1.6, + uuid-types >= 1.0 && < 2 +@@ -38,7 +37,6 @@ Library Exposed-Modules: Data.UUID Data.UUID.Util @@ -75,5 +62,5 @@ index 0a53059..57b1b86 100644 Data.UUID.V4 Data.UUID.V5 -- -1.7.10.4 +2.1.4 diff --git a/standalone/android/haskell-patches/warp_avoid-ipv6-for-android.patch b/standalone/android/haskell-patches/warp_avoid-ipv6-for-android.patch new file mode 100644 index 000000000..6144aa0fa --- /dev/null +++ b/standalone/android/haskell-patches/warp_avoid-ipv6-for-android.patch @@ -0,0 +1,39 @@ +From a33437e3150fb33d2fd22d29ff196be28a81c747 Mon Sep 17 00:00:00 2001 +From: androidbuilder <androidbuilder@example.com> +Date: Thu, 2 Jul 2015 21:48:18 +0000 +Subject: [PATCH] avoid ipv6 for android + +--- + Network/Wai/Handler/Warp/Run.hs | 9 +-------- + 1 file changed, 1 insertion(+), 8 deletions(-) + +diff --git a/Network/Wai/Handler/Warp/Run.hs b/Network/Wai/Handler/Warp/Run.hs +index 34ae455..ea7475c 100644 +--- a/Network/Wai/Handler/Warp/Run.hs ++++ b/Network/Wai/Handler/Warp/Run.hs +@@ -14,7 +14,7 @@ import Control.Monad (when, unless, void) + import Data.ByteString (ByteString) + import qualified Data.ByteString as S + import Data.Char (chr) +-import Data.IP (toHostAddress, toHostAddress6) ++import Data.IP (toHostAddress) + import Data.IORef (IORef, newIORef, readIORef, writeIORef) + import Data.Streaming.Network (bindPortTCP) + import Network (sClose, Socket) +@@ -323,13 +323,6 @@ serveConnection conn ii origAddr transport settings app = do + [a] -> Just (SockAddrInet (readInt clientPort) + (toHostAddress a)) + _ -> Nothing +- ["PROXY","TCP6",clientAddr,_,clientPort,_] -> +- case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of +- [a] -> Just (SockAddrInet6 (readInt clientPort) +- 0 +- (toHostAddress6 a) +- 0) +- _ -> Nothing + ("PROXY":"UNKNOWN":_) -> + Just origAddr + _ -> +-- +2.1.4 + diff --git a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch index 6d17d634e..8009d92f9 100644 --- a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch +++ b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch @@ -1,6 +1,6 @@ -From e54cfacbb9fb24f75d3d93cd8ee6da67b161574f Mon Sep 17 00:00:00 2001 +From 6d4a7c63d737c9215ee55996715250c89f14c398 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:51:28 +0000 +Date: Fri, 3 Jul 2015 01:36:31 +0000 Subject: [PATCH] remove TH --- @@ -10,7 +10,7 @@ Subject: [PATCH] remove TH 3 files changed, 306 insertions(+), 46 deletions(-) diff --git a/DAV.cabal b/DAV.cabal -index 95fffd8..5669c51 100644 +index f78c2e5..1ec4d80 100644 --- a/DAV.cabal +++ b/DAV.cabal @@ -47,33 +47,7 @@ library @@ -27,7 +27,7 @@ index 95fffd8..5669c51 100644 - , containers - , data-default - , either >= 4.3 -- , errors +- , errors < 2.0 - , exceptions - , http-client >= 0.2 - , http-client-tls >= 0.2 @@ -49,7 +49,7 @@ index 95fffd8..5669c51 100644 source-repository head type: git diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs -index 4c6d68f..55979b6 100644 +index 5d5d6fd..7265d42 100644 --- a/Network/Protocol/HTTP/DAV.hs +++ b/Network/Protocol/HTTP/DAV.hs @@ -82,6 +82,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho @@ -416,5 +416,5 @@ index 0ecd476..1653bf6 100644 + Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg)) +{-# INLINE userAgent #-} -- -2.1.1 +2.1.4 diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch index bc453bfa1..9b15c0448 100644 --- a/standalone/no-th/haskell-patches/lens_no-TH.patch +++ b/standalone/no-th/haskell-patches/lens_no-TH.patch @@ -1,20 +1,20 @@ -From 10c9ade98b3ac2054947f411d77db2eb28896b9f Mon Sep 17 00:00:00 2001 +From 88ff2174944daf90530a33ee06e2e3f667089b6a Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 01:43:10 +0000 -Subject: [PATCH] avoid TH +Date: Fri, 3 Jul 2015 02:06:43 +0000 +Subject: [PATCH] remove TH --- - lens.cabal | 17 +---------------- - src/Control/Lens.hs | 8 ++------ + lens.cabal | 16 +--------------- + src/Control/Lens.hs | 6 ++---- src/Control/Lens/Cons.hs | 2 -- src/Control/Lens/Internal/Fold.hs | 2 -- src/Control/Lens/Operators.hs | 2 +- src/Control/Lens/Prism.hs | 2 -- src/Control/Monad/Primitive/Lens.hs | 1 - - 7 files changed, 4 insertions(+), 30 deletions(-) + 7 files changed, 4 insertions(+), 27 deletions(-) diff --git a/lens.cabal b/lens.cabal -index 5388301..d7b02b9 100644 +index c7f6009..ab206c5 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional @@ -26,15 +26,7 @@ index 5388301..d7b02b9 100644 -- build-tools: cpphs tested-with: GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2 synopsis: Lenses, Folds and Traversals -@@ -217,7 +217,6 @@ library - Control.Exception.Lens - Control.Lens - Control.Lens.Action -- Control.Lens.At - Control.Lens.Combinators - Control.Lens.Cons - Control.Lens.Each -@@ -234,8 +233,6 @@ library +@@ -230,8 +230,6 @@ library Control.Lens.Internal.Context Control.Lens.Internal.Deque Control.Lens.Internal.Exception @@ -43,7 +35,7 @@ index 5388301..d7b02b9 100644 Control.Lens.Internal.Fold Control.Lens.Internal.Getter Control.Lens.Internal.Indexed -@@ -247,25 +244,21 @@ library +@@ -243,25 +241,21 @@ library Control.Lens.Internal.Reflection Control.Lens.Internal.Review Control.Lens.Internal.Setter @@ -69,7 +61,7 @@ index 5388301..d7b02b9 100644 Control.Monad.Primitive.Lens Control.Parallel.Strategies.Lens Control.Seq.Lens -@@ -291,12 +284,8 @@ library +@@ -287,12 +281,8 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens @@ -82,7 +74,7 @@ index 5388301..d7b02b9 100644 Numeric.Lens other-modules: -@@ -403,7 +392,6 @@ test-suite doctests +@@ -395,7 +385,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, @@ -90,7 +82,7 @@ index 5388301..d7b02b9 100644 mtl, nats, parallel, -@@ -441,7 +429,6 @@ benchmark plated +@@ -433,7 +422,6 @@ benchmark plated comonad, criterion, deepseq, @@ -98,7 +90,7 @@ index 5388301..d7b02b9 100644 lens, transformers -@@ -476,7 +463,6 @@ benchmark unsafe +@@ -468,7 +456,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, @@ -106,7 +98,7 @@ index 5388301..d7b02b9 100644 lens, transformers -@@ -493,6 +479,5 @@ benchmark zipper +@@ -485,6 +472,5 @@ benchmark zipper comonads-fd, criterion, deepseq, @@ -114,18 +106,10 @@ index 5388301..d7b02b9 100644 lens, transformers diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs -index 7e15267..433f1fc 100644 +index d879c58..3d6015b 100644 --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs -@@ -41,7 +41,6 @@ - ---------------------------------------------------------------------------- - module Control.Lens - ( module Control.Lens.Action -- , module Control.Lens.At - , module Control.Lens.Cons - , module Control.Lens.Each - , module Control.Lens.Empty -@@ -53,12 +52,11 @@ module Control.Lens +@@ -56,12 +56,11 @@ module Control.Lens , module Control.Lens.Lens , module Control.Lens.Level , module Control.Lens.Loupe @@ -139,15 +123,7 @@ index 7e15267..433f1fc 100644 , module Control.Lens.TH #endif , module Control.Lens.Traversal -@@ -69,7 +67,6 @@ module Control.Lens - ) where - - import Control.Lens.Action --import Control.Lens.At - import Control.Lens.Cons - import Control.Lens.Each - import Control.Lens.Empty -@@ -81,12 +78,11 @@ import Control.Lens.Iso +@@ -83,12 +82,11 @@ import Control.Lens.Iso import Control.Lens.Lens import Control.Lens.Level import Control.Lens.Loupe @@ -162,12 +138,12 @@ index 7e15267..433f1fc 100644 #endif import Control.Lens.Traversal diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs -index a80e9c8..7d27b80 100644 +index 7b35db4..269f307 100644 --- a/src/Control/Lens/Cons.hs +++ b/src/Control/Lens/Cons.hs -@@ -55,8 +55,6 @@ import Data.Vector.Unboxed (Unbox) - import qualified Data.Vector.Unboxed as Unbox +@@ -56,8 +56,6 @@ import qualified Data.Vector.Unboxed as Unbox import Data.Word + import Prelude -{-# ANN module "HLint: ignore Eta reduce" #-} - @@ -175,12 +151,12 @@ index a80e9c8..7d27b80 100644 -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs -index ab09c6b..43aa905 100644 +index 4bbde21..16295f4 100644 --- a/src/Control/Lens/Internal/Fold.hs +++ b/src/Control/Lens/Internal/Fold.hs -@@ -37,8 +37,6 @@ import Data.Maybe - import Data.Semigroup hiding (Min, getMin, Max, getMax) +@@ -35,8 +35,6 @@ import Data.Semigroup hiding (Min, getMin, Max, getMax) import Data.Reflection + import Prelude -{-# ANN module "HLint: ignore Avoid lambda" #-} - @@ -188,10 +164,10 @@ index ab09c6b..43aa905 100644 -- Folding ------------------------------------------------------------------------------ diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs -index 9992e63..631e8e6 100644 +index 302f68e..1625fe5 100644 --- a/src/Control/Lens/Operators.hs +++ b/src/Control/Lens/Operators.hs -@@ -111,7 +111,7 @@ module Control.Lens.Operators +@@ -104,7 +104,7 @@ module Control.Lens.Operators , (<#~) , (<#=) -- * "Control.Lens.Plated" @@ -201,12 +177,12 @@ index 9992e63..631e8e6 100644 , ( # ) -- * "Control.Lens.Setter" diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs -index b75c870..c6c6596 100644 +index 36152d6..3af6bd3 100644 --- a/src/Control/Lens/Prism.hs +++ b/src/Control/Lens/Prism.hs -@@ -61,8 +61,6 @@ import Unsafe.Coerce - import Data.Profunctor.Unsafe +@@ -62,8 +62,6 @@ import Data.Profunctor.Unsafe #endif + import Prelude -{-# ANN module "HLint: ignore Use camelCase" #-} - @@ -214,17 +190,17 @@ index b75c870..c6c6596 100644 -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs -index ee942c6..2f37134 100644 +index 8f1ec94..482764a 100644 --- a/src/Control/Monad/Primitive/Lens.hs +++ b/src/Control/Monad/Primitive/Lens.hs -@@ -20,7 +20,6 @@ import Control.Lens - import Control.Monad.Primitive (PrimMonad(..)) +@@ -26,7 +26,6 @@ import Control.Lens + import Control.Monad.Primitive import GHC.Prim (State#) -{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-} - prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) - prim = iso internal primitive + #if MIN_VERSION_primitive(0,6,0) + prim :: PrimBase m => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) -- -2.1.1 +2.1.4 diff --git a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch index 940514756..68226dcc6 100644 --- a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch +++ b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch @@ -1,18 +1,1039 @@ -From 38a22dae4f7f9726379fdaa3f85d78d75eee9d8e Mon Sep 17 00:00:00 2001 +From 4694f3a7ee4eb15d33ecda9d62712ea236304c1b Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:01:22 +0000 +Date: Thu, 2 Jul 2015 22:17:29 +0000 Subject: [PATCH] hack TH --- - Text/Shakespeare.hs | 70 ++++++++---------------------------------------- - Text/Shakespeare/Base.hs | 28 ------------------- - 2 files changed, 11 insertions(+), 87 deletions(-) + Text/Cassius.hs | 30 +--- + Text/Coffee.hs | 56 +------- + Text/Css.hs | 151 --------------------- + Text/CssCommon.hs | 22 --- + Text/Hamlet.hs | 346 +++-------------------------------------------- + Text/Julius.hs | 59 +------- + Text/Lucius.hs | 47 +------ + Text/Roy.hs | 52 +------ + Text/Shakespeare.hs | 70 ++-------- + Text/Shakespeare/Base.hs | 28 ---- + Text/Shakespeare/Text.hs | 117 ++-------------- + Text/TypeScript.hs | 48 +------ + shakespeare.cabal | 6 +- + 13 files changed, 69 insertions(+), 963 deletions(-) +diff --git a/Text/Cassius.hs b/Text/Cassius.hs +index ba73bdd..ffe7c51 100644 +--- a/Text/Cassius.hs ++++ b/Text/Cassius.hs +@@ -14,12 +14,7 @@ module Text.Cassius + , renderCss + , renderCssUrl + -- * Parsing +- , cassius +- , cassiusFile +- , cassiusFileDebug +- , cassiusFileReload + -- ** Mixims +- , cassiusMixin + , Mixin + -- * ToCss instances + -- ** Color +@@ -27,15 +22,12 @@ module Text.Cassius + , colorRed + , colorBlack + -- ** Size +- , mkSize ++ --, mkSize + , AbsoluteUnit (..) + , AbsoluteSize (..) + , absoluteSize +- , EmSize (..) +- , ExSize (..) + , PercentageSize (..) + , percentageSize +- , PixelSize (..) + -- * Internal + , cassiusUsedIdentifiers + ) where +@@ -47,25 +39,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)] +@@ -74,10 +50,6 @@ cassiusUsedIdentifiers = cssUsedIdentifiers True Text.Lucius.parseTopLevels + -- | Create a mixin with Cassius syntax. + -- + -- Since 2.0.3 +-cassiusMixin :: QuasiQuoter +-cassiusMixin = QuasiQuoter +- { quoteExp = quoteExp Text.Lucius.luciusMixin . i2bMixin +- } + + i2bMixin :: String -> String + i2bMixin s' = +diff --git a/Text/Coffee.hs b/Text/Coffee.hs +index 488c81b..4e28c94 100644 +--- a/Text/Coffee.hs ++++ b/Text/Coffee.hs +@@ -51,13 +51,13 @@ module Text.Coffee + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- coffee +- , coffeeFile +- , coffeeFileReload +- , coffeeFileDebug ++ -- coffee ++ --, coffeeFile ++ --, coffeeFileReload ++ --, coffeeFileDebug + + #ifdef TEST_EXPORT +- , coffeeSettings ++ -- , coffeeSettings + #endif + ) where + +@@ -65,49 +65,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..)) + import Language.Haskell.TH.Syntax + import Text.Shakespeare + import Text.Julius +- +-coffeeSettings :: Q ShakespeareSettings +-coffeeSettings = do +- jsettings <- javascriptSettings +- return $ jsettings { varChar = '%' +- , preConversion = Just PreConvert { +- preConvert = ReadProcess "coffee" ["-spb"] +- , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks. +- , preEscapeIgnoreLine = "#" -- ignore commented lines +- , wrapInsertion = Just WrapInsertion { +- wrapInsertionIndent = Just " " +- , wrapInsertionStartBegin = "(" +- , wrapInsertionSeparator = ", " +- , wrapInsertionStartClose = ") =>" +- , wrapInsertionEnd = "" +- , wrapInsertionAddParens = False +- } +- } +- } +- +--- | Read inline, quasiquoted CoffeeScript. +-coffee :: QuasiQuoter +-coffee = QuasiQuoter { quoteExp = \s -> do +- rs <- coffeeSettings +- quoteExp (shakespeare rs) s +- } +- +--- | Read in a CoffeeScript template file. This function reads the file once, at +--- compile time. +-coffeeFile :: FilePath -> Q Exp +-coffeeFile fp = do +- rs <- coffeeSettings +- shakespeareFile rs fp +- +--- | Read in a CoffeeScript template file. This impure function uses +--- unsafePerformIO to re-read the file on every call, allowing for rapid +--- iteration. +-coffeeFileReload :: FilePath -> Q Exp +-coffeeFileReload fp = do +- rs <- coffeeSettings +- shakespeareFileReload rs fp +- +--- | Deprecated synonym for 'coffeeFileReload' +-coffeeFileDebug :: FilePath -> Q Exp +-coffeeFileDebug = coffeeFileReload +-{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-} +diff --git a/Text/Css.hs b/Text/Css.hs +index 75dc549..20c206c 100644 +--- a/Text/Css.hs ++++ b/Text/Css.hs +@@ -166,22 +166,6 @@ cssUsedIdentifiers toi2b parseBlocks s' = + (scope, rest') = go rest + go' (Attr k v) = k ++ v + +-cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion +- -> Q Exp +- -> Parser [TopLevel Unresolved] +- -> FilePath +- -> Q Exp +-cssFileDebug toi2b parseBlocks' parseBlocks fp = do +- s <- fmap TL.unpack $ qRunIO $ readUtf8File fp +-#ifdef GHC_7_4 +- qAddDependentFile fp +-#endif +- let vs = cssUsedIdentifiers toi2b parseBlocks s +- c <- mapM vtToExp vs +- cr <- [|cssRuntime toi2b|] +- parseBlocks'' <- parseBlocks' +- return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c +- + combineSelectors :: HasLeadingSpace + -> [Contents] + -> [Contents] +@@ -287,18 +271,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do + + addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd + +-vtToExp :: (Deref, VarType) -> Q Exp +-vtToExp (d, vt) = do +- d' <- lift d +- c' <- c vt +- return $ TupE [d', c' `AppE` derefToExp [] d] +- where +- c :: VarType -> Q Exp +- c VTPlain = [|CDPlain . toCss|] +- c VTUrl = [|CDUrl|] +- c VTUrlParam = [|CDUrlParam|] +- c VTMixin = [|CDMixin|] +- + getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)] + getVars _ ContentRaw{} = return [] + getVars scope (ContentVar d) = +@@ -342,111 +314,8 @@ compressBlock (Block x y blocks mixins) = + cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c + cc (a:b) = a : cc b + +-blockToMixin :: Name +- -> Scope +- -> Block Unresolved +- -> Q Exp +-blockToMixin r scope (Block _sel props subblocks mixins) = +- [|Mixin +- { mixinAttrs = concat +- $ $(listE $ map go props) +- : map mixinAttrs $mixinsE +- -- FIXME too many complications to implement sublocks for now... +- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) [] +- }|] +- {- +- . foldr (.) id $(listE $ map subGo subblocks) +- . (concatMap mixinBlocks $mixinsE ++) +- |] +- -} +- where +- mixinsE = return $ ListE $ map (derefToExp []) mixins +- go (Attr x y) = conE 'Attr +- `appE` (contentsToBuilder r scope x) +- `appE` (contentsToBuilder r scope y) +- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d +- +-blockToCss :: Name +- -> Scope +- -> Block Unresolved +- -> Q Exp +-blockToCss r scope (Block sel props subblocks mixins) = +- [|((Block +- { blockSelector = $(selectorToBuilder r scope sel) +- , blockAttrs = concat +- $ $(listE $ map go props) +- : map mixinAttrs $mixinsE +- , blockBlocks = () +- , blockMixins = () +- } :: Block Resolved):) +- . foldr (.) id $(listE $ map subGo subblocks) +- . (concatMap mixinBlocks $mixinsE ++) +- |] +- where +- mixinsE = return $ ListE $ map (derefToExp []) mixins +- go (Attr x y) = conE 'Attr +- `appE` (contentsToBuilder r scope x) +- `appE` (contentsToBuilder r scope y) +- subGo (hls, Block sel' b c d) = +- blockToCss r scope $ Block sel'' b c d +- where +- sel'' = combineSelectors hls sel sel' +- +-selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp +-selectorToBuilder r scope sels = +- contentsToBuilder r scope $ intercalate [ContentRaw ","] sels +- +-contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp +-contentsToBuilder r scope contents = +- appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents +- +-contentToBuilder :: Name -> Scope -> Content -> Q Exp +-contentToBuilder _ _ (ContentRaw x) = +- [|fromText . pack|] `appE` litE (StringL x) +-contentToBuilder _ scope (ContentVar d) = +- case d of +- DerefIdent (Ident s) +- | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val) +- _ -> [|toCss|] `appE` return (derefToExp [] d) +-contentToBuilder r _ (ContentUrl u) = +- [|fromText|] `appE` +- (varE r `appE` return (derefToExp [] u) `appE` listE []) +-contentToBuilder r _ (ContentUrlParam u) = +- [|fromText|] `appE` +- ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u)) +-contentToBuilder _ _ ContentMixin{} = error "contentToBuilder on ContentMixin" +- + type Scope = [(String, String)] + +-topLevelsToCassius :: [TopLevel Unresolved] +- -> Q Exp +-topLevelsToCassius a = do +- r <- newName "_render" +- lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a +- where +- go _ _ [] = return [] +- go r scope (TopBlock b:rest) = do +- e <- [|(++) $ map TopBlock ($(blockToCss r scope b) [])|] +- es <- go r scope rest +- return $ e : es +- go r scope (TopAtBlock name s b:rest) = do +- let s' = contentsToBuilder r scope s +- e <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|] +- es <- go r scope rest +- return $ e : es +- go r scope (TopAtDecl dec cs:rest) = do +- e <- [|(:) $ TopAtDecl $(lift dec) $(contentsToBuilder r scope cs)|] +- es <- go r scope rest +- return $ e : es +- go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest +- +-blocksToCassius :: Name +- -> Scope +- -> [Block Unresolved] +- -> Q Exp +-blocksToCassius r scope a = do +- appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a +- + renderCss :: Css -> TL.Text + renderCss css = + toLazyText $ mconcat $ map go tops +@@ -515,23 +384,3 @@ renderBlock haveWhiteSpace indent (Block sel attrs () ()) + | haveWhiteSpace = fromString ";\n" + | otherwise = singleton ';' + +-instance Lift Mixin where +- lift (Mixin a b) = [|Mixin a b|] +-instance Lift (Attr Unresolved) where +- lift (Attr k v) = [|Attr k v :: Attr Unresolved |] +-instance Lift (Attr Resolved) where +- lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |] +- +-liftBuilder :: Builder -> Q Exp +-liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|] +- +-instance Lift Content where +- lift (ContentRaw s) = [|ContentRaw s|] +- lift (ContentVar d) = [|ContentVar d|] +- lift (ContentUrl d) = [|ContentUrl d|] +- lift (ContentUrlParam d) = [|ContentUrlParam d|] +- lift (ContentMixin m) = [|ContentMixin m|] +-instance Lift (Block Unresolved) where +- lift (Block a b c d) = [|Block a b c d|] +-instance Lift (Block Resolved) where +- lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|] +diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs +index 719e0a8..0635cf4 100644 +--- a/Text/CssCommon.hs ++++ b/Text/CssCommon.hs +@@ -1,4 +1,3 @@ +-{-# LANGUAGE TemplateHaskell #-} + {-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-# LANGUAGE FlexibleInstances #-} + {-# LANGUAGE CPP #-} +@@ -47,24 +46,6 @@ colorBlack = Color 0 0 0 + + -- CSS size wrappers + +--- | Create a CSS size, e.g. $(mkSize "100px"). +-mkSize :: String -> ExpQ +-mkSize s = appE nameE valueE +- where [(value, unit)] = reads s :: [(Double, String)] +- absoluteSizeE = varE $ mkName "absoluteSize" +- nameE = case unit of +- "cm" -> appE absoluteSizeE (conE $ mkName "Centimeter") +- "em" -> conE $ mkName "EmSize" +- "ex" -> conE $ mkName "ExSize" +- "in" -> appE absoluteSizeE (conE $ mkName "Inch") +- "mm" -> appE absoluteSizeE (conE $ mkName "Millimeter") +- "pc" -> appE absoluteSizeE (conE $ mkName "Pica") +- "pt" -> appE absoluteSizeE (conE $ mkName "Point") +- "px" -> conE $ mkName "PixelSize" +- "%" -> varE $ mkName "percentageSize" +- _ -> error $ "In mkSize, invalid unit: " ++ unit +- valueE = litE $ rationalL (toRational value) +- + -- | Absolute size units. + data AbsoluteUnit = Centimeter + | Inch +@@ -156,6 +137,3 @@ showSize :: Rational -> String -> String + showSize value' unit = printf "%f" value ++ unit + where value = fromRational value' :: Double + +-mkSizeType "EmSize" "em" +-mkSizeType "ExSize" "ex" +-mkSizeType "PixelSize" "px" +diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs +index 4618be3..4ad3633 100644 +--- a/Text/Hamlet.hs ++++ b/Text/Hamlet.hs +@@ -11,36 +11,36 @@ + module Text.Hamlet + ( -- * Plain HTML + Html +- , shamlet +- , shamletFile +- , xshamlet +- , xshamletFile ++ --, shamlet ++ --, shamletFile ++ --, xshamlet ++ --, xshamletFile + -- * Hamlet + , HtmlUrl +- , hamlet +- , hamletFile +- , hamletFileReload +- , ihamletFileReload +- , xhamlet +- , xhamletFile ++ --, hamlet ++ -- , hamletFile ++ -- , hamletFileReload ++ -- , ihamletFileReload ++ -- , xhamlet ++ -- , xhamletFile + -- * I18N Hamlet + , HtmlUrlI18n +- , ihamlet +- , ihamletFile ++ -- , ihamlet ++ -- , ihamletFile + -- * Type classes + , ToAttributes (..) + -- * Internal, for making more + , HamletSettings (..) + , NewlineStyle (..) +- , hamletWithSettings +- , hamletFileWithSettings ++ -- , hamletWithSettings ++ -- , hamletFileWithSettings + , defaultHamletSettings + , xhtmlHamletSettings +- , Env (..) +- , HamletRules (..) +- , hamletRules +- , ihamletRules +- , htmlRules ++ --, Env (..) ++ --, HamletRules (..) ++ --, hamletRules ++ --, ihamletRules ++ --, htmlRules + , CloseStyle (..) + -- * Used by generated code + , condH +@@ -109,48 +109,9 @@ type HtmlUrl url = Render url -> Html + -- | A function generating an 'Html' given a message translator and a URL rendering function. + type HtmlUrlI18n msg url = Translate msg -> Render url -> Html + +-docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp +-docsToExp env hr scope docs = do +- exps <- mapM (docToExp env hr scope) docs +- case exps of +- [] -> [|return ()|] +- [x] -> return x +- _ -> return $ DoE $ map NoBindS exps +- + unIdent :: Ident -> String + unIdent (Ident s) = s + +-bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)]) +-bindingPattern (BindAs i@(Ident s) b) = do +- name <- newName s +- (pattern, scope) <- bindingPattern b +- return (AsP name pattern, (i, VarE name):scope) +-bindingPattern (BindVar i@(Ident s)) +- | s == "_" = return (WildP, []) +- | all isDigit s = do +- return (LitP $ IntegerL $ read s, []) +- | otherwise = do +- name <- newName s +- return (VarP name, [(i, VarE name)]) +-bindingPattern (BindTuple is) = do +- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is +- return (TupP patterns, concat scopes) +-bindingPattern (BindList is) = do +- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is +- return (ListP patterns, concat scopes) +-bindingPattern (BindConstr con is) = do +- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is +- return (ConP (mkConName con) patterns, concat scopes) +-bindingPattern (BindRecord con fields wild) = do +- let f (Ident field,b) = +- do (p,s) <- bindingPattern b +- return ((mkName field,p),s) +- (patterns, scopes) <- fmap unzip $ mapM f fields +- (patterns1, scopes1) <- if wild +- then bindWildFields con $ map fst fields +- else return ([],[]) +- return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1) +- + mkConName :: DataConstr -> Name + mkConName = mkName . conToStr + +@@ -158,257 +119,15 @@ conToStr :: DataConstr -> String + conToStr (DCUnqualified (Ident x)) = x + conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x] + +--- Wildcards bind all of the unbound fields to variables whose name +--- matches the field name. +--- +--- For example: data R = C { f1, f2 :: Int } +--- C {..} is equivalent to C {f1=f1, f2=f2} +--- C {f1 = a, ..} is equivalent to C {f1=a, f2=f2} +--- C {f2 = a, ..} is equivalent to C {f1=f1, f2=a} +-bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)]) +-bindWildFields conName fields = do +- fieldNames <- recordToFieldNames conName +- let available n = nameBase n `notElem` map unIdent fields +- let remainingFields = filter available fieldNames +- let mkPat n = do +- e <- newName (nameBase n) +- return ((n,VarP e), (Ident (nameBase n), VarE e)) +- fmap unzip $ mapM mkPat remainingFields +- +--- Important note! reify will fail if the record type is defined in the +--- same module as the reify is used. This means quasi-quoted Hamlet +--- literals will not be able to use wildcards to match record types +--- defined in the same module. +-recordToFieldNames :: DataConstr -> Q [Name] +-recordToFieldNames conStr = do +- -- use 'lookupValueName' instead of just using 'mkName' so we reify the +- -- data constructor and not the type constructor if their names match. +- Just conName <- lookupValueName $ conToStr conStr +- DataConI _ _ typeName _ <- reify conName +- TyConI (DataD _ _ _ cons _) <- reify typeName +- [fields] <- return [fields | RecC name fields <- cons, name == conName] +- return [fieldName | (fieldName, _, _) <- fields] +- +-docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp +-docToExp env hr scope (DocForall list idents inside) = do +- let list' = derefToExp scope list +- (pat, extraScope) <- bindingPattern idents +- let scope' = extraScope ++ scope +- mh <- [|F.mapM_|] +- inside' <- docsToExp env hr scope' inside +- let lam = LamE [pat] inside' +- return $ mh `AppE` lam `AppE` list' +-docToExp env hr scope (DocWith [] inside) = do +- inside' <- docsToExp env hr scope inside +- return $ inside' +-docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do +- let deref' = derefToExp scope deref +- (pat, extraScope) <- bindingPattern idents +- let scope' = extraScope ++ scope +- inside' <- docToExp env hr scope' (DocWith dis inside) +- let lam = LamE [pat] inside' +- return $ lam `AppE` deref' +-docToExp env hr scope (DocMaybe val idents inside mno) = do +- let val' = derefToExp scope val +- (pat, extraScope) <- bindingPattern idents +- let scope' = extraScope ++ scope +- inside' <- docsToExp env hr scope' inside +- let inside'' = LamE [pat] inside' +- ninside' <- case mno of +- Nothing -> [|Nothing|] +- Just no -> do +- no' <- docsToExp env hr scope no +- j <- [|Just|] +- return $ j `AppE` no' +- mh <- [|maybeH|] +- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside' +-docToExp env hr scope (DocCond conds final) = do +- conds' <- mapM go conds +- final' <- case final of +- Nothing -> [|Nothing|] +- Just f -> do +- f' <- docsToExp env hr scope f +- j <- [|Just|] +- return $ j `AppE` f' +- ch <- [|condH|] +- return $ ch `AppE` ListE conds' `AppE` final' +- where +- go :: (Deref, [Doc]) -> Q Exp +- go (d, docs) = do +- let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d +- docs' <- docsToExp env hr scope docs +- return $ TupE [d', docs'] +-docToExp env hr scope (DocCase deref cases) = do +- let exp_ = derefToExp scope deref +- matches <- mapM toMatch cases +- return $ CaseE exp_ matches +- where +- toMatch :: (Binding, [Doc]) -> Q Match +- toMatch (idents, inside) = do +- (pat, extraScope) <- bindingPattern idents +- let scope' = extraScope ++ scope +- insideExp <- docsToExp env hr scope' inside +- return $ Match pat (NormalB insideExp) [] +-docToExp env hr v (DocContent c) = contentToExp env hr v c +- +-contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp +-contentToExp _ hr _ (ContentRaw s) = do +- os <- [|preEscapedText . pack|] +- let s' = LitE $ StringL s +- return $ hrFromHtml hr `AppE` (os `AppE` s') +-contentToExp _ hr scope (ContentVar d) = do +- str <- [|toHtml|] +- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d) +-contentToExp env hr scope (ContentUrl hasParams d) = +- case urlRender env of +- Nothing -> error "URL interpolation used, but no URL renderer provided" +- Just wrender -> wrender $ \render -> do +- let render' = return render +- ou <- if hasParams +- then [|\(u, p) -> $(render') u p|] +- else [|\u -> $(render') u []|] +- let d' = derefToExp scope d +- pet <- [|toHtml|] +- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d')) +-contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d +-contentToExp env hr scope (ContentMsg d) = +- case msgRender env of +- Nothing -> error "Message interpolation used, but no message renderer provided" +- Just wrender -> wrender $ \render -> +- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d) +-contentToExp _ hr scope (ContentAttrs d) = do +- html <- [|attrsToHtml . toAttributes|] +- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d) +- +-shamlet :: QuasiQuoter +-shamlet = hamletWithSettings htmlRules defaultHamletSettings +- +-xshamlet :: QuasiQuoter +-xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings +- +-htmlRules :: Q HamletRules +-htmlRules = do +- i <- [|id|] +- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b) +- +-hamlet :: QuasiQuoter +-hamlet = hamletWithSettings hamletRules defaultHamletSettings +- +-xhamlet :: QuasiQuoter +-xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings +- + asHtmlUrl :: HtmlUrl url -> HtmlUrl url + asHtmlUrl = id + +-hamletRules :: Q HamletRules +-hamletRules = do +- i <- [|id|] +- let ur f = do +- r <- newName "_render" +- let env = Env +- { urlRender = Just ($ (VarE r)) +- , msgRender = Nothing +- } +- h <- f env +- return $ LamE [VarP r] h +- return $ HamletRules i ur em +- where +- em (Env (Just urender) Nothing) e = do +- asHtmlUrl' <- [|asHtmlUrl|] +- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur') +- em _ _ = error "bad Env" +- +-ihamlet :: QuasiQuoter +-ihamlet = hamletWithSettings ihamletRules defaultHamletSettings +- +-ihamletRules :: Q HamletRules +-ihamletRules = do +- i <- [|id|] +- let ur f = do +- u <- newName "_urender" +- m <- newName "_mrender" +- let env = Env +- { urlRender = Just ($ (VarE u)) +- , msgRender = Just ($ (VarE m)) +- } +- h <- f env +- return $ LamE [VarP m, VarP u] h +- return $ HamletRules i ur em +- where +- em (Env (Just urender) (Just mrender)) e = +- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur') +- em _ _ = error "bad Env" +- +-hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter +-hamletWithSettings hr set = +- QuasiQuoter +- { quoteExp = hamletFromString hr set +- } +- +-data HamletRules = HamletRules +- { hrFromHtml :: Exp +- , hrWithEnv :: (Env -> Q Exp) -> Q Exp +- , hrEmbed :: Env -> Exp -> Q Exp +- } +- +-data Env = Env +- { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp) +- , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp) +- } +- +-hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp +-hamletFromString qhr set s = do +- hr <- qhr +- hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s +- + docFromString :: HamletSettings -> String -> [Doc] + docFromString set s = + case parseDoc set s of + Error s' -> error s' + Ok (_, d) -> d + +-hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp +-hamletFileWithSettings qhr set fp = do +-#ifdef GHC_7_4 +- qAddDependentFile fp +-#endif +- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp +- hamletFromString qhr set contents +- +-hamletFile :: FilePath -> Q Exp +-hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings +- +-hamletFileReload :: FilePath -> Q Exp +-hamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings +- where runtimeRules = HamletRuntimeRules { hrrI18n = False } +- +-ihamletFileReload :: FilePath -> Q Exp +-ihamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings +- where runtimeRules = HamletRuntimeRules { hrrI18n = True } +- +-xhamletFile :: FilePath -> Q Exp +-xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings +- +-shamletFile :: FilePath -> Q Exp +-shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings +- +-xshamletFile :: FilePath -> Q Exp +-xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings +- +-ihamletFile :: FilePath -> Q Exp +-ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings +- +-varName :: Scope -> String -> Exp +-varName _ "" = error "Illegal empty varName" +-varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope +- +-strToExp :: String -> Exp +-strToExp s@(c:_) +- | all isDigit s = LitE $ IntegerL $ read s +- | isUpper c = ConE $ mkName s +- | otherwise = VarE $ mkName s +-strToExp "" = error "strToExp on empty string" +- + -- | Checks for truth in the left value in each pair in the first argument. If + -- a true exists, then the corresponding right action is performed. Only the + -- first is performed. In there are no true values, then the second argument is +@@ -461,33 +180,6 @@ data HamletRuntimeRules = HamletRuntimeRules { + hrrI18n :: Bool + } + +-hamletFileReloadWithSettings :: HamletRuntimeRules +- -> HamletSettings -> FilePath -> Q Exp +-hamletFileReloadWithSettings hrr settings fp = do +- s <- readFileQ fp +- let b = hamletUsedIdentifiers settings s +- c <- mapM vtToExp b +- rt <- if hrrI18n hrr +- then [|hamletRuntimeMsg settings fp|] +- else [|hamletRuntime settings fp|] +- return $ rt `AppE` ListE c +- where +- vtToExp :: (Deref, VarType) -> Q Exp +- vtToExp (d, vt) = do +- d' <- lift d +- c' <- toExp vt +- return $ TupE [d', c' `AppE` derefToExp [] d] +- where +- toExp = c +- where +- c :: VarType -> Q Exp +- c VTAttrs = [|EPlain . attrsToHtml . toAttributes|] +- c VTPlain = [|EPlain . toHtml|] +- c VTUrl = [|EUrl|] +- c VTUrlParam = [|EUrlParam|] +- c VTMixin = [|\r -> EMixin $ \c -> r c|] +- c VTMsg = [|EMsg|] +- + -- move to Shakespeare.Base? + readFileUtf8 :: FilePath -> IO String + readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp +diff --git a/Text/Julius.hs b/Text/Julius.hs +index 8c15a99..47b42fd 100644 +--- a/Text/Julius.hs ++++ b/Text/Julius.hs +@@ -14,17 +14,9 @@ module Text.Julius + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- js +- , julius +- , juliusFile +- , jsFile +- , juliusFileDebug +- , jsFileDebug +- , juliusFileReload +- , jsFileReload + + -- * Datatypes +- , JavascriptUrl ++ JavascriptUrl + , Javascript (..) + , RawJavascript (..) + +@@ -37,9 +29,9 @@ module Text.Julius + , renderJavascriptUrl + + -- ** internal, used by 'Text.Coffee' +- , javascriptSettings ++ --, javascriptSettings + -- ** internal +- , juliusUsedIdentifiers ++ --, juliusUsedIdentifiers + , asJavascriptUrl + ) where + +@@ -102,48 +94,3 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText + instance RawJS Builder where rawJS = RawJavascript + instance RawJS Bool where rawJS = RawJavascript . unJavascript . toJavascript + +-javascriptSettings :: Q ShakespeareSettings +-javascriptSettings = do +- toJExp <- [|toJavascript|] +- wrapExp <- [|Javascript|] +- unWrapExp <- [|unJavascript|] +- asJavascriptUrl' <- [|asJavascriptUrl|] +- return $ defaultShakespeareSettings { toBuilder = toJExp +- , wrap = wrapExp +- , unwrap = unWrapExp +- , modifyFinalValue = Just asJavascriptUrl' +- } +- +-js, julius :: QuasiQuoter +-js = QuasiQuoter { quoteExp = \s -> do +- rs <- javascriptSettings +- quoteExp (shakespeare rs) s +- } +- +-julius = js +- +-jsFile, juliusFile :: FilePath -> Q Exp +-jsFile fp = do +- rs <- javascriptSettings +- shakespeareFile rs fp +- +-juliusFile = jsFile +- +- +-jsFileReload, juliusFileReload :: FilePath -> Q Exp +-jsFileReload fp = do +- rs <- javascriptSettings +- shakespeareFileReload rs fp +- +-juliusFileReload = jsFileReload +- +-jsFileDebug, juliusFileDebug :: FilePath -> Q Exp +-juliusFileDebug = jsFileReload +-{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-} +-jsFileDebug = jsFileReload +-{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-} +- +--- | Determine which identifiers are used by the given template, useful for +--- creating systems like yesod devel. +-juliusUsedIdentifiers :: String -> [(Deref, VarType)] +-juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings +diff --git a/Text/Lucius.hs b/Text/Lucius.hs +index 3226b79..fd0b7be 100644 +--- a/Text/Lucius.hs ++++ b/Text/Lucius.hs +@@ -9,13 +9,13 @@ + {-# OPTIONS_GHC -fno-warn-missing-fields #-} + module Text.Lucius + ( -- * Parsing +- lucius +- , luciusFile +- , luciusFileDebug +- , luciusFileReload ++ -- lucius ++ --, luciusFile ++ --, luciusFileDebug ++ --, luciusFileReload + -- ** Mixins +- , luciusMixin +- , Mixin ++ --, luciusMixin ++ Mixin + -- ** Runtime + , luciusRT + , luciusRT' +@@ -37,15 +37,12 @@ module Text.Lucius + , colorRed + , colorBlack + -- ** Size +- , mkSize ++ --, mkSize + , AbsoluteUnit (..) + , AbsoluteSize (..) + , absoluteSize +- , EmSize (..) +- , ExSize (..) + , PercentageSize (..) + , percentageSize +- , PixelSize (..) + -- * Internal + , parseTopLevels + , luciusUsedIdentifiers +@@ -72,13 +69,6 @@ import Text.Shakespeare (VarType) + -- + -- >>> renderCss ([lucius|foo{bar:baz}|] undefined) + -- "foo{bar:baz}" +-lucius :: QuasiQuoter +-lucius = QuasiQuoter { quoteExp = luciusFromString } +- +-luciusFromString :: String -> Q Exp +-luciusFromString s = +- topLevelsToCassius +- $ either (error . show) id $ parse parseTopLevels s s + + whiteSpace :: Parser () + whiteSpace = many whiteSpace1 >> return () +@@ -219,18 +209,6 @@ parseComment = do + _ <- manyTill anyChar $ try $ string "*/" + return $ ContentRaw "" + +-luciusFile :: FilePath -> Q Exp +-luciusFile fp = do +-#ifdef GHC_7_4 +- qAddDependentFile fp +-#endif +- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp +- luciusFromString contents +- +-luciusFileDebug, luciusFileReload :: FilePath -> Q Exp +-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels +-luciusFileReload = luciusFileDebug +- + parseTopLevels :: Parser [TopLevel Unresolved] + parseTopLevels = + go id +@@ -379,14 +357,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $ + luciusUsedIdentifiers :: String -> [(Deref, VarType)] + luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels + +-luciusMixin :: QuasiQuoter +-luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString } +- +-luciusMixinFromString :: String -> Q Exp +-luciusMixinFromString s' = do +- r <- newName "_render" +- case fmap compressBlock $ parse parseBlock s s of +- Left e -> error $ show e +- Right block -> blockToMixin r [] block +- where +- s = concat ["mixin{", s', "}"] +diff --git a/Text/Roy.hs b/Text/Roy.hs +index 6e5e246..a08b019 100644 +--- a/Text/Roy.hs ++++ b/Text/Roy.hs +@@ -39,12 +39,12 @@ module Text.Roy + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- roy +- , royFile +- , royFileReload ++ -- roy ++ --, royFile ++ --, royFileReload + + #ifdef TEST_EXPORT +- , roySettings ++ --, roySettings + #endif + ) where + +@@ -52,47 +52,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..)) + import Language.Haskell.TH.Syntax + import Text.Shakespeare + import Text.Julius +- +--- | The Roy language compiles down to Javascript. +--- We do this compilation once at compile time to avoid needing to do it during the request. +--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. +-roySettings :: Q ShakespeareSettings +-roySettings = do +- jsettings <- javascriptSettings +- return $ jsettings { varChar = '#' +- , preConversion = Just PreConvert { +- preConvert = ReadProcess "roy" ["--stdio", "--browser"] +- , preEscapeIgnoreBalanced = "'\"" +- , preEscapeIgnoreLine = "//" +- , wrapInsertion = Just WrapInsertion { +- wrapInsertionIndent = Just " " +- , wrapInsertionStartBegin = "(\\" +- , wrapInsertionSeparator = " " +- , wrapInsertionStartClose = " ->\n" +- , wrapInsertionEnd = ")" +- , wrapInsertionAddParens = True +- } +- } +- } +- +--- | Read inline, quasiquoted Roy. +-roy :: QuasiQuoter +-roy = QuasiQuoter { quoteExp = \s -> do +- rs <- roySettings +- quoteExp (shakespeare rs) s +- } +- +--- | Read in a Roy template file. This function reads the file once, at +--- compile time. +-royFile :: FilePath -> Q Exp +-royFile fp = do +- rs <- roySettings +- shakespeareFile rs fp +- +--- | Read in a Roy template file. This impure function uses +--- unsafePerformIO to re-read the file on every call, allowing for rapid +--- iteration. +-royFileReload :: FilePath -> Q Exp +-royFileReload fp = do +- rs <- roySettings +- shakespeareFileReload rs fp diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index 68e344f..97361a2 100644 +index 98c0c2d..2f6431b 100644 --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs -@@ -14,12 +14,12 @@ module Text.Shakespeare +@@ -16,12 +16,12 @@ module Text.Shakespeare , WrapInsertion (..) , PreConversion (..) , defaultShakespeareSettings @@ -30,7 +1051,7 @@ index 68e344f..97361a2 100644 , RenderUrl , VarType (..) , Deref -@@ -154,38 +154,6 @@ defaultShakespeareSettings = ShakespeareSettings { +@@ -153,38 +153,6 @@ defaultShakespeareSettings = ShakespeareSettings { , modifyFinalValue = Nothing } @@ -69,7 +1090,7 @@ index 68e344f..97361a2 100644 type QueryParameters = [(TS.Text, TS.Text)] type RenderUrl url = (url -> QueryParameters -> TS.Text) -@@ -349,6 +317,7 @@ pack' = TS.pack +@@ -348,6 +316,7 @@ pack' = TS.pack {-# NOINLINE pack' #-} #endif @@ -77,7 +1098,7 @@ index 68e344f..97361a2 100644 contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp contentsToShakespeare rs a = do r <- newName "_render" -@@ -400,16 +369,19 @@ shakespeareFile r fp = +@@ -399,16 +368,19 @@ shakespeareFile r fp = qAddDependentFile fp >> #endif readFileQ fp >>= shakespeareFromString r @@ -97,7 +1118,7 @@ index 68e344f..97361a2 100644 data VarExp url = EPlain Builder | EUrl url -@@ -418,8 +390,10 @@ data VarExp url = EPlain Builder +@@ -417,8 +389,10 @@ data VarExp url = EPlain Builder -- | Determine which identifiers are used by the given template, useful for -- creating systems like yesod devel. @@ -108,7 +1129,7 @@ index 68e344f..97361a2 100644 type MTime = UTCTime -@@ -436,28 +410,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] +@@ -435,28 +409,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef (\reloadMap -> (M.insert fp (mt, content) reloadMap, content)) @@ -176,6 +1197,242 @@ index a0e983c..23b4692 100644 derefParens, derefCurlyBrackets :: UserParser a Deref derefParens = between (char '(') (char ')') parseDeref derefCurlyBrackets = between (char '{') (char '}') parseDeref +diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs +index f490d7f..5154618 100644 +--- a/Text/Shakespeare/Text.hs ++++ b/Text/Shakespeare/Text.hs +@@ -7,20 +7,20 @@ module Text.Shakespeare.Text + ( TextUrl + , ToText (..) + , renderTextUrl +- , stext +- , text +- , textFile +- , textFileDebug +- , textFileReload +- , st -- | strict text +- , lt -- | lazy text, same as stext :) +- , sbt -- | strict text whose left edge is aligned with bar ('|') +- , lbt -- | lazy text, whose left edge is aligned with bar ('|') ++ --, stext ++ --, text ++ --, textFile ++ --, textFileDebug ++ --, textFileReload ++ --, st -- | strict text ++ --, lt -- | lazy text, same as stext :) ++ --, sbt -- | strict text whose left edge is aligned with bar ('|') ++ --, lbt -- | lazy text, whose left edge is aligned with bar ('|') + -- * Yesod code generation +- , codegen +- , codegenSt +- , codegenFile +- , codegenFileReload ++ --, codegen ++ --, codegenSt ++ --, codegenFile ++ --, codegenFileReload + ) where + + import Language.Haskell.TH.Quote (QuasiQuoter (..)) +@@ -59,66 +59,12 @@ settings = do + } + + +-stext, lt, st, text, lbt, sbt :: QuasiQuoter +-stext = +- QuasiQuoter { quoteExp = \s -> do +- rs <- settings +- render <- [|toLazyText|] +- rendered <- shakespeareFromString rs { justVarInterpolation = True } s +- return (render `AppE` rendered) +- } +-lt = stext +- +-st = +- QuasiQuoter { quoteExp = \s -> do +- rs <- settings +- render <- [|TL.toStrict . toLazyText|] +- rendered <- shakespeareFromString rs { justVarInterpolation = True } s +- return (render `AppE` rendered) +- } +- +-text = QuasiQuoter { quoteExp = \s -> do +- rs <- settings +- quoteExp (shakespeare rs) $ filter (/='\r') s +- } +- + dropBar :: [TL.Text] -> [TL.Text] + dropBar [] = [] + dropBar (c:cx) = c:dropBar' cx + where + dropBar' txt = reverse $ drop 1 $ map (TL.drop 1 . TL.dropWhile (/= '|')) $ reverse txt + +-lbt = +- QuasiQuoter { quoteExp = \s -> do +- rs <- settings +- render <- [|TL.unlines . dropBar . TL.lines . toLazyText|] +- rendered <- shakespeareFromString rs { justVarInterpolation = True } s +- return (render `AppE` rendered) +- } +- +-sbt = +- QuasiQuoter { quoteExp = \s -> do +- rs <- settings +- render <- [|TL.toStrict . TL.unlines . dropBar . TL.lines . toLazyText|] +- rendered <- shakespeareFromString rs { justVarInterpolation = True } s +- return (render `AppE` rendered) +- } +- +-textFile :: FilePath -> Q Exp +-textFile fp = do +- rs <- settings +- shakespeareFile rs fp +- +- +-textFileDebug :: FilePath -> Q Exp +-textFileDebug = textFileReload +-{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-} +- +-textFileReload :: FilePath -> Q Exp +-textFileReload fp = do +- rs <- settings +- shakespeareFileReload rs fp +- + -- | codegen is designed for generating Yesod code, including templates + -- So it uses different interpolation characters that won't clash with templates. + codegenSettings :: Q ShakespeareSettings +@@ -135,40 +81,3 @@ codegenSettings = do + , justVarInterpolation = True -- always! + } + +--- | codegen is designed for generating Yesod code, including templates +--- So it uses different interpolation characters that won't clash with templates. +--- You can use the normal text quasiquoters to generate code +-codegen :: QuasiQuoter +-codegen = +- QuasiQuoter { quoteExp = \s -> do +- rs <- codegenSettings +- render <- [|toLazyText|] +- rendered <- shakespeareFromString rs { justVarInterpolation = True } s +- return (render `AppE` rendered) +- } +- +--- | Generates strict Text +--- codegen is designed for generating Yesod code, including templates +--- So it uses different interpolation characters that won't clash with templates. +-codegenSt :: QuasiQuoter +-codegenSt = +- QuasiQuoter { quoteExp = \s -> do +- rs <- codegenSettings +- render <- [|TL.toStrict . toLazyText|] +- rendered <- shakespeareFromString rs { justVarInterpolation = True } s +- return (render `AppE` rendered) +- } +- +-codegenFileReload :: FilePath -> Q Exp +-codegenFileReload fp = do +- rs <- codegenSettings +- render <- [|TL.toStrict . toLazyText|] +- rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp +- return (render `AppE` rendered) +- +-codegenFile :: FilePath -> Q Exp +-codegenFile fp = do +- rs <- codegenSettings +- render <- [|TL.toStrict . toLazyText|] +- rendered <- shakespeareFile rs{ justVarInterpolation = True } fp +- return (render `AppE` rendered) +diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs +index 85f6abd..3188272 100644 +--- a/Text/TypeScript.hs ++++ b/Text/TypeScript.hs +@@ -57,12 +57,12 @@ module Text.TypeScript + -- ** Template-Reading Functions + -- | These QuasiQuoter and Template Haskell methods return values of + -- type @'JavascriptUrl' url@. See the Yesod book for details. +- tsc +- , typeScriptFile +- , typeScriptFileReload ++ -- tsc ++ --, typeScriptFile ++ --, typeScriptFileReload + + #ifdef TEST_EXPORT +- , typeScriptSettings ++ --, typeScriptSettings + #endif + ) where + +@@ -74,43 +74,3 @@ import Text.Julius + -- | The TypeScript language compiles down to Javascript. + -- We do this compilation once at compile time to avoid needing to do it during the request. + -- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. +-typeScriptSettings :: Q ShakespeareSettings +-typeScriptSettings = do +- jsettings <- javascriptSettings +- return $ jsettings { varChar = '#' +- , preConversion = Just PreConvert { +- preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"] +- , preEscapeIgnoreBalanced = "'\"" +- , preEscapeIgnoreLine = "//" +- , wrapInsertion = Just WrapInsertion { +- wrapInsertionIndent = Nothing +- , wrapInsertionStartBegin = ";(function(" +- , wrapInsertionSeparator = ", " +- , wrapInsertionStartClose = "){" +- , wrapInsertionEnd = "})" +- , wrapInsertionAddParens = False +- } +- } +- } +- +--- | Read inline, quasiquoted TypeScript +-tsc :: QuasiQuoter +-tsc = QuasiQuoter { quoteExp = \s -> do +- rs <- typeScriptSettings +- quoteExp (shakespeare rs) s +- } +- +--- | Read in a TypeScript template file. This function reads the file once, at +--- compile time. +-typeScriptFile :: FilePath -> Q Exp +-typeScriptFile fp = do +- rs <- typeScriptSettings +- shakespeareFile rs fp +- +--- | Read in a TypeScript template file. This impure function uses +--- unsafePerformIO to re-read the file on every call, allowing for rapid +--- iteration. +-typeScriptFileReload :: FilePath -> Q Exp +-typeScriptFileReload fp = do +- rs <- typeScriptSettings +- shakespeareFileReload rs fp +diff --git a/shakespeare.cabal b/shakespeare.cabal +index 37029fc..2c4b557 100644 +--- a/shakespeare.cabal ++++ b/shakespeare.cabal +@@ -62,18 +62,16 @@ library + Text.Shakespeare.Base + Text.Shakespeare + Text.TypeScript +- other-modules: Text.Hamlet.Parse + Text.Css ++ Text.CssCommon ++ other-modules: Text.Hamlet.Parse + Text.MkSizeType + Text.IndentToBrace +- Text.CssCommon + ghc-options: -Wall + + if flag(test_export) + cpp-options: -DTEST_EXPORT + +- extensions: TemplateHaskell +- + if impl(ghc >= 7.4) + cpp-options: -DGHC_7_4 + -- -2.1.1 +2.1.4 diff --git a/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch b/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch index 93314312f..76beafd03 100644 --- a/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch +++ b/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch @@ -1,12 +1,8 @@ -From 3aef808eee43c973ae1fbf6e8769d89b7f0d355b Mon Sep 17 00:00:00 2001 +From a020dd27eda45263db6ac887df4a94efb6ca86db Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Tue, 10 Jun 2014 14:47:42 +0000 +Date: Thu, 2 Jul 2015 21:36:02 +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 ---- WaiAppStatic/Storage/Embedded.hs | 8 ++++---- @@ -14,10 +10,10 @@ Splicer. 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs -index db2b835..b2c1aec 100644 +index 228582d..7d72bb0 100644 --- a/Network/Wai/Application/Static.hs +++ b/Network/Wai/Application/Static.hs -@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO) +@@ -34,8 +34,6 @@ import Control.Monad.IO.Class (liftIO) import Blaze.ByteString.Builder (toByteString) @@ -26,10 +22,10 @@ index db2b835..b2c1aec 100644 import Data.Text (Text) import qualified Data.Text as T -@@ -198,8 +196,6 @@ staticAppPieces _ _ req sendResponse +@@ -218,8 +216,6 @@ staticAppPieces _ _ req sendResponse H.status405 [("Content-Type", "text/plain")] - "Only GET is supported" + "Only GET or HEAD is supported" -staticAppPieces _ [".hidden", "folder.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")] -staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")] staticAppPieces ss rawPieces req sendResponse = liftIO $ do @@ -55,10 +51,10 @@ index daa6e50..9873d4e 100644 -import WaiAppStatic.Storage.Embedded.TH +--import WaiAppStatic.Storage.Embedded.TH diff --git a/wai-app-static.cabal b/wai-app-static.cabal -index ef6f898..9a59d71 100644 +index 4cca237..3fbfcee 100644 --- a/wai-app-static.cabal +++ b/wai-app-static.cabal -@@ -33,7 +33,6 @@ library +@@ -35,7 +35,6 @@ library , containers >= 0.2 , time >= 1.1.4 , old-locale >= 1.0.0.2 @@ -66,7 +62,7 @@ index ef6f898..9a59d71 100644 , text >= 0.7 , blaze-builder >= 0.2.1.4 , base64-bytestring >= 0.1 -@@ -61,9 +60,8 @@ library +@@ -63,9 +62,8 @@ library WaiAppStatic.Listing WaiAppStatic.Types WaiAppStatic.CmdLine @@ -78,5 +74,5 @@ index ef6f898..9a59d71 100644 extensions: CPP -- -2.0.0 +2.1.4 diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch index f58fcb353..723ec099a 100644 --- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch @@ -1,6 +1,6 @@ -From f1feea61dcba0b16afed5ce8dd5d2433fe505461 Mon Sep 17 00:00:00 2001 +From bec7dac77cc7fbe9a620c371d7c2cdbcf234eac6 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:15:23 +0000 +Date: Fri, 3 Jul 2015 00:39:53 +0000 Subject: [PATCH] hack TH --- @@ -15,7 +15,7 @@ Subject: [PATCH] hack TH 8 files changed, 213 insertions(+), 288 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs -index 9b29317..7c0792d 100644 +index f7436e6..2fa62cc 100644 --- a/Yesod/Core.hs +++ b/Yesod/Core.hs @@ -31,16 +31,16 @@ module Yesod.Core @@ -45,7 +45,7 @@ index 9b29317..7c0792d 100644 -- * Sessions , SessionBackend (..) , customizeSessionCookies -@@ -87,17 +87,15 @@ module Yesod.Core +@@ -90,17 +90,15 @@ module Yesod.Core , readIntegral -- * Shakespeare -- ** Hamlet @@ -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 8631d27..c40eb10 100644 +index c2e707a..b594353 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 8631d27..c40eb10 100644 import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) - import Control.Arrow ((***), second) +@@ -18,7 +22,7 @@ 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.Logger (LogLevel (LevelInfo, LevelOther), +- LogSource) ++ LogSource, Loc) + 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,7 +105,7 @@ index 8631d27..c40eb10 100644 import Network.HTTP.Types (encodePath) import qualified Network.Wai as W import Data.Default (def) -@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where +@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage @@ -143,7 +144,7 @@ index 8631d27..c40eb10 100644 -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid -@@ -374,45 +385,103 @@ widgetToPageContent w = do +@@ -410,45 +421,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 @@ -286,7 +287,7 @@ index 8631d27..c40eb10 100644 return $ PageContent title headAll $ case jsLoader master of -@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -478,10 +547,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" @@ -304,7 +305,7 @@ index 8631d27..c40eb10 100644 provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. -@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -491,10 +563,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" @@ -320,7 +321,7 @@ index 8631d27..c40eb10 100644 provideRep $ do -- 401 *MUST* include a WWW-Authenticate header -@@ -480,10 +553,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do +@@ -516,10 +589,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -338,7 +339,7 @@ index 8631d27..c40eb10 100644 provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) -@@ -492,30 +568,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do +@@ -528,30 +604,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" @@ -396,7 +397,7 @@ index 8631d27..c40eb10 100644 provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text) -@@ -682,8 +770,4 @@ loadClientSession key getCachedDate sessionName req = load +@@ -718,8 +806,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 @@ -407,7 +408,7 @@ index 8631d27..c40eb10 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 7e43f74..625a901 100644 --- a/Yesod/Core/Dispatch.hs +++ b/Yesod/Core/Dispatch.hs @@ -1,4 +1,3 @@ @@ -444,9 +445,9 @@ index e0d1f0e..cc23fdd 100644 , PathMultiPiece (..) , Texts -- * Convert to WAI -@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do - , yreSite = site +@@ -141,13 +140,6 @@ toWaiAppLogger logger site = do , yreSessionBackend = sb + , yreGen = gen } - messageLoggerSource - site @@ -458,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 -> +@@ -167,14 +159,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 @@ -469,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 +@@ -208,7 +193,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr -- | Deprecated synonym for 'warp'. warpDebug :: YesodDispatch site => Int -> site -> IO () warpDebug = warp @@ -483,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 d2b196b..13cac17 100644 +index 19f4152..c97fb24 100644 --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs -@@ -174,7 +174,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +@@ -178,7 +178,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 @@ -495,7 +496,7 @@ index d2b196b..13cac17 100644 import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -@@ -203,6 +203,7 @@ import Control.Exception (throwIO) +@@ -206,6 +206,7 @@ import Control.Exception (throwIO) import Blaze.ByteString.Builder (Builder) import Safe (headMay) import Data.CaseInsensitive (CI) @@ -503,7 +504,7 @@ index d2b196b..13cac17 100644 import qualified Data.Conduit.List as CL import Control.Monad (unless) import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO -@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) +@@ -848,19 +849,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) -> m a redirectToPost url = do urlText <- toTextUrl url @@ -533,7 +534,7 @@ index d2b196b..13cac17 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 311f208..63f666f 100644 +index 651c11c..46e1d2a 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs @@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) @@ -543,18 +544,18 @@ index 311f208..63f666f 100644 -import Control.Monad.Logger (LogLevel (LevelError), LogSource, +import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource, liftLoc) - import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) + import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState) import qualified Data.ByteString as S -@@ -31,7 +31,7 @@ import qualified Data.Text as T - import Data.Text.Encoding (encodeUtf8) +@@ -32,7 +32,7 @@ import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) + import Data.Time (getCurrentTime, addUTCTime) -import Language.Haskell.TH.Syntax (Loc, qLocation) +import Language.Haskell.TH.Syntax (qLocation) import qualified Network.HTTP.Types as H import Network.Wai - #if MIN_VERSION_wai(2, 0, 0) -@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + import Network.Wai.Internal +@@ -160,8 +160,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp safeEh log' er req = do @@ -683,26 +684,26 @@ index 7e84c1c..a273c29 100644 - ] - return $ LetE [fun] (VarE helper) diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs -index 388dfe3..b3fce0f 100644 +index 5fa5c3d..1646d54 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 (..)) -@@ -191,7 +192,7 @@ data RunHandlerEnv site = RunHandlerEnv +@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv , rheRoute :: !(Maybe (Route site)) , rheSite :: !site , rheUpload :: !(RequestBodyLength -> FileUpload) - , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ()) , rheOnError :: !(ErrorResponse -> YesodApp) + , rheGetMaxExpires :: IO Text -- ^ How to respond when an error is thrown internally. - -- diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs index 481199e..8489fbe 100644 --- a/Yesod/Core/Widget.hs @@ -764,5 +765,5 @@ index 481199e..8489fbe 100644 ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -2.1.1 +2.1.4 diff --git a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch index 84314a8d9..b9a84b1ad 100644 --- a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch +++ b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch @@ -1,22 +1,27 @@ -From 1b24ece1a40c9365f719472ca6e342c8c4065c25 Mon Sep 17 00:00:00 2001 +From 4cf9a045569ea0b51b4ee11df2dadbde330f7813 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:31:20 +0000 +Date: Fri, 3 Jul 2015 01:06:34 +0000 Subject: [PATCH] hack TH +1. EvilSplicer +2. Add imports +3. Fix some syntax errors in spliced code +4. Remove some persistent stuff that doesn't build. --- - Yesod/Form/Bootstrap3.hs | 186 +++++++++-- - Yesod/Form/Fields.hs | 816 +++++++++++++++++++++++++++++++++++------------ - Yesod/Form/Functions.hs | 257 ++++++++++++--- - Yesod/Form/Jquery.hs | 134 ++++++-- + Yesod/Form/Bootstrap3.hs | 189 +++++++++-- + Yesod/Form/Fields.hs | 811 ++++++++++++++++++++++++++++++++++++----------- + Yesod/Form/Functions.hs | 255 ++++++++++++--- + Yesod/Form/Jquery.hs | 124 ++++++-- Yesod/Form/MassInput.hs | 226 ++++++++++--- - Yesod/Form/Nic.hs | 67 +++- - 6 files changed, 1322 insertions(+), 364 deletions(-) + Yesod/Form/Nic.hs | 60 +++- + yesod-form.cabal | 2 +- + 7 files changed, 1311 insertions(+), 356 deletions(-) diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs -index 84e85fc..1954fb4 100644 +index 8377a68..fa8b7d4 100644 --- a/Yesod/Form/Bootstrap3.hs +++ b/Yesod/Form/Bootstrap3.hs -@@ -26,6 +26,9 @@ import Data.String (IsString(..)) +@@ -35,6 +35,9 @@ import Data.String (IsString(..)) import Yesod.Core import qualified Data.Text as T @@ -26,7 +31,7 @@ index 84e85fc..1954fb4 100644 import Yesod.Form.Types import Yesod.Form.Functions -@@ -152,44 +155,144 @@ renderBootstrap3 formLayout aform fragment = do +@@ -155,44 +158,144 @@ renderBootstrap3 formLayout aform fragment = do let views = views' [] has (Just _) = True has Nothing = False @@ -59,22 +64,22 @@ index 84e85fc..1954fb4 100644 - |] + widget = do { (asWidgetT . toWidget) (toHtml fragment); + Data.Foldable.mapM_ -+ (\ view_as0a ++ (\ view_a2d4p + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<div class=\"form-group "); + Text.Hamlet.condH -+ [(fvRequired view_as0a, ++ [(fvRequired view_a2d4p, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "required "))] + Nothing; + Text.Hamlet.condH -+ [(not (fvRequired view_as0a), ++ [(not (fvRequired view_a2d4p), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "optional "))] + Nothing; + Text.Hamlet.condH -+ [(has (fvErrors view_as0a), ++ [(has (fvErrors view_a2d4p), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "has-error"))] + Nothing; @@ -83,66 +88,66 @@ index 84e85fc..1954fb4 100644 + case formLayout of { + ; BootstrapBasicForm + -> do { Text.Hamlet.condH -+ [((/=) (fvId view_as0a) bootstrapSubmitId, ++ [((/=) (fvId view_a2d4p) bootstrapSubmitId, + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_as0a)); ++ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "</label>") })] + Nothing; -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a) } ++ (asWidgetT . toWidget) (fvInput view_a2d4p); ++ (asWidgetT . toWidget) (helpWidget view_a2d4p) } + ; BootstrapInlineForm + -> do { Text.Hamlet.condH -+ [((/=) (fvId view_as0a) bootstrapSubmitId, ++ [((/=) (fvId view_a2d4p) bootstrapSubmitId, + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<label class=\"sr-only\" for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_as0a)); ++ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "</label>") })] + Nothing; -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a) } -+ ; BootstrapHorizontalForm labelOffset_as0b -+ labelSize_as0c -+ inputOffset_as0d -+ inputSize_as0e ++ (asWidgetT . toWidget) (fvInput view_a2d4p); ++ (asWidgetT . toWidget) (helpWidget view_a2d4p) } ++ ; BootstrapHorizontalForm labelOffset_a2d4q ++ labelSize_a2d4r ++ inputOffset_a2d4s ++ inputSize_a2d4t + -> Text.Hamlet.condH -+ [((/=) (fvId view_as0a) bootstrapSubmitId, ++ [((/=) (fvId view_a2d4p) bootstrapSubmitId, + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<label class=\"control-label "); -+ (asWidgetT . toWidget) (toHtml (toOffset labelOffset_as0b)); ++ (asWidgetT . toWidget) (toHtml (toOffset labelOffset_a2d4q)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) " "); -+ (asWidgetT . toWidget) (toHtml (toColumn labelSize_as0c)); ++ (asWidgetT . toWidget) (toHtml (toColumn labelSize_a2d4r)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "\" for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_as0a)); ++ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "</label><div class=\""); -+ (asWidgetT . toWidget) (toHtml (toOffset inputOffset_as0d)); ++ (asWidgetT . toWidget) (toHtml (toOffset inputOffset_a2d4s)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) " "); -+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_as0e)); ++ (asWidgetT . toWidget) (toHtml (toColumn inputSize_a2d4t)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a); ++ (asWidgetT . toWidget) (fvInput view_a2d4p); ++ (asWidgetT . toWidget) (helpWidget view_a2d4p); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "</div>") })] + (Just @@ -153,15 +158,15 @@ index 84e85fc..1954fb4 100644 + (toHtml + (toOffset + (addGO -+ inputOffset_as0d -+ (addGO labelOffset_as0b labelSize_as0c)))); ++ inputOffset_a2d4s ++ (addGO labelOffset_a2d4q labelSize_a2d4r)))); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) " "); -+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_as0e)); ++ (asWidgetT . toWidget) (toHtml (toColumn inputSize_a2d4t)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a); ++ (asWidgetT . toWidget) (fvInput view_a2d4p); ++ (asWidgetT . toWidget) (helpWidget view_a2d4p); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "</div>") })) }; @@ -182,21 +187,21 @@ index 84e85fc..1954fb4 100644 -|] +helpWidget view = do { Text.Hamlet.maybeH + (fvTooltip view) -+ (\ tt_as0k ++ (\ tt_a2d5x + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml tt_as0k); ++ (asWidgetT . toWidget) (toHtml tt_a2d5x); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") }) + Nothing; + Text.Hamlet.maybeH + (fvErrors view) -+ (\ err_as0l ++ (\ err_a2d5y + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml err_as0l); ++ (asWidgetT . toWidget) (toHtml err_a2d5y); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") }) + Nothing } @@ -204,7 +209,7 @@ index 84e85fc..1954fb4 100644 -- | How the 'bootstrapSubmit' button should be rendered. -@@ -244,7 +347,22 @@ mbootstrapSubmit +@@ -247,7 +350,23 @@ mbootstrapSubmit => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) mbootstrapSubmit (BootstrapSubmit msg classes attrs) = let res = FormSuccess () @@ -221,40 +226,26 @@ index 84e85fc..1954fb4 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) ">"); + ((liftM (toHtml .) getMessageRender) -+ >>= (\ urender_as0w -> (asWidgetT . toWidget) (urender_as0w msg))); ++ >>= ++ (\ urender_a2d6f -> (asWidgetT . toWidget) (urender_a2d6f msg))); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . T.pack) "</button>") } + fv = FieldView { fvLabel = "" , fvTooltip = Nothing , fvId = bootstrapSubmitId +@@ -314,4 +433,4 @@ bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id" + -- > <$> areq textField nameSettings Nothing + -- > where nameSettings = withAutofocus $ + -- > withPlaceholder "First name" $ +--- > (bfs ("Name" :: Text)) +\ No newline at end of file ++-- > (bfs ("Name" :: Text)) diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs -index c6091a9..9e6bd4e 100644 +index 5fe123e..42fd7d6 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs -@@ -1,4 +1,3 @@ --{-# LANGUAGE QuasiQuotes #-} - {-# LANGUAGE TypeFamilies #-} - {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE GeneralizedNewtypeDeriving #-} -@@ -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 -- , checkboxesFieldList -- , checkboxesField - , multiSelectField - , multiSelectFieldList +@@ -52,8 +52,6 @@ module Yesod.Form.Fields , Option (..) , OptionList (..) , mkOptionList @@ -263,7 +254,7 @@ index c6091a9..9e6bd4e 100644 , optionsPairs , optionsEnum ) where -@@ -72,6 +64,15 @@ import Control.Monad (when, unless) +@@ -80,6 +78,15 @@ import Control.Monad (when, unless) import Data.Either (partitionEithers) import Data.Maybe (listToMaybe, fromMaybe) @@ -279,14 +270,7 @@ index c6091a9..9e6bd4e 100644 import qualified Blaze.ByteString.Builder.Html.Utf8 as B import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder.Internal.Write (fromWriteList) -@@ -91,15 +92,12 @@ import qualified Data.Text as T (drop, dropWhile) - import qualified Data.Text.Read - - import qualified Data.Map as Map --import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery) - import Control.Arrow ((&&&)) - - import Control.Applicative ((<$>), (<|>)) +@@ -102,8 +109,6 @@ import Control.Applicative ((<$>), (<|>)) import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly) @@ -295,7 +279,7 @@ index c6091a9..9e6bd4e 100644 defaultFormMessage :: FormMessage -> Text defaultFormMessage = englishFormMessage -@@ -111,10 +109,25 @@ intField = Field +@@ -115,10 +120,25 @@ intField = Field Right (a, "") -> Right a _ -> Left $ MsgInvalidInteger s @@ -303,7 +287,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input id="#{theId}" name="#{name}" *{attrs} type="number" step=1 :isReq:required="" value="#{showVal val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJh ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nCq + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); @@ -325,7 +309,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } where -@@ -128,10 +141,25 @@ doubleField = Field +@@ -133,10 +153,25 @@ doubleField = Field Right (a, "") -> Right a _ -> Left $ MsgInvalidNumber s @@ -333,7 +317,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input id="#{theId}" name="#{name}" *{attrs} type="number" step=any :isReq:required="" value="#{showVal val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJu ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nCV + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); @@ -355,7 +339,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) -@@ -139,10 +167,24 @@ $newline never +@@ -147,10 +182,24 @@ $newline never dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day dayField = Field { fieldParse = parseHelper $ parseDate . unpack @@ -363,7 +347,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJF ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nDh + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); @@ -384,20 +368,22 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) -@@ -150,10 +192,23 @@ $newline never - timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay - timeField = Field +@@ -179,10 +228,25 @@ timeFieldTypeText = timeFieldOfType "text" + timeFieldOfType :: Monad m => RenderMessage (HandlerSite m) FormMessage => Text -> Field m TimeOfDay + timeFieldOfType inputType = Field { fieldParse = parseHelper parseTime - , fieldView = \theId name attrs val isReq -> toWidget [hamlet| -$newline never --<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}"> +-<input id="#{theId}" name="#{name}" *{attrs} type="#{inputType}" :isReq:required="" value="#{showVal val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJT ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nDN + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); + id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); + id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\""); ++ id (toHtml inputType); + id ((Text.Blaze.Internal.preEscapedText . pack) "\""); + condH + [(isReq, @@ -412,7 +398,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } where -@@ -166,10 +221,23 @@ $newline never +@@ -196,10 +260,23 @@ $newline never htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html htmlField = Field { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance @@ -420,7 +406,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<textarea :isReq:required="" id="#{theId}" name="#{name}" *{attrs}>#{showVal val} -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJK4 ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nEc + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<textarea"); + condH @@ -440,21 +426,25 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . renderHtml) -@@ -197,10 +265,18 @@ instance ToHtml Textarea where +@@ -231,10 +308,22 @@ 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}" *{attrs}>#{either id unTextarea val} +-<textarea id="#{theId}" name="#{name}" :isReq:required="" *{attrs}>#{either id unTextarea val} -|] -+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_aJKe ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nEL + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\""); + id (toHtml theId); + id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); + id (toHtml name); + id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; + id ((attrsToHtml . toAttributes) attrs); + id ((Text.Blaze.Internal.preEscapedText . pack) ">"); + id (toHtml (either id unTextarea val)); @@ -463,7 +453,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } -@@ -208,10 +284,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) +@@ -243,10 +332,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) => Field m p hiddenField = Field { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece @@ -471,7 +461,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}"> -|] -+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_aJKo ++ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_a2nFl + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) + "<input type=\"hidden\" id=\""); @@ -487,7 +477,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } -@@ -219,20 +304,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex +@@ -255,20 +353,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex textField = Field { fieldParse = parseHelper $ Right , fieldView = \theId name attrs val isReq -> @@ -519,7 +509,7 @@ index c6091a9..9e6bd4e 100644 + , fieldEnctype = UrlEncoded } - + -- | Creates an input with @type="password"@. passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text passwordField = Field { fieldParse = parseHelper $ Right @@ -527,7 +517,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJKH ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nG7 + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); @@ -549,7 +539,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } -@@ -304,10 +422,24 @@ emailField = Field +@@ -342,10 +473,24 @@ emailField = Field case Email.canonicalizeEmail $ encodeUtf8 s of Just e -> Right $ decodeUtf8With lenientDecode e Nothing -> Left $ MsgInvalidEmail s @@ -557,7 +547,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJLq ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nKu + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); @@ -578,7 +568,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } -@@ -322,10 +454,25 @@ multiEmailField = Field +@@ -360,10 +505,25 @@ multiEmailField = Field in case partitionEithers addrs of ([], good) -> Right good (bad, _) -> Left $ MsgInvalidEmail $ cat bad @@ -586,7 +576,7 @@ index c6091a9..9e6bd4e 100644 -$newline never -<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}"> -|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJMd ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nL5 + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); @@ -608,7 +598,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } where -@@ -341,20 +488,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus +@@ -380,20 +540,74 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus searchField autoFocus = Field { fieldParse = parseHelper Right , fieldView = \theId name attrs val isReq -> do @@ -661,32 +651,31 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) + "').focus();}</script>") } + -+ toWidget $ \ _render_aJMx -+ -> (Text.Css.CssNoWhitespace -+ . (foldr ($) [])) ++ toWidget $ \ _render_a2nMA ++ -> (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.fromText ++ . Text.Css.pack) ++ "#", ++ toCss theId], + Text.Css.blockAttrs = (Prelude.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.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 []) @@ -695,8 +684,8 @@ index c6091a9..9e6bd4e 100644 + , fieldEnctype = UrlEncoded } - -@@ -365,7 +567,28 @@ urlField = Field + -- | Creates an input with @type="url"@, validating the URL according to RFC3986. +@@ -404,7 +618,28 @@ urlField = Field Nothing -> Left $ MsgInvalidUrl s Just _ -> Right s , fieldView = \theId name attrs val isReq -> @@ -726,7 +715,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } -@@ -378,18 +601,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) +@@ -423,18 +658,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) a selectField = selectFieldHelper @@ -769,8 +758,8 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) ">"); + ((Control.Monad.liftM (toHtml .) getMessageRender) + >>= -+ (\ urender_aJMX -+ -> (asWidgetT . toWidget) (urender_aJMX MsgSelectNone))); ++ (\ urender_a2nOk ++ -> (asWidgetT . toWidget) (urender_a2nOk MsgSelectNone))); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) + -- onOpt @@ -791,9 +780,9 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) + -- inside + -- | Creates a @\<select>@ tag for selecting multiple options. multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) - => [(msg, a)] -@@ -412,11 +671,45 @@ multiSelectField ioptlist = +@@ -459,11 +730,45 @@ multiSelectField ioptlist = view theId name attrs val isReq = do opts <- fmap olOptions $ handlerToWidget ioptlist let selOpts = map (id &&& (optselected val)) opts @@ -821,20 +810,20 @@ index c6091a9..9e6bd4e 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) ">"); + Data.Foldable.mapM_ -+ (\ (opt_aJNs, optsel_aJNt) ++ (\ (opt_a2nPy, optsel_a2nPz) + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); -+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_aJNs)); ++ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_a2nPy)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\""); + condH -+ [(optsel_aJNt, ++ [(optsel_a2nPz, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] + Nothing; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_aJNs)); ++ (asWidgetT . toWidget) (toHtml (optionDisplay opt_a2nPy)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) + selOpts; @@ -844,7 +833,7 @@ index c6091a9..9e6bd4e 100644 where optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals -@@ -439,54 +732,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) +@@ -489,37 +794,115 @@ checkboxesField ioptlist = (multiSelectField ioptlist) opts <- fmap olOptions $ handlerToWidget ioptlist let optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals @@ -861,25 +850,25 @@ index c6091a9..9e6bd4e 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\">"); + Data.Foldable.mapM_ -+ (\ opt_aJNI ++ (\ opt_a2nQo + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<label><input type=\"checkbox\" name=\""); + (asWidgetT . toWidget) (toHtml name); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_aJNI)); ++ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_a2nQo)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\""); + condH -+ [(optselected val opt_aJNI, ++ [(optselected val opt_a2nQo, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] + Nothing; + (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_aJNI)); ++ (asWidgetT . toWidget) (toHtml (optionDisplay opt_a2nQo)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }) + opts; @@ -887,7 +876,7 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) "</span>") } + } - + -- | Creates an input with @type="radio"@ for selecting one option. radioField :: (Eq a, RenderMessage site FormMessage) => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) a @@ -942,8 +931,8 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) ">"); + ((Control.Monad.liftM (toHtml .) getMessageRender) + >>= -+ (\ urender_aJNY -+ -> (asWidgetT . toWidget) (urender_aJNY MsgSelectNone))); ++ (\ urender_a2nR7 ++ -> (asWidgetT . toWidget) (urender_a2nR7 MsgSelectNone))); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) + @@ -983,6 +972,9 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) + + -- | Creates a group of radio buttons to answer the question given in the message. Radio buttons are used to allow differentiating between an empty response (@Nothing@) and a no response (@Just False@). Consider using the simpler 'checkBoxField' if you don't need to make this distinction. + -- +@@ -531,19 +914,83 @@ $newline never boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool boolField = Field { fieldParse = \e _ -> return $ boolParser e @@ -992,6 +984,9 @@ index c6091a9..9e6bd4e 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) @@ -1012,8 +1007,8 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) "-none\">"); + ((Control.Monad.liftM (toHtml .) getMessageRender) + >>= -+ (\ urender_aJOn -+ -> (asWidgetT . toWidget) (urender_aJOn MsgSelectNone))); ++ (\ urender_a2nSk ++ -> (asWidgetT . toWidget) (urender_a2nSk MsgSelectNone))); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] + Nothing; @@ -1039,8 +1034,8 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">"); + ((Control.Monad.liftM (toHtml .) getMessageRender) + >>= -+ (\ urender_aJOo -+ -> (asWidgetT . toWidget) (urender_aJOo MsgBoolYes))); ++ (\ urender_a2nSl ++ -> (asWidgetT . toWidget) (urender_a2nSl MsgBoolYes))); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "</label><input id=\""); @@ -1064,21 +1059,18 @@ index c6091a9..9e6bd4e 100644 + ((Text.Blaze.Internal.preEscapedText . pack) "-no\">"); + ((Control.Monad.liftM (toHtml .) getMessageRender) + >>= -+ (\ urender_aJOp -+ -> (asWidgetT . toWidget) (urender_aJOp MsgBoolNo))); ++ (\ urender_a2nSm ++ -> (asWidgetT . toWidget) (urender_a2nSm MsgBoolNo))); + (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 -@@ -512,10 +947,24 @@ $newline never +@@ -570,10 +1017,24 @@ $newline never checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool checkBoxField = Field { fieldParse = \e _ -> return $ checkBoxParser e @@ -1107,25 +1099,31 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = UrlEncoded } -@@ -559,69 +1008,6 @@ optionsPairs opts = do +@@ -619,66 +1080,6 @@ optionsPairs opts = do optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] --#if MIN_VERSION_persistent(2, 0, 0) +--- | Selects a list of 'Entity's with the given 'Filter' and 'SelectOpt's. The @(a -> msg)@ function is then used to derive the display value for an 'OptionList'. Example usage: +--- +--- > Country +--- > name Text +--- > deriving Eq -- Must derive Eq +--- +--- > data CountryForm = CountryForm +--- > { country :: Entity Country +--- > } +--- > +--- > countryNameForm :: AForm Handler CountryForm +--- > countryNameForm = CountryForm +--- > <$> areq (selectField countries) "Which country do you live in?" Nothing +--- > where +--- > countries = optionsPersist [] [Asc CountryName] countryName -optionsPersist :: ( YesodPersist site, PersistEntity a - , PersistQuery (PersistEntityBackend a) - , PathPiece (Key a) - , RenderMessage site msg - , YesodPersistBackend site ~ PersistEntityBackend a - ) --#else --optionsPersist :: ( YesodPersist site, PersistEntity a -- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) -- , PathPiece (Key a) -- , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO)) -- , RenderMessage site msg -- ) --#endif - => [Filter a] - -> [SelectOpt a] - -> (a -> msg) @@ -1139,11 +1137,10 @@ index c6091a9..9e6bd4e 100644 - , optionExternalValue = toPathPiece key - }) pairs - ---- | An alternative to 'optionsPersist' which returns just the @Key@ instead of ---- the entire @Entity@. +--- | An alternative to 'optionsPersist' which returns just the 'Key' instead of +--- the entire 'Entity'. --- --- Since 1.3.2 --#if MIN_VERSION_persistent(2, 0, 0) -optionsPersistKey - :: (YesodPersist site - , PersistEntity a @@ -1152,15 +1149,6 @@ index c6091a9..9e6bd4e 100644 - , RenderMessage site msg - , YesodPersistBackend site ~ PersistEntityBackend a - ) --#else --optionsPersistKey -- :: (YesodPersist site -- , PersistEntity a -- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) -- , PathPiece (Key a) -- , RenderMessage site msg -- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)) --#endif - => [Filter a] - -> [SelectOpt a] - -> (a -> msg) @@ -1174,17 +1162,18 @@ index c6091a9..9e6bd4e 100644 - , optionInternalValue = key - , optionExternalValue = toPathPiece key - }) pairs - +- selectFieldHelper :: (Eq a, RenderMessage site FormMessage) -@@ -665,9 +1051,21 @@ fileField = Field + => (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ()) +@@ -722,9 +1123,21 @@ fileField = Field case files of [] -> Right Nothing file:_ -> Right $ Just file - , fieldView = \id' name attrs _ isReq -> toWidget [hamlet| - <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required> - |] -+ , fieldView = \id' name attrs _ isReq -> toWidget $ \ _render_aJPt ++ , fieldView = \id' name attrs _ isReq -> toWidget $ \ _render_a2nUV + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml id'); @@ -1202,7 +1191,7 @@ index c6091a9..9e6bd4e 100644 , fieldEnctype = Multipart } -@@ -694,10 +1092,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do +@@ -751,10 +1164,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' @@ -1226,7 +1215,7 @@ index c6091a9..9e6bd4e 100644 , fvErrors = errs , fvRequired = True } -@@ -726,10 +1133,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do +@@ -783,10 +1205,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' @@ -1251,28 +1240,26 @@ index c6091a9..9e6bd4e 100644 , fvRequired = False } diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs -index 9e6abaf..0c2a0ce 100644 +index 0d83b79..61e9b66 100644 --- a/Yesod/Form/Functions.hs +++ b/Yesod/Form/Functions.hs -@@ -60,12 +60,16 @@ import Text.Blaze (Markup, toMarkup) +@@ -60,12 +60,14 @@ import Text.Blaze (Markup, toMarkup) #define toHtml toMarkup import Yesod.Core import Network.Wai (requestMethod) -import Text.Hamlet (shamlet) -+--import Text.Hamlet (shamlet) import Data.Monoid (mempty) import Data.Maybe (listToMaybe, fromMaybe) import qualified Data.Map as Map import qualified Data.Text.Encoding as TE import Control.Arrow (first) ++import qualified Text.Hamlet +import qualified Text.Blaze.Internal -+import qualified Yesod.Core.Widget +import qualified Data.Foldable -+import qualified Text.Hamlet -- | Get a unique identifier. newFormIdent :: Monad m => MForm m Text -@@ -217,7 +221,14 @@ postHelper form env = do +@@ -217,7 +219,14 @@ postHelper form env = do let token = case reqToken req of Nothing -> mempty @@ -1288,7 +1275,7 @@ index 9e6abaf..0c2a0ce 100644 m <- getYesod langs <- languages ((res, xml), enctype) <- runFormGeneric (form token) m langs env -@@ -297,7 +308,12 @@ getHelper :: MonadHandler m +@@ -298,7 +307,12 @@ getHelper :: MonadHandler m -> Maybe (Env, FileEnv) -> m (a, Enctype) getHelper form env = do @@ -1302,7 +1289,7 @@ index 9e6abaf..0c2a0ce 100644 langs <- languages m <- getYesod runFormGeneric (form fragment) m langs env -@@ -332,10 +348,15 @@ identifyForm +@@ -333,10 +347,15 @@ identifyForm identifyForm identVal form = \fragment -> do -- Create hidden <input>. let fragment' = @@ -1322,7 +1309,7 @@ index 9e6abaf..0c2a0ce 100644 -- Check if we got its value back. mp <- askParams -@@ -365,22 +386,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a +@@ -366,22 +385,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a renderTable aform fragment = do (res, views') <- aFormToForm aform let views = views' [] @@ -1345,20 +1332,20 @@ index 9e6abaf..0c2a0ce 100644 + let widget = do { Text.Hamlet.condH + [(null views, (asWidgetT . toWidget) (toHtml fragment))] Nothing; + Data.Foldable.mapM_ -+ (\ (isFirst_ab5u, view_ab5v) ++ (\ (isFirst_aNqW, view_aNqX) + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "<tr"); + Text.Hamlet.condH -+ [(or [fvRequired view_ab5v, not (fvRequired view_ab5v)], ++ [(or [fvRequired view_aNqX, not (fvRequired view_aNqX)], + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); + Text.Hamlet.condH -+ [(fvRequired view_ab5v, ++ [(fvRequired view_aNqX, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "required "))] + Nothing; + Text.Hamlet.condH -+ [(not (fvRequired view_ab5v), ++ [(not (fvRequired view_aNqX), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] + Nothing; @@ -1368,37 +1355,37 @@ index 9e6abaf..0c2a0ce 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "><td>"); + Text.Hamlet.condH -+ [(isFirst_ab5u, (asWidgetT . toWidget) (toHtml fragment))] Nothing; ++ [(isFirst_aNqW, (asWidgetT . toWidget) (toHtml fragment))] Nothing; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_ab5v)); ++ (asWidgetT . toWidget) (toHtml (fvId view_aNqX)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5v)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_aNqX)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</label>"); + Text.Hamlet.maybeH -+ (fvTooltip view_ab5v) -+ (\ tt_ab5w ++ (fvTooltip view_aNqX) ++ (\ tt_aNqY + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_ab5w); ++ (asWidgetT . toWidget) (toHtml tt_aNqY); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) + Nothing; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>"); -+ (asWidgetT . toWidget) (fvInput view_ab5v); ++ (asWidgetT . toWidget) (fvInput view_aNqX); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</td>"); + Text.Hamlet.maybeH -+ (fvErrors view_ab5v) -+ (\ err_ab5x ++ (fvErrors view_aNqX) ++ (\ err_aNqZ + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<td class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_ab5x); ++ (asWidgetT . toWidget) (toHtml err_aNqZ); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</td>") }) + Nothing; @@ -1409,7 +1396,7 @@ index 9e6abaf..0c2a0ce 100644 return (res, widget) where addIsFirst [] = [] -@@ -396,19 +465,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a +@@ -397,19 +464,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a renderDivsMaybeLabels withLabels aform fragment = do (res, views') <- aFormToForm aform let views = views' [] @@ -1428,20 +1415,20 @@ index 9e6abaf..0c2a0ce 100644 -|] + let widget = do { (asWidgetT . toWidget) (toHtml fragment); + Data.Foldable.mapM_ -+ (\ view_ab5K ++ (\ view_aNsz + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "<div"); + Text.Hamlet.condH -+ [(or [fvRequired view_ab5K, not (fvRequired view_ab5K)], ++ [(or [fvRequired view_aNsz, not (fvRequired view_aNsz)], + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); + Text.Hamlet.condH -+ [(fvRequired view_ab5K, ++ [(fvRequired view_aNsz, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "required "))] + Nothing; + Text.Hamlet.condH -+ [(not (fvRequired view_ab5K), ++ [(not (fvRequired view_aNsz), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] + Nothing; @@ -1454,31 +1441,31 @@ index 9e6abaf..0c2a0ce 100644 + [(withLabels, + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_ab5K)); ++ (asWidgetT . toWidget) (toHtml (fvId view_aNsz)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5K)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_aNsz)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] + Nothing; + Text.Hamlet.maybeH -+ (fvTooltip view_ab5K) -+ (\ tt_ab5L ++ (fvTooltip view_aNsz) ++ (\ tt_aNsL + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_ab5L); ++ (asWidgetT . toWidget) (toHtml tt_aNsL); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) + Nothing; -+ (asWidgetT . toWidget) (fvInput view_ab5K); ++ (asWidgetT . toWidget) (fvInput view_aNsz); + Text.Hamlet.maybeH -+ (fvErrors view_ab5K) -+ (\ err_ab5M ++ (fvErrors view_aNsz) ++ (\ err_aNsP + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<div class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_ab5M); ++ (asWidgetT . toWidget) (toHtml err_aNsP); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) + Nothing; @@ -1489,7 +1476,7 @@ index 9e6abaf..0c2a0ce 100644 return (res, widget) -- | Render a form using Bootstrap v2-friendly shamlet syntax. -@@ -436,19 +552,62 @@ renderBootstrap2 aform fragment = do +@@ -437,19 +551,62 @@ renderBootstrap2 aform fragment = do let views = views' [] has (Just _) = True has Nothing = False @@ -1508,53 +1495,53 @@ index 9e6abaf..0c2a0ce 100644 - |] + let widget = do { (asWidgetT . toWidget) (toHtml fragment); + Data.Foldable.mapM_ -+ (\ view_ab5Y ++ (\ view_aNw8 + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<div class=\"control-group clearfix "); + Text.Hamlet.condH -+ [(fvRequired view_ab5Y, ++ [(fvRequired view_aNw8, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "required "))] + Nothing; + Text.Hamlet.condH -+ [(not (fvRequired view_ab5Y), ++ [(not (fvRequired view_aNw8), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "optional "))] + Nothing; + Text.Hamlet.condH -+ [(has (fvErrors view_ab5Y), ++ [(has (fvErrors view_aNw8), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "error"))] + Nothing; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "\"><label class=\"control-label\" for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_ab5Y)); ++ (asWidgetT . toWidget) (toHtml (fvId view_aNw8)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5Y)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_aNw8)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "</label><div class=\"controls input\">"); -+ (asWidgetT . toWidget) (fvInput view_ab5Y); ++ (asWidgetT . toWidget) (fvInput view_aNw8); + Text.Hamlet.maybeH -+ (fvTooltip view_ab5Y) -+ (\ tt_ab5Z ++ (fvTooltip view_aNw8) ++ (\ tt_aNw9 + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml tt_ab5Z); ++ (asWidgetT . toWidget) (toHtml tt_aNw9); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) + Nothing; + Text.Hamlet.maybeH -+ (fvErrors view_ab5Y) -+ (\ err_ab60 ++ (fvErrors view_aNw8) ++ (\ err_aNwa + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml err_ab60); ++ (asWidgetT . toWidget) (toHtml err_aNwa); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) + Nothing; @@ -1566,16 +1553,15 @@ index 9e6abaf..0c2a0ce 100644 -- | Deprecated synonym for 'renderBootstrap2'. diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs -index 362eb8a..1df9966 100644 +index 63e3d57..47503c2 100644 --- a/Yesod/Form/Jquery.hs +++ b/Yesod/Form/Jquery.hs -@@ -17,11 +17,23 @@ import Yesod.Core +@@ -18,11 +18,23 @@ import Yesod.Core import Yesod.Form import Data.Time (Day) import Data.Default -import Text.Hamlet (shamlet) -import Text.Julius (julius, rawJS) -+--import Text.Hamlet (shamlet) +import Text.Julius (rawJS) import Data.Text (Text, pack, unpack) import Data.Monoid (mconcat) @@ -1591,25 +1577,27 @@ index 362eb8a..1df9966 100644 +import qualified Text.Julius +import qualified Data.Text.Lazy.Builder +import qualified Text.Shakespeare ++import qualified Data.Text.Lazy.Builder as Data.Text.Internal.Builder + -- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme. googleHostedJqueryUiCss :: Text -> Text googleHostedJqueryUiCss theme = mconcat -@@ -61,27 +73,59 @@ jqueryDayField jds = Field +@@ -71,27 +83,54 @@ jqueryDayField' jds inputType = Field . readMay . unpack , fieldView = \theId name attrs val isReq -> do - toWidget [shamlet| -$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}"> +-<input id="#{theId}" name="#{name}" *{attrs} type="#{inputType}" :isReq:required="" value="#{showVal val}"> -|] + toWidget $ do { id + ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); + id (toHtml theId); + id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); + id (toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\""); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\""); ++ id (toHtml inputType); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); + Text.Hamlet.condH + [(isReq, + id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] @@ -1638,42 +1626,36 @@ index 362eb8a..1df9966 100644 -}); -|] + toWidget $ Text.Julius.asJavascriptUrl -+ (\ _render_a2l4S ++ (\ _render_a3iGM + -> mconcat + [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\n$(function(){\n var i = document.getElementById(\""), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ "\n\n$(function(){\n\n var i = document.getElementById(\""), + Text.Julius.toJavascript (rawJS theId), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\");\n if (i.type != \"date\") {\n $(i).datepicker({\n dateFormat:'yy-mm-dd',\n changeMonth:"), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ "\");\n\n if (i.type != \"date\") {\n\n $(i).datepicker({\n\n dateFormat:'yy-mm-dd',\n\n changeMonth:"), + Text.Julius.toJavascript (jsBool (jdsChangeMonth jds)), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ ",\n changeYear:"), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ ",\n\n changeYear:"), + Text.Julius.toJavascript (jsBool (jdsChangeYear jds)), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ ",\n numberOfMonths:"), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ ",\n\n numberOfMonths:"), + Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds))), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ ",\n yearRange:"), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ ",\n\n yearRange:"), + Text.Julius.toJavascript (toJSON (jdsYearRange jds)), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\n });\n }\n});")]) ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ "\n\n });\n\n }\n\n});")]) + , fieldEnctype = UrlEncoded } where -@@ -108,16 +152,52 @@ jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site) +@@ -118,16 +157,47 @@ jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site) jqueryAutocompleteField' minLen src = Field { fieldParse = parseHelper $ Right , fieldView = \theId name attrs val isReq -> do @@ -1706,40 +1688,35 @@ index 362eb8a..1df9966 100644 -$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJSON minLen}})}); -|] + toWidget $ Text.Julius.asJavascriptUrl -+ (\ _render_a2l58 ++ (\ _render_a3iHO + -> mconcat + [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\n$(function(){$(\"#"), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ "\n\n$(function(){$(\"#"), + Text.Julius.toJavascript (rawJS theId), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') + "\").autocomplete({source:\""), + Text.Julius.Javascript -+ (Data.Text.Lazy.Builder.fromText -+ (_render_a2l58 src [])), ++ (Data.Text.Internal.Builder.fromText (_render_a3iHO src [])), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') + "\",minLength:"), + Text.Julius.toJavascript (toJSON minLen), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') + "})});")]) + , fieldEnctype = UrlEncoded } diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs -index a2b434d..75eb484 100644 +index a2b434d..29b45b5 100644 --- a/Yesod/Form/MassInput.hs +++ b/Yesod/Form/MassInput.hs -@@ -9,6 +9,16 @@ module Yesod.Form.MassInput - , massTable - ) where +@@ -22,6 +22,16 @@ import Data.Traversable (sequenceA) + import qualified Data.Map as Map + import Data.Maybe (listToMaybe) +import qualified Data.Text +import qualified Text.Blaze as Text.Blaze.Internal @@ -1751,9 +1728,9 @@ index a2b434d..75eb484 100644 +import qualified Data.Foldable +import qualified Control.Monad + - import Yesod.Form.Types - import Yesod.Form.Functions - import Yesod.Form.Fields (checkBoxField) + down :: Monad m => Int -> MForm m () + down 0 = return () + down i | i < 0 = error "called down with a negative number" @@ -70,16 +80,27 @@ inputList label fixXml single mdef = formToAForm $ do { fvLabel = label , fvTooltip = Nothing @@ -1772,7 +1749,7 @@ index a2b434d..75eb484 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>"); + Data.Foldable.mapM_ -+ (\ xml_a1yM1 -> (asWidgetT . toWidget) xml_a1yM1) xmls; ++ (\ xml_a3hPg -> (asWidgetT . toWidget) xml_a3hPg) xmls; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<input class=\"count\" type=\"hidden\" name=\""); @@ -1829,27 +1806,27 @@ index a2b434d..75eb484 100644 - <div .errors>#{err} -|] +massDivs viewss = Data.Foldable.mapM_ -+ (\ views_a1yMm ++ (\ views_a3hPz + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<fieldset>"); + Data.Foldable.mapM_ -+ (\ view_a1yMn ++ (\ view_a3hPA + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div"); + Text.Hamlet.condH -+ [(or [fvRequired view_a1yMn, not (fvRequired view_a1yMn)], ++ [(or [fvRequired view_a3hPA, not (fvRequired view_a3hPA)], + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + " class=\""); + Text.Hamlet.condH -+ [(fvRequired view_a1yMn, ++ [(fvRequired view_a3hPA, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "required "))] + Nothing; + Text.Hamlet.condH -+ [(not (fvRequired view_a1yMn), ++ [(not (fvRequired view_a3hPA), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "optional"))] @@ -1861,38 +1838,38 @@ index a2b434d..75eb484 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "><label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_a1yMn)); ++ (asWidgetT . toWidget) (toHtml (fvId view_a3hPA)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_a1yMn)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_a3hPA)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); + Text.Hamlet.maybeH -+ (fvTooltip view_a1yMn) -+ (\ tt_a1yMo ++ (fvTooltip view_a3hPA) ++ (\ tt_a3hPB + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_a1yMo); ++ (asWidgetT . toWidget) (toHtml tt_a3hPB); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</div>") }) + Nothing; -+ (asWidgetT . toWidget) (fvInput view_a1yMn); ++ (asWidgetT . toWidget) (fvInput view_a3hPA); + Text.Hamlet.maybeH -+ (fvErrors view_a1yMn) -+ (\ err_a1yMp ++ (fvErrors view_a3hPA) ++ (\ err_a3hPC + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<div class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_a1yMp); ++ (asWidgetT . toWidget) (toHtml err_a3hPC); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</div>") }) + Nothing; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") }) -+ views_a1yMm; ++ views_a3hPz; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</fieldset>") }) @@ -1900,27 +1877,27 @@ index a2b434d..75eb484 100644 + + +massTable viewss = Data.Foldable.mapM_ -+ (\ views_a1yMv ++ (\ views_a3hPH + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<fieldset><table>"); + Data.Foldable.mapM_ -+ (\ view_a1yMw ++ (\ view_a3hPI + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr"); + Text.Hamlet.condH -+ [(or [fvRequired view_a1yMw, not (fvRequired view_a1yMw)], ++ [(or [fvRequired view_a3hPI, not (fvRequired view_a3hPI)], + do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + " class=\""); + Text.Hamlet.condH -+ [(fvRequired view_a1yMw, ++ [(fvRequired view_a3hPI, + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "required "))] + Nothing; + Text.Hamlet.condH -+ [(not (fvRequired view_a1yMw), ++ [(not (fvRequired view_a3hPI), + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "optional"))] @@ -1932,19 +1909,19 @@ index a2b434d..75eb484 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "><td><label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_a1yMw)); ++ (asWidgetT . toWidget) (toHtml (fvId view_a3hPI)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_a1yMw)); ++ (asWidgetT . toWidget) (toHtml (fvLabel view_a3hPI)); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); + Text.Hamlet.maybeH -+ (fvTooltip view_a1yMw) -+ (\ tt_a1yMx ++ (fvTooltip view_a3hPI) ++ (\ tt_a3hPJ + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_a1yMx); ++ (asWidgetT . toWidget) (toHtml tt_a3hPJ); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</div>") }) @@ -1952,23 +1929,23 @@ index a2b434d..75eb484 100644 + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</td><td>"); -+ (asWidgetT . toWidget) (fvInput view_a1yMw); ++ (asWidgetT . toWidget) (fvInput view_a3hPI); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>"); + Text.Hamlet.maybeH -+ (fvErrors view_a1yMw) -+ (\ err_a1yMy ++ (fvErrors view_a3hPI) ++ (\ err_a3hPK + -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "<td class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_a1yMy); ++ (asWidgetT . toWidget) (toHtml err_a3hPK); + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</td>") }) + Nothing; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") }) -+ views_a1yMv; ++ views_a3hPH; + (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) + "</table></fieldset>") }) @@ -1990,12 +1967,19 @@ index a2b434d..75eb484 100644 - <td .errors>#{err} -|] diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs -index 7e4af07..b59745a 100644 +index 2862678..a773553 100644 --- a/Yesod/Form/Nic.hs +++ b/Yesod/Form/Nic.hs -@@ -9,11 +9,22 @@ module Yesod.Form.Nic - , nicHtmlField - ) where +@@ -12,12 +12,24 @@ module Yesod.Form.Nic + import Yesod.Core + import Yesod.Form + import Text.HTML.SanitizeXSS (sanitizeBalance) +-import Text.Hamlet (shamlet) +-import Text.Julius (julius, rawJS) ++import Text.Julius (rawJS) + import Text.Blaze.Html.Renderer.String (renderHtml) + import Data.Text (Text, pack) + import Data.Maybe (listToMaybe) +import qualified Text.Blaze as Text.Blaze.Internal +import qualified Text.Blaze.Internal @@ -2007,24 +1991,19 @@ index 7e4af07..b59745a 100644 +import qualified Control.Monad +import qualified Text.Julius +import qualified Data.Text.Lazy.Builder ++import qualified Data.Text.Lazy.Builder as Data.Text.Internal.Builder +import qualified Text.Shakespeare + - import Yesod.Core - import Yesod.Form - import Text.HTML.SanitizeXSS (sanitizeBalance) --import Text.Hamlet (shamlet) --import Text.Julius (julius, rawJS) -+import Text.Julius ( rawJS) - import Text.Blaze.Html.Renderer.String (renderHtml) - import Data.Text (Text, pack) - import Data.Maybe (listToMaybe) -@@ -27,20 +38,52 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html + class Yesod a => YesodNic a where + -- | NIC Editor Javascript file. + urlNicEdit :: a -> Either (Route a) Text +@@ -27,20 +39,44 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html nicHtmlField = Field { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e - , fieldView = \theId name attrs val isReq -> do + , fieldView = \theId name attrs val _isReq -> do - toWidget [shamlet| -$newline never -- <textarea id="#{theId}" *{attrs} name="#{name}" :isReq:required .html>#{showVal val} +- <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val} -|] + toWidget $ do { id + ((Text.Blaze.Internal.preEscapedText . pack) @@ -2033,10 +2012,6 @@ index 7e4af07..b59745a 100644 + id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); + id (toHtml name); + id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; + id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); + id ((Text.Blaze.Internal.preEscapedText . pack) ">"); + id (toHtml (showVal val)); @@ -2053,34 +2028,43 @@ index 7e4af07..b59745a 100644 -(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})(); -|] + BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl -+ (\ _render_a2rMh ++ (\ _render_a3hYy + -> Data.Monoid.mconcat + [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ "\n\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""), + Text.Julius.toJavascript (rawJS theId), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') + "\")});")]) + + _ -> Text.Julius.asJavascriptUrl -+ (\ _render_a2rMm ++ (\ _render_a3i1Q + -> Data.Monoid.mconcat + [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""), ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') ++ "\n\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""), + Text.Julius.toJavascript (rawJS theId), + Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') ++ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack') + "\")})();")]) + , fieldEnctype = UrlEncoded } where +diff --git a/yesod-form.cabal b/yesod-form.cabal +index 7849763..9694fe1 100644 +--- a/yesod-form.cabal ++++ b/yesod-form.cabal +@@ -23,7 +23,7 @@ library + , yesod-core >= 1.4 && < 1.5 + , yesod-persistent >= 1.4 && < 1.5 + , time >= 1.1.4 +- , shakespeare >= 2.0 ++ , shakespeare >= 2.0.5 + , persistent + , template-haskell + , transformers >= 0.2.2 -- -2.1.1 +2.1.4 diff --git a/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch b/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch index 76aad4e34..1b850d282 100644 --- a/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch +++ b/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch @@ -1,6 +1,6 @@ -From e82ed4e6fd7b5ea6dbe474b5de2755ec5794161c Mon Sep 17 00:00:00 2001 +From 4d8650bd806f50aa2538270f80fa93261c43d056 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:23:50 +0000 +Date: Fri, 3 Jul 2015 00:12:02 +0000 Subject: [PATCH] stub out --- @@ -8,16 +8,16 @@ Subject: [PATCH] stub out 1 file changed, 10 deletions(-) diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal -index b116f3a..017b184 100644 +index c3bc1bf..1727dba 100644 --- a/yesod-persistent.cabal +++ b/yesod-persistent.cabal -@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod. +@@ -15,16 +15,6 @@ extra-source-files: README.md ChangeLog.md library build-depends: base >= 4 && < 5 -- , yesod-core >= 1.2.2 && < 1.3 -- , persistent >= 1.2 && < 2.1 -- , persistent-template >= 1.2 && < 2.1 +- , 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 b116f3a..017b184 100644 test-suite test -- -2.1.1 +2.1.4 diff --git a/standalone/no-th/haskell-patches/yesod-static_hack.patch b/standalone/no-th/haskell-patches/yesod-static_hack.patch index 46e4b654c..20e47b5dd 100644 --- a/standalone/no-th/haskell-patches/yesod-static_hack.patch +++ b/standalone/no-th/haskell-patches/yesod-static_hack.patch @@ -1,6 +1,6 @@ -From 606c5f4f4b2d476d274907eb2bb8c12b60fc451f Mon Sep 17 00:00:00 2001 +From 09d7340ff4c9b43f7c8c2ad6529a6c60871d265f Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Wed, 21 May 2014 04:43:30 +0000 +Date: Fri, 3 Jul 2015 01:39:14 +0000 Subject: [PATCH] remove TH --- @@ -31,7 +31,7 @@ index 08febb9..e3a6d51 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 725ebf4..33eaffd 100644 +index a18d88e..afb1cda 100644 --- a/Yesod/Static.hs +++ b/Yesod/Static.hs @@ -37,8 +37,8 @@ module Yesod.Static @@ -99,7 +99,7 @@ index 725ebf4..33eaffd 100644 @@ -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 + publicFiles dir = mkStaticFiles' dir False - +-} @@ -111,17 +111,17 @@ index 725ebf4..33eaffd 100644 +{- mkStaticFiles :: Prelude.FilePath -> Q [Dec] - mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True + mkStaticFiles fp = mkStaticFiles' fp True -@@ -357,6 +361,7 @@ mkStaticFilesList fp fs routeConName makeHash = do - [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) [] +@@ -354,6 +358,7 @@ mkStaticFilesList fp fs makeHash = do + [ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) [] ] ] +-} base64md5File :: Prelude.FilePath -> IO String base64md5File = fmap (base64 . encode) . hashFile -@@ -395,7 +400,7 @@ base64 = map tr +@@ -392,7 +397,7 @@ base64 = map tr -- single static file at compile time. data CombineType = JS | CSS @@ -130,7 +130,7 @@ index 725ebf4..33eaffd 100644 combineStatics' :: CombineType -> CombineSettings -> [Route Static] -- ^ files to combine -@@ -429,7 +434,7 @@ combineStatics' combineType CombineSettings {..} routes = do +@@ -426,7 +431,7 @@ combineStatics' combineType CombineSettings {..} routes = do case combineType of JS -> "js" CSS -> "css" @@ -139,7 +139,7 @@ index 725ebf4..33eaffd 100644 -- | Data type for holding all settings for combining files. -- -- This data type is a settings type. For more information, see: -@@ -505,6 +510,7 @@ instance Default CombineSettings where +@@ -502,6 +507,7 @@ instance Default CombineSettings where errorIntro :: [FilePath] -> [Char] -> [Char] errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s @@ -147,7 +147,7 @@ index 725ebf4..33eaffd 100644 liftRoutes :: [Route Static] -> Q Exp liftRoutes = fmap ListE . mapM go -@@ -551,4 +557,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining +@@ -548,4 +554,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining -> Q Exp combineScripts' development cs con routes | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |] @@ -155,18 +155,18 @@ index 725ebf4..33eaffd 100644 + | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a +-} diff --git a/yesod-static.cabal b/yesod-static.cabal -index 2582a95..5df03b3 100644 +index 4ccb0d7..8758aaa 100644 --- a/yesod-static.cabal +++ b/yesod-static.cabal -@@ -49,7 +49,6 @@ library +@@ -50,7 +50,6 @@ library + , system-fileio >= 0.3 , data-default - , shakespeare-css >= 1.0.3 , mime-types >= 0.1 - , hjsmin , filepath >= 1.3 , resourcet >= 0.4 , unordered-containers >= 0.2 -@@ -62,13 +61,6 @@ library +@@ -63,13 +62,6 @@ library , hashable >= 1.1 exposed-modules: Yesod.Static @@ -181,13 +181,13 @@ index 2582a95..5df03b3 100644 ghc-options: -Wall extensions: TemplateHaskell @@ -108,7 +100,6 @@ test-suite tests + , system-fileio , data-default - , shakespeare-css , mime-types - , hjsmin , filepath , resourcet , unordered-containers -- -2.0.0.rc2 +2.1.4 diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch index ebf8a786b..1365b277d 100644 --- a/standalone/no-th/haskell-patches/yesod_hack-TH.patch +++ b/standalone/no-th/haskell-patches/yesod_hack-TH.patch @@ -1,13 +1,13 @@ -From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001 +From 86e7cf433fcd3386893556d690748781f46d3f03 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:36:37 +0000 +Date: Fri, 3 Jul 2015 01:33:03 +0000 Subject: [PATCH] hack TH --- Yesod.hs | 19 ++++++++++++-- - Yesod/Default/Main.hs | 31 +---------------------- - Yesod/Default/Util.hs | 69 ++------------------------------------------------- - 3 files changed, 20 insertions(+), 99 deletions(-) + Yesod/Default/Main.hs | 28 +-------------------- + Yesod/Default/Util.hs | 68 ++------------------------------------------------- + 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..bf46642 100644 +index 2694825..5a5fbb9 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@ @@ -64,7 +64,7 @@ index 565ed35..bf46642 100644 import System.Log.FastLogger (LogStr, toLogStr) import Language.Haskell.TH.Syntax (qLocation) -@@ -55,33 +53,6 @@ defaultMain load getApp = do +@@ -56,30 +54,6 @@ defaultMain load getApp = do type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () @@ -79,27 +79,24 @@ index 565ed35..bf46642 100644 -defaultMainLog load getApp = do - config <- load - (app, logFunc) <- getApp config -- runSettings defaultSettings -- { settingsPort = appPort config -- , settingsHost = appHost config -- , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc +- runSettings +- ( setPort (appPort config) +- $ setHost (appHost config) +- $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc - $(qLocation >>= liftLoc) - "yesod" - LevelError -- (toLogStr $ "Exception from Warp: " ++ show e) -- } app +- (toLogStr $ "Exception from Warp: " ++ show e)) +- $ defaultSettings +- ) 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 + -- diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs -index a10358e..0547424 100644 +index 488312a..5476b54 100644 --- a/Yesod/Default/Util.hs +++ b/Yesod/Default/Util.hs @@ -5,10 +5,9 @@ @@ -125,7 +122,7 @@ index a10358e..0547424 100644 import Text.Hamlet (HamletSettings, defaultHamletSettings) import Data.Maybe (catMaybes) import Data.Default (Default (def)) -@@ -69,68 +65,7 @@ data TemplateLanguage = TemplateLanguage +@@ -69,68 +65,8 @@ data TemplateLanguage = TemplateLanguage , tlReload :: FilePath -> Q Exp } @@ -143,7 +140,7 @@ index a10358e..0547424 100644 { wfsLanguages :: HamletSettings -> [TemplateLanguage] , wfsHamletSettings :: HamletSettings } -- + -instance Default WidgetFileSettings where - def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings - @@ -162,7 +159,7 @@ index a10358e..0547424 100644 - , func - , " on " - , show file -- , ", but no template were found." +- , ", but no templates were found." - ] - exps -> return $ DoE $ map NoBindS exps - where @@ -195,5 +192,5 @@ index a10358e..0547424 100644 - else return $ Just ex - else return Nothing -- -2.1.1 +2.1.4 |