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

reverted updates to new lib versions that broke android build

Browse source 
I ran into several evilsplicer problems with the new lib versions, most notably including a problem with encoding of embedded binary files
This commit is contained in:
androidbuilder 2015-08-02 19:48:36 +00:00
parent 4f11f9b539
commit 34c6e0ea1a
38 changed files with 2960 additions and 2987 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1190
standalone/android/cabal.config
View file

File diff suppressed because it is too large Load diff

227
standalone/android/haskell-patches/crypto-numbers_build-fix.patch Normal file
View file

@ -0,0 +1,227 @@
From 0cfdb30120976290068f4bcbebbf236b960afbb6 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 26 Dec 2013 20:01:30 -0400
Subject: [PATCH] hack to build
---
Crypto/Number/Basic.hs | 14 --------------
Crypto/Number/ModArithmetic.hs | 29 -----------------------------
Crypto/Number/Prime.hs | 18 ------------------
crypto-numbers.cabal | 2 +-
4 files changed, 1 insertion(+), 62 deletions(-)
diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs
index 65c14b3..eaee853 100644
--- a/Crypto/Number/Basic.hs
+++ b/Crypto/Number/Basic.hs
@@ -20,11 +20,7 @@ module Crypto.Number.Basic
, areEven
) where
-#if MIN_VERSION_integer_gmp(0,5,1)
-import GHC.Integer.GMP.Internals
-#else
import Data.Bits
-#endif
-- | sqrti returns two integer (l,b) so that l <= sqrt i <= b
-- the implementation is quite naive, use an approximation for the first number
@@ -63,25 +59,16 @@ sqrti i
-- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d
--
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
-#if MIN_VERSION_integer_gmp(0,5,1)
-gcde a b = (s, t, g)
- where (# g, s #) = gcdExtInteger a b
- t = (g - s * a) `div` b
-#else
gcde a b = if d < 0 then (-x,-y,-d) else (x,y,d) where
(d, x, y) = f (a,1,0) (b,0,1)
f t (0, _, _) = t
f (a', sa, ta) t@(b', sb, tb) =
let (q, r) = a' `divMod` b' in
f t (r, sa - (q * sb), ta - (q * tb))
-#endif
-- | get the extended GCD of two integer using the extended binary algorithm (HAC 14.61)
-- get (x,y,d) where d = gcd(a,b) and x,y satisfying ax + by = d
gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer)
-#if MIN_VERSION_integer_gmp(0,5,1)
-gcde_binary = gcde
-#else
gcde_binary a' b'
| b' == 0 = (1,0,a')
| a' >= b' = compute a' b'
@@ -105,7 +92,6 @@ gcde_binary a' b'
in if u2 >= v2
then loop g x y (u2 - v2) v2 (a2 - c2) (b2 - d2) c2 d2
else loop g x y u2 (v2 - u2) a2 b2 (c2 - a2) (d2 - b2)
-#endif
-- | check if a list of integer are all even
areEven :: [Integer] -> Bool
diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs
index 942c12f..f8cfc32 100644
--- a/Crypto/Number/ModArithmetic.hs
+++ b/Crypto/Number/ModArithmetic.hs
@@ -29,12 +29,8 @@ module Crypto.Number.ModArithmetic
import Control.Exception (throw, Exception)
import Data.Typeable
-#if MIN_VERSION_integer_gmp(0,5,1)
-import GHC.Integer.GMP.Internals
-#else
import Crypto.Number.Basic (gcde_binary)
import Data.Bits
-#endif
-- | Raised when two numbers are supposed to be coprimes but are not.
data CoprimesAssertionError = CoprimesAssertionError
@@ -55,13 +51,7 @@ expSafe :: Integer -- ^ base
-> Integer -- ^ exponant
-> Integer -- ^ modulo
-> Integer -- ^ result
-#if MIN_VERSION_integer_gmp(0,5,1)
-expSafe b e m
- | odd m = powModSecInteger b e m
- | otherwise = powModInteger b e m
-#else
expSafe = exponentiation
-#endif
-- | Compute the modular exponentiation of base^exponant using
-- the fastest algorithm without any consideration for
@@ -74,11 +64,7 @@ expFast :: Integer -- ^ base
-> Integer -- ^ modulo
-> Integer -- ^ result
expFast =
-#if MIN_VERSION_integer_gmp(0,5,1)
- powModInteger
-#else
exponentiation
-#endif
-- note on exponentiation: 0^0 is treated as 1 for mimicking the standard library;
-- the mathematic debate is still open on whether or not this is true, but pratically
@@ -87,22 +73,15 @@ expFast =
-- | exponentiation_rtl_binary computes modular exponentiation as b^e mod m
-- using the right-to-left binary exponentiation algorithm (HAC 14.79)
exponentiation_rtl_binary :: Integer -> Integer -> Integer -> Integer
-#if MIN_VERSION_integer_gmp(0,5,1)
-exponentiation_rtl_binary = expSafe
-#else
exponentiation_rtl_binary 0 0 m = 1 `mod` m
exponentiation_rtl_binary b e m = loop e b 1
where sq x = (x * x) `mod` m
loop !0 _ !a = a `mod` m
loop !i !s !a = loop (i `shiftR` 1) (sq s) (if odd i then a * s else a)
-#endif
-- | exponentiation computes modular exponentiation as b^e mod m
-- using repetitive squaring.
exponentiation :: Integer -> Integer -> Integer -> Integer
-#if MIN_VERSION_integer_gmp(0,5,1)
-exponentiation = expSafe
-#else
exponentiation b e m
| b == 1 = b
| e == 0 = 1
@@ -110,7 +89,6 @@ exponentiation b e m
| even e = let p = (exponentiation b (e `div` 2) m) `mod` m
in (p^(2::Integer)) `mod` m
| otherwise = (b * exponentiation b (e-1) m) `mod` m
-#endif
--{-# DEPRECATED exponantiation_rtl_binary "typo in API name it's called exponentiation_rtl_binary #-}
exponantiation_rtl_binary :: Integer -> Integer -> Integer -> Integer
@@ -122,17 +100,10 @@ exponantiation = exponentiation
-- | inverse computes the modular inverse as in g^(-1) mod m
inverse :: Integer -> Integer -> Maybe Integer
-#if MIN_VERSION_integer_gmp(0,5,1)
-inverse g m
- | r == 0 = Nothing
- | otherwise = Just r
- where r = recipModInteger g m
-#else
inverse g m
| d > 1 = Nothing
| otherwise = Just (x `mod` m)
where (x,_,d) = gcde_binary g m
-#endif
-- | Compute the modular inverse of 2 coprime numbers.
-- This is equivalent to inverse except that the result
diff --git a/Crypto/Number/Prime.hs b/Crypto/Number/Prime.hs
index 0cea9da..458c94d 100644
--- a/Crypto/Number/Prime.hs
+++ b/Crypto/Number/Prime.hs
@@ -3,9 +3,7 @@
#ifndef MIN_VERSION_integer_gmp
#define MIN_VERSION_integer_gmp(a,b,c) 0
#endif
-#if MIN_VERSION_integer_gmp(0,5,1)
{-# LANGUAGE MagicHash #-}
-#endif
-- |
-- Module : Crypto.Number.Prime
-- License : BSD-style
@@ -30,12 +28,7 @@ import Crypto.Number.Generate
import Crypto.Number.Basic (sqrti, gcde_binary)
import Crypto.Number.ModArithmetic (exponantiation)
-#if MIN_VERSION_integer_gmp(0,5,1)
-import GHC.Integer.GMP.Internals
-import GHC.Base
-#else
import Data.Bits
-#endif
-- | returns if the number is probably prime.
-- first a list of small primes are implicitely tested for divisibility,
@@ -78,21 +71,11 @@ findPrimeFromWith rng prop !n
-- | find a prime from a starting point with no specific property.
findPrimeFrom :: CPRG g => g -> Integer -> (Integer, g)
findPrimeFrom rng n =
-#if MIN_VERSION_integer_gmp(0,5,1)
- (nextPrimeInteger n, rng)
-#else
findPrimeFromWith rng (\g _ -> (True, g)) n
-#endif
-- | Miller Rabin algorithm return if the number is probably prime or composite.
-- the tries parameter is the number of recursion, that determines the accuracy of the test.
primalityTestMillerRabin :: CPRG g => g -> Int -> Integer -> (Bool, g)
-#if MIN_VERSION_integer_gmp(0,5,1)
-primalityTestMillerRabin rng (I# tries) !n =
- case testPrimeInteger n tries of
- 0# -> (False, rng)
- _ -> (True, rng)
-#else
primalityTestMillerRabin rng tries !n
| n <= 3 = error "Miller-Rabin requires tested value to be > 3"
| even n = (False, rng)
@@ -129,7 +112,6 @@ primalityTestMillerRabin rng tries !n
| x2 == 1 = False
| x2 /= nm1 = loop' ws ((x2*x2) `mod` n) (r+1)
| otherwise = loop ws
-#endif
{-
n < z -> witness to test
diff --git a/crypto-numbers.cabal b/crypto-numbers.cabal
index 9610e34..6669d78 100644
--- a/crypto-numbers.cabal
+++ b/crypto-numbers.cabal
@@ -15,7 +15,7 @@ Extra-Source-Files: Tests/*.hs
Flag integer-gmp
Description: Are we using integer-gmp?
- Default: True
+ Default: False
Library
Build-Depends: base >= 4 && < 5
--
1.7.10.4

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

@ -1,6 +1,6 @@
From e5072d9b721cc25fa1017df97d71bf926a78d4e5 Mon Sep 17 00:00:00 2001
From 087f1ae5e17f0e6d7c9f6b4092a5bb5bb6f5bf60 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 02:24:19 +0000
Date: Thu, 16 Oct 2014 02:59:11 +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 31f6373..6487c7b 100644
index 5721e03..c4400d1 100644
--- a/Network/DNS/Resolver.hs
+++ b/Network/DNS/Resolver.hs
@@ -18,7 +18,7 @@ module Network.DNS.Resolver (
, fromDNSFormat
@@ -19,7 +19,7 @@ module Network.DNS.Resolver (
) 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)
import Data.Maybe (fromMaybe)
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), defaultHints, getAddrInfo
import Prelude hiding (lookup)
import System.Random (getStdRandom, randomR)
import System.Timeout (timeout)
+import System.Process
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative ((<$>), (<*>), pure)
@@ -136,10 +137,12 @@ makeResolvSeed conf = ResolvSeed <$> addr
#if mingw32_HOST_OS == 1
import Network.Socket (send)
@@ -130,10 +131,12 @@ makeResolvSeed conf = ResolvSeed <$> addr
where
addr = case resolvInfo conf of
RCHostName numhost -> makeAddrInfo numhost Nothing
RCHostPort numhost mport -> makeAddrInfo numhost $ Just mport
- RCFilePath file -> toAddr <$> readFile file >>= \i -> makeAddrInfo i Nothing
RCHostName numhost -> makeAddrInfo numhost
- RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo
- 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])
+ flip makeAddrInfo Nothing $ case ls of
+ makeAddrInfo $ case ls of
+ [] -> "8.8.8.8" -- google public dns as a fallback only
+ (l:_) -> l
makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
makeAddrInfo addr mport = do
makeAddrInfo :: HostName -> IO AddrInfo
makeAddrInfo addr = do
diff --git a/dns.cabal b/dns.cabal
index 0745754..8cf4b67 100644
index ceaf5f4..cd15e61 100644
--- a/dns.cabal
+++ b/dns.cabal
@@ -39,6 +39,7 @@ Library
@@ -37,6 +37,7 @@ Library
, network >= 2.3
, random
, resourcet
@ -59,5 +59,5 @@ index 0745754..8cf4b67 100644
Build-Depends: base >= 4 && < 5
, attoparsec
--
2.1.4
2.1.1

27
standalone/android/haskell-patches/entropy_cross-build.patch
View file

@ -1,27 +0,0 @@
From 8e942c1f661b30e5477607b78528634e6d345ae8 Mon Sep 17 00:00:00 2001
From: androidbuilder <androidbuilder@example.com>
Date: Thu, 2 Jul 2015 21:16:15 +0000
Subject: [PATCH] cross build
---
entropy.cabal | 5 +----
1 file changed, 1 insertion(+), 4 deletions(-)
diff --git a/entropy.cabal b/entropy.cabal
index e4fb436..e26896c 100644
--- a/entropy.cabal
+++ b/entropy.cabal
@@ -14,10 +14,7 @@ category: Data, Cryptography
homepage: https://github.com/TomMD/entropy
bug-reports: https://github.com/TomMD/entropy/issues
stability: stable
--- build-type: Simple
--- ^^ Used for HaLVM
-build-type: Custom
--- ^^ Test for RDRAND support using 'ghc'
+build-type: Simple
cabal-version: >=1.10
tested-with: GHC == 7.8.2
-- data-files:
--
2.1.4

50
standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch Normal file
View file

@ -0,0 +1,50 @@
From afdec6c9e66211a0ac8419fffe191b059d1fd00c Mon Sep 17 00:00:00 2001
From: foo <foo@bar>
Date: Sun, 22 Sep 2013 17:24:33 +0000
Subject: [PATCH] fix build with new base
---
Data/Text/IDN/IDNA.chs | 1 +
Data/Text/IDN/Punycode.chs | 1 +
Data/Text/IDN/StringPrep.chs | 1 +
3 files changed, 3 insertions(+)
diff --git a/Data/Text/IDN/IDNA.chs b/Data/Text/IDN/IDNA.chs
index ed29ee4..dbb4ba5 100644
--- a/Data/Text/IDN/IDNA.chs
+++ b/Data/Text/IDN/IDNA.chs
@@ -31,6 +31,7 @@ import Foreign
import Foreign.C
import Data.Text.IDN.Internal
+import System.IO.Unsafe
#include <idna.h>
#include <idn-free.h>
diff --git a/Data/Text/IDN/Punycode.chs b/Data/Text/IDN/Punycode.chs
index 24b5fa6..4e62555 100644
--- a/Data/Text/IDN/Punycode.chs
+++ b/Data/Text/IDN/Punycode.chs
@@ -32,6 +32,7 @@ import Data.List (unfoldr)
import qualified Data.ByteString as B
import qualified Data.Text as T
+import System.IO.Unsafe
import Foreign
import Foreign.C
diff --git a/Data/Text/IDN/StringPrep.chs b/Data/Text/IDN/StringPrep.chs
index 752dc9e..5e9fd84 100644
--- a/Data/Text/IDN/StringPrep.chs
+++ b/Data/Text/IDN/StringPrep.chs
@@ -39,6 +39,7 @@ import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
+import System.IO.Unsafe
import Foreign
import Foreign.C
--
1.7.10.4

24
standalone/android/haskell-patches/iproute_1.2.11_0001-build-without-IPv6-stuff.patch
View file

@ -1,31 +1,31 @@
From b2b88224426fe6c7c72ebdec2946fd1ddbacbfaf Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 2 Jul 2015 20:42:50 +0000
From 7beec2e707d59f9573aa2dc7c57bd2a62f16b480 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 15 May 2013 19:06:03 -0400
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 306a488..e3f252e 100644
index cffef93..ea486c9 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, toIPv6b, fromIPv6, fromIPv6b, fromHostAddress6, toHostAddress6
+ , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b -- , fromHostAddress6, toHostAddress6
- , IPv6, toIPv6, fromIPv6, fromHostAddress6, toHostAddress6
+ , IPv6, toIPv6, fromIPv6 -- , fromHostAddress6, toHostAddress6
-- ** IP range data
, IPRange (..)
, AddrRange (addr, mask, mlen)
diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs
index 8d4131e..868a572 100644
index faaf0c7..5b556fb 100644
--- a/Data/IP/Addr.hs
+++ b/Data/IP/Addr.hs
@@ -376,6 +376,7 @@ toHostAddress (IP4 addr4)
@@ -312,6 +312,7 @@ toHostAddress (IP4 addr4)
| byteOrder == LittleEndian = fixByteOrder addr4
| otherwise = addr4
@ -33,7 +33,7 @@ index 8d4131e..868a572 100644
-- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.
fromHostAddress6 :: HostAddress6 -> IPv6
fromHostAddress6 = IP6
@@ -384,6 +385,8 @@ fromHostAddress6 = IP6
@@ -320,6 +321,8 @@ fromHostAddress6 = IP6
toHostAddress6 :: IPv6 -> HostAddress6
toHostAddress6 (IP6 addr6) = addr6
@ -43,5 +43,5 @@ index 8d4131e..868a572 100644
fixByteOrder s = d1 .|. d2 .|. d3 .|. d4
where
--
2.1.4
1.7.10.4

50
standalone/android/haskell-patches/network_2.4.1.0_0002-remove-Network.BSD-symbols-not-available-in-bionic.patch
View file

@ -1,17 +1,17 @@
From 508b4701c1610d9772564b97a74b5fa01dab48e2 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 2 Jul 2015 20:12:59 +0000
From 7861b133bb269b50fcf709291449cb0473818902 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 29 Dec 2013 21:29:23 +0000
Subject: [PATCH] remove Network.BSD symbols not available in bionic
---
Network/BSD.hsc | 100 --------------------------------------------------------
1 file changed, 100 deletions(-)
Network/BSD.hsc | 98 -------------------------------------------------------
1 file changed, 98 deletions(-)
diff --git a/Network/BSD.hsc b/Network/BSD.hsc
index b5e9a26..f085f2a 100644
index d6dae85..27910f4 100644
--- a/Network/BSD.hsc
+++ b/Network/BSD.hsc
@@ -27,15 +27,6 @@ module Network.BSD
@@ -30,15 +30,6 @@ module Network.BSD
, getHostByAddr
, hostAddress
@ -27,7 +27,7 @@ index b5e9a26..f085f2a 100644
-- * Service names
, ServiceEntry(..)
, ServiceName
@@ -61,14 +52,6 @@ module Network.BSD
@@ -64,14 +55,6 @@ module Network.BSD
, getProtocolNumber
, defaultProtocol
@ -42,7 +42,7 @@ index b5e9a26..f085f2a 100644
-- * Port numbers
, PortNumber
@@ -80,11 +63,7 @@ module Network.BSD
@@ -83,11 +66,7 @@ module Network.BSD
#if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32)
, getNetworkByName
, getNetworkByAddr
@ -52,9 +52,9 @@ index b5e9a26..f085f2a 100644
- , getNetworkEntry
- , endNetworkEntry
#endif
) where
#if defined(HAVE_IF_NAMETOINDEX)
@@ -298,31 +277,6 @@ getProtocolNumber proto = do
@@ -303,31 +282,6 @@ getProtocolNumber proto = do
(ProtocolEntry _ _ num) <- getProtocolByName proto
return num
@ -62,18 +62,18 @@ index b5e9a26..f085f2a 100644
-getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
-getProtocolEntry = withLock $ do
- ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry"
- $ c_getprotoent
- $ trySysCall c_getprotoent
- peek ent
-
-foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)
-
-setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
-setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg)
-setProtocolEntry flg = withLock $ trySysCall $ c_setprotoent (fromBool flg)
-
-foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO ()
-
-endProtocolEntry :: IO ()
-endProtocolEntry = withLock $ c_endprotoent
-endProtocolEntry = withLock $ trySysCall $ c_endprotoent
-
-foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()
-
@ -86,7 +86,7 @@ index b5e9a26..f085f2a 100644
-- ---------------------------------------------------------------------------
-- Host lookups
@@ -397,31 +351,6 @@ getHostByAddr family addr = do
@@ -402,31 +356,6 @@ getHostByAddr family addr = do
foreign import CALLCONV safe "gethostbyaddr"
c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
@ -94,13 +94,13 @@ index b5e9a26..f085f2a 100644
-getHostEntry :: IO HostEntry
-getHostEntry = withLock $ do
- throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry"
- $ c_gethostent
- $ trySysCall $ c_gethostent
- >>= peek
-
-foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)
-
-setHostEntry :: Bool -> IO ()
-setHostEntry flg = withLock $ c_sethostent (fromBool flg)
-setHostEntry flg = withLock $ trySysCall $ c_sethostent (fromBool flg)
-
-foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO ()
-
@ -118,14 +118,14 @@ index b5e9a26..f085f2a 100644
-- ---------------------------------------------------------------------------
-- Accessing network information
@@ -483,35 +412,6 @@ getNetworkByAddr addr family = withLock $ do
@@ -488,33 +417,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"
- $ c_getnetent
- $ trySysCall $ c_getnetent
- >>= peek
-
-foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)
@ -134,13 +134,13 @@ index b5e9a26..f085f2a 100644
--- whether a connection is maintained open between various
--- networkEntry calls
-setNetworkEntry :: Bool -> IO ()
-setNetworkEntry flg = withLock $ c_setnetent (fromBool flg)
-setNetworkEntry flg = withLock $ trySysCall $ 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 $ c_endnetent
-endNetworkEntry = withLock $ trySysCall $ c_endnetent
-
-foreign import ccall unsafe "endnetent" c_endnetent :: IO ()
-
@ -149,11 +149,9 @@ index b5e9a26..f085f2a 100644
-getNetworkEntries stayOpen = do
- setNetworkEntry stayOpen
- getEntries (getNetworkEntry) (endNetworkEntry)
-#endif
-
-- ---------------------------------------------------------------------------
-- Interface names
#endif
-- Mutex for name service lockdown
--
2.1.4
1.7.10.4

16
standalone/android/haskell-patches/network_2.4.1.0_0003-configure-misdetects-accept4.patch
View file

@ -1,6 +1,6 @@
From 21af25e922b00171c07f951a235ff7d7edbbd2be Mon Sep 17 00:00:00 2001
From 478fc7ae42030c1345e75727e54e1f8f895d3e22 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 2 Jul 2015 20:14:40 +0000
Date: Wed, 15 Oct 2014 15:16:21 +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 6553bfc..802a7e9 100644
index 2fe62ee..94db7a4 100644
--- a/Network/Socket.hsc
+++ b/Network/Socket.hsc
@@ -489,7 +489,7 @@ accept sock@(MkSocket s family stype protocol status) = do
return new_sock
@@ -511,7 +511,7 @@ accept sock@(MkSocket s family stype protocol status) = do
#else
with (fromIntegral sz) $ \ ptr_len -> do
new_sock <-
-# ifdef HAVE_ACCEPT4
+#if 0
new_sock <- throwSocketErrorIfMinus1RetryMayBlock "accept"
throwSocketErrorIfMinus1RetryMayBlock "accept"
(threadWaitRead (fromIntegral s))
(c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK))
@@ -1565,7 +1565,7 @@ foreign import CALLCONV SAFE_ON_WIN "connect"
@@ -1602,7 +1602,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 6553bfc..802a7e9 100644
c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt
#endif
--
2.1.4
2.1.1

24
standalone/android/haskell-patches/network_2.4.1.0_0006-build-fixes.patch
View file

@ -1,24 +0,0 @@
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

153
standalone/android/haskell-patches/shakespeare-text_remove-TH.patch Normal file
View file

@ -0,0 +1,153 @@
From dca2a30ca06865bf66cd25cc14b06f5d28190231 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 16 Oct 2014 02:46:57 +0000
Subject: [PATCH] remove TH
---
Text/Shakespeare/Text.hs | 125 +++++------------------------------------------
1 file changed, 11 insertions(+), 114 deletions(-)
diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs
index 6865a5a..e25a8be 100644
--- a/Text/Shakespeare/Text.hs
+++ b/Text/Shakespeare/Text.hs
@@ -7,18 +7,18 @@ module Text.Shakespeare.Text
( TextUrl
, ToText (..)
, renderTextUrl
- , stext
- , text
- , textFile
- , textFileDebug
- , textFileReload
- , st -- | strict text
- , lt -- | lazy text, same as stext :)
+ --, stext
+ --, text
+ --, textFile
+ --, textFileDebug
+ --, textFileReload
+ --, st -- | strict text
+ --, lt -- | lazy text, same as stext :)
-- * Yesod code generation
- , codegen
- , codegenSt
- , codegenFile
- , codegenFileReload
+ --, codegen
+ --, codegenSt
+ --, codegenFile
+ --, codegenFileReload
) where
import Language.Haskell.TH.Quote (QuasiQuoter (..))
@@ -45,106 +45,3 @@ instance ToText Int32 where toText = toText . show
instance ToText Int64 where toText = toText . show
instance ToText Int where toText = toText . show
-settings :: Q ShakespeareSettings
-settings = do
- toTExp <- [|toText|]
- wrapExp <- [|id|]
- unWrapExp <- [|id|]
- return $ defaultShakespeareSettings { toBuilder = toTExp
- , wrap = wrapExp
- , unwrap = unWrapExp
- }
-
-
-stext, lt, st, text :: 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
- }
-
-
-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
-codegenSettings = do
- toTExp <- [|toText|]
- wrapExp <- [|id|]
- unWrapExp <- [|id|]
- return $ defaultShakespeareSettings { toBuilder = toTExp
- , wrap = wrapExp
- , unwrap = unWrapExp
- , varChar = '~'
- , urlChar = '*'
- , intChar = '&'
- , 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)
--
2.1.1

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

@ -1,6 +1,6 @@
From da127aa3b2c6cbf679950eb593eb8c88384cc26b Mon Sep 17 00:00:00 2001
From db9eb179885874af342bb2c3adef7185496ba1f1 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 2 Jul 2015 20:34:05 +0000
Date: Wed, 15 Oct 2014 16:37:32 +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 6253b27..fb5b3fa 100644
index d30f39b..ec7ca4c 100644
--- a/Data/UnixTime/Types.hsc
+++ b/Data/UnixTime/Types.hsc
@@ -12,8 +12,6 @@ import Data.Binary
@@ -9,8 +9,6 @@ import Foreign.Storable
#include <sys/time.h>
@ -20,8 +20,8 @@ index 6253b27..fb5b3fa 100644
-
-- |
-- Data structure for Unix time.
--
@@ -33,16 +31,6 @@ data UnixTime = UnixTime {
data UnixTime = UnixTime {
@@ -20,16 +18,6 @@ data UnixTime = UnixTime {
, utMicroSeconds :: {-# UNPACK #-} !Int32
} deriving (Eq,Ord,Show)
@ -35,14 +35,14 @@ index 6253b27..fb5b3fa 100644
- (#poke struct timeval, tv_sec) ptr (utSeconds ut)
- (#poke struct timeval, tv_usec) ptr (utMicroSeconds ut)
-
#if __GLASGOW_HASKELL__ >= 704
instance Binary UnixTime where
put (UnixTime (CTime sec) msec) = do
-- |
-- Format of the strptime()/strftime() style.
type Format = ByteString
diff --git a/cbits/conv.c b/cbits/conv.c
index 669cfda..8fa5f9a 100644
index ec31fef..b7bc0f9 100644
--- a/cbits/conv.c
+++ b/cbits/conv.c
@@ -98,7 +98,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
@@ -96,7 +96,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
#else
strptime(src, fmt, &dst);
#endif
@ -52,5 +52,5 @@ index 669cfda..8fa5f9a 100644
size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
--
2.1.4
2.1.1

59
standalone/android/haskell-patches/uuid_build-without-v1-uuid-which-needs-network-info.patch
View file

@ -1,15 +1,16 @@
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
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
---
Data/UUID/Util.hs | 11 -----------
uuid.cabal | 2 --
2 files changed, 13 deletions(-)
Data/UUID/Util.hs | 11 -----------
Data/UUID/V1.hs | 2 --
uuid.cabal | 2 --
3 files changed, 15 deletions(-)
diff --git a/Data/UUID/Util.hs b/Data/UUID/Util.hs
index 8817f51..0d43b01 100644
index 581391a..399e508 100644
--- a/Data/UUID/Util.hs
+++ b/Data/UUID/Util.hs
@@ -3,7 +3,6 @@ module Data.UUID.Util (
@ -23,37 +24,49 @@ index 8817f51..0d43b01 100644
@@ -13,7 +12,6 @@ import Data.Word
import Data.Word.Util
import Data.Bits
import Data.UUID.Types.Internal
import Data.UUID.Internal
-import Network.Info
import Data.Int (Int64)
version :: UUID -> Int
@@ -42,12 +40,3 @@ extractTime uuid =
@@ -43,12 +41,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 2fa548b..9d86fd2 100644
index 0a53059..57b1b86 100644
--- a/uuid.cabal
+++ b/uuid.cabal
@@ -30,7 +30,6 @@ Library
binary >= 0.4 && < 0.8,
bytestring >= 0.9 && < 0.11,
@@ -32,14 +32,12 @@ Library
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.2,
time >= 1.1 && < 1.6,
uuid-types >= 1.0 && < 2
@@ -38,7 +37,6 @@ Library
random >= 1.0.1 && < 1.1,
time >= 1.1 && < 1.5
Exposed-Modules:
Data.UUID
Data.UUID.Util
@ -62,5 +75,5 @@ index 2fa548b..9d86fd2 100644
Data.UUID.V4
Data.UUID.V5
--
2.1.4
1.7.10.4

24
standalone/android/haskell-patches/vector_cross-build.patch
View file

@ -1,24 +0,0 @@
From 6ffd4fcb7d27ec6df709d80a40a262406446a259 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Wed, 15 Oct 2014 17:00:56 +0000
Subject: [PATCH] cross build
---
Data/Vector/Fusion/Stream/Monadic.hs | 1 -
2 files changed, 14 deletions(-)
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
index 51fec75..b089b3d 100644
--- a/Data/Vector/Fusion/Stream/Monadic.hs
+++ b/Data/Vector/Fusion/Stream/Monadic.hs
@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )
data SPEC = SPEC | SPEC2
#if __GLASGOW_HASKELL__ >= 700
-{-# ANN type SPEC ForceSpecConstr #-}
#endif
emptyStream :: String
--
2.1.1

39
standalone/android/haskell-patches/warp_avoid-ipv6-for-android.patch
View file

@ -1,39 +0,0 @@
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

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

@ -8,6 +8,10 @@
# versions that have been gotten working. To update, delete the
# cabal.config, run this script with an empty cabal and fix up the broken
# patches, and then use cabal freeze to generate a new cabal.config.
#
# This only installs haskell packages for ghc-android. The host ghc
# also needs to have all the git-annex build deps installed, in similar
# versions. Those are installed from Debian packages using apt.
set -e
@ -86,9 +90,10 @@ EOF
patched iproute
patched primitive
patched socks
patched entropy
# patched entropy # needed for newer version, not current pinned version
patched vector
patched stm-chans
patched persistent
patched profunctors
patched skein
patched lens
@ -97,14 +102,19 @@ EOF
patched persistent-template
patched system-filepath
patched optparse-applicative
patched warp
patched wai-app-static
patched shakespeare
patched shakespeare-css
patched shakespeare-js
patched yesod-routes
patched yesod-core
patched yesod-persistent
patched yesod-form
patched crypto-numbers
patched clock
patched yesod-auth
patched yesod
patched shakespeare-text
patched process-conduit
patched DAV
patched yesod-static
@ -112,6 +122,7 @@ EOF
patched dns
patched gnutls
patched unbounded-delays
patched gnuidn
patched network-protocol-xmpp
cd ..
@ -119,13 +130,11 @@ EOF
installgitannexdeps -fAndroid -f-Pairing
}
setupcabal
# Install packages for host ghc.
# native cabal needs its own update
cabal update
installgitannexdeps
# Install packages for cross ghc, with patches as necessary.
PATH=$HOME/.ghc/$(cat abiversion)/bin:$HOME/.ghc/$(cat abiversion)/arm-linux-androideabi/bin:$PATH
setupcabal
cabal update
install_pkgs

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

@ -1,6 +1,6 @@
From 6d4a7c63d737c9215ee55996715250c89f14c398 Mon Sep 17 00:00:00 2001
From e54cfacbb9fb24f75d3d93cd8ee6da67b161574f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 01:36:31 +0000
Date: Thu, 16 Oct 2014 02:51:28 +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 f78c2e5..1ec4d80 100644
index 95fffd8..5669c51 100644
--- a/DAV.cabal
+++ b/DAV.cabal
@@ -47,33 +47,7 @@ library
@ -27,7 +27,7 @@ index f78c2e5..1ec4d80 100644
- , containers
- , data-default
- , either >= 4.3
- , errors < 2.0
- , errors
- , exceptions
- , http-client >= 0.2
- , http-client-tls >= 0.2
@ -49,7 +49,7 @@ index f78c2e5..1ec4d80 100644
source-repository head
type: git
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
index 5d5d6fd..7265d42 100644
index 4c6d68f..55979b6 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.4
2.1.1

40
standalone/no-th/haskell-patches/aeson_remove-TH.patch Normal file
View file

@ -0,0 +1,40 @@
From f147ec9aeaa03ca6e30232c84c413ef29b95fb62 Mon Sep 17 00:00:00 2001
From: Your Name <you@example.com>
Date: Tue, 20 May 2014 19:53:55 +0000
Subject: [PATCH] avoid TH
---
aeson.cabal | 3 ---
1 file changed, 3 deletions(-)
diff --git a/aeson.cabal b/aeson.cabal
index 493d625..02dc6f4 100644
--- a/aeson.cabal
+++ b/aeson.cabal
@@ -88,7 +88,6 @@ library
Data.Aeson.Generic
Data.Aeson.Parser
Data.Aeson.Types
- Data.Aeson.TH
other-modules:
Data.Aeson.Functions
@@ -121,7 +120,6 @@ library
old-locale,
scientific >= 0.3.1 && < 0.4,
syb,
- template-haskell >= 2.4,
time,
unordered-containers >= 0.2.3.0,
vector >= 0.7.1
@@ -164,7 +162,6 @@ test-suite tests
base,
containers,
bytestring,
- template-haskell,
test-framework,
test-framework-quickcheck2,
test-framework-hunit,
--
2.0.0.rc2

132
standalone/no-th/haskell-patches/file-embed_remove-TH.patch Normal file
View file

@ -0,0 +1,132 @@
From 497d09a91f9eb1e5979948cd128078491b0e8bca Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 12 Sep 2014 20:52:08 -0400
Subject: [PATCH] remove TH
---
Data/FileEmbed.hs | 87 ++++---------------------------------------------------
1 file changed, 5 insertions(+), 82 deletions(-)
diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
index 5617493..adacdba 100644
--- a/Data/FileEmbed.hs
+++ b/Data/FileEmbed.hs
@@ -17,13 +17,13 @@
-- > {-# LANGUAGE TemplateHaskell #-}
module Data.FileEmbed
( -- * Embed at compile time
- embedFile
- , embedOneFileOf
- , embedDir
- , getDir
+ -- embedFile
+ --, embedOneFileOf
+ --, embedDir
+ getDir
-- * Inject into an executable
#if MIN_VERSION_template_haskell(2,5,0)
- , dummySpace
+ --, dummySpace
#endif
, inject
, injectFile
@@ -56,73 +56,12 @@ import Data.ByteString.Unsafe (unsafePackAddressLen)
import System.IO.Unsafe (unsafePerformIO)
import System.FilePath ((</>))
--- | Embed a single file in your source code.
---
--- > import qualified Data.ByteString
--- >
--- > myFile :: Data.ByteString.ByteString
--- > myFile = $(embedFile "dirName/fileName")
-embedFile :: FilePath -> Q Exp
-embedFile fp =
-#if MIN_VERSION_template_haskell(2,7,0)
- qAddDependentFile fp >>
-#endif
- (runIO $ B.readFile fp) >>= bsToExp
-
--- | Embed a single existing file in your source code
--- out of list a list of paths supplied.
---
--- > import qualified Data.ByteString
--- >
--- > myFile :: Data.ByteString.ByteString
--- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
-embedOneFileOf :: [FilePath] -> Q Exp
-embedOneFileOf ps =
- (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
-#if MIN_VERSION_template_haskell(2,7,0)
- qAddDependentFile path
-#endif
- bsToExp content
- where
- readExistingFile :: [FilePath] -> IO ( FilePath, B.ByteString )
- readExistingFile xs = do
- ys <- filterM doesFileExist xs
- case ys of
- (p:_) -> B.readFile p >>= \ c -> return ( p, c )
- _ -> throw $ ErrorCall "Cannot find file to embed as resource"
-
--- | Embed a directory recursively in your source code.
---
--- > import qualified Data.ByteString
--- >
--- > myDir :: [(FilePath, Data.ByteString.ByteString)]
--- > myDir = $(embedDir "dirName")
-embedDir :: FilePath -> Q Exp
-embedDir fp = do
- typ <- [t| [(FilePath, B.ByteString)] |]
- e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
- return $ SigE e typ
-
-- | Get a directory tree in the IO monad.
--
-- This is the workhorse of 'embedDir'
getDir :: FilePath -> IO [(FilePath, B.ByteString)]
getDir = fileList
-pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
-pairToExp _root (path, bs) = do
-#if MIN_VERSION_template_haskell(2,7,0)
- qAddDependentFile $ _root ++ '/' : path
-#endif
- exp' <- bsToExp bs
- return $! TupE [LitE $ StringL path, exp']
-
-bsToExp :: B.ByteString -> Q Exp
-bsToExp bs = do
- helper <- [| stringToBs |]
- let chars = B8.unpack bs
- return $! AppE helper $! LitE $! StringL chars
-
stringToBs :: String -> B.ByteString
stringToBs = B8.pack
@@ -164,22 +103,6 @@ padSize i =
let s = show i
in replicate (sizeLen - length s) '0' ++ s
-#if MIN_VERSION_template_haskell(2,5,0)
-dummySpace :: Int -> Q Exp
-dummySpace space = do
- let size = padSize space
- let start = magic ++ size
- let chars = LitE $ StringPrimL $
-#if MIN_VERSION_template_haskell(2,6,0)
- map (toEnum . fromEnum) $
-#endif
- start ++ replicate space '0'
- let len = LitE $ IntegerL $ fromIntegral $ length start + space
- upi <- [|unsafePerformIO|]
- pack <- [|unsafePackAddressLen|]
- getInner' <- [|getInner|]
- return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
-#endif
inject :: B.ByteString -- ^ bs to inject
-> B.ByteString -- ^ original BS containing dummy
--
2.1.0

394
standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch Normal file
View file

@ -0,0 +1,394 @@
From 9a41401d903f160e11d56fff35c24eb59d97885d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 17 Dec 2013 19:04:40 +0000
Subject: [PATCH] remove TH
---
src/Generics/Deriving/TH.hs | 354 --------------------------------------------
1 file changed, 354 deletions(-)
diff --git a/src/Generics/Deriving/TH.hs b/src/Generics/Deriving/TH.hs
index 783cb65..9aab713 100644
--- a/src/Generics/Deriving/TH.hs
+++ b/src/Generics/Deriving/TH.hs
@@ -19,18 +19,6 @@
-- Adapted from Generics.Regular.TH
module Generics.Deriving.TH (
-
- deriveMeta
- , deriveData
- , deriveConstructors
- , deriveSelectors
-
-#if __GLASGOW_HASKELL__ < 701
- , deriveAll
- , deriveRepresentable0
- , deriveRep0
- , simplInstance
-#endif
) where
import Generics.Deriving.Base
@@ -41,124 +29,6 @@ import Language.Haskell.TH.Syntax (Lift(..))
import Data.List (intercalate)
import Control.Monad
--- | Given the names of a generic class, a type to instantiate, a function in
--- the class and the default implementation, generates the code for a basic
--- generic instance.
-simplInstance :: Name -> Name -> Name -> Name -> Q [Dec]
-simplInstance cl ty fn df = do
- i <- reify (genRepName 0 ty)
- x <- newName "x"
- let typ = ForallT [PlainTV x] []
- ((foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT (genRepName 0 ty))
- (typeVariables i)) `AppT` (VarT x))
- fmap (: []) $ instanceD (cxt []) (conT cl `appT` conT ty)
- [funD fn [clause [] (normalB (varE df `appE`
- (sigE (global 'undefined) (return typ)))) []]]
-
-
--- | Given the type and the name (as string) for the type to derive,
--- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
--- instances, and the 'Representable0' instance.
-deriveAll :: Name -> Q [Dec]
-deriveAll n =
- do a <- deriveMeta n
- b <- deriveRepresentable0 n
- return (a ++ b)
-
--- | Given the type and the name (as string) for the type to derive,
--- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'
--- instances.
-deriveMeta :: Name -> Q [Dec]
-deriveMeta n =
- do a <- deriveData n
- b <- deriveConstructors n
- c <- deriveSelectors n
- return (a ++ b ++ c)
-
--- | Given a datatype name, derive a datatype and instance of class 'Datatype'.
-deriveData :: Name -> Q [Dec]
-deriveData = dataInstance
-
--- | Given a datatype name, derive datatypes and
--- instances of class 'Constructor'.
-deriveConstructors :: Name -> Q [Dec]
-deriveConstructors = constrInstance
-
--- | Given a datatype name, derive datatypes and instances of class 'Selector'.
-deriveSelectors :: Name -> Q [Dec]
-deriveSelectors = selectInstance
-
--- | Given the type and the name (as string) for the Representable0 type
--- synonym to derive, generate the 'Representable0' instance.
-deriveRepresentable0 :: Name -> Q [Dec]
-deriveRepresentable0 n = do
- rep0 <- deriveRep0 n
- inst <- deriveInst n
- return $ rep0 ++ inst
-
--- | Derive only the 'Rep0' type synonym. Not needed if 'deriveRepresentable0'
--- is used.
-deriveRep0 :: Name -> Q [Dec]
-deriveRep0 n = do
- i <- reify n
- fmap (:[]) $ tySynD (genRepName 0 n) (typeVariables i) (rep0Type n)
-
-deriveInst :: Name -> Q [Dec]
-deriveInst t = do
- i <- reify t
- let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q)
- (typeVariables i)
-#if __GLASGOW_HASKELL__ >= 707
- let tyIns = TySynInstD ''Rep (TySynEqn [typ t] (typ (genRepName 0 t)))
-#else
- let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))
-#endif
- fcs <- mkFrom t 1 0 t
- tcs <- mkTo t 1 0 t
- liftM (:[]) $
- instanceD (cxt []) (conT ''Generic `appT` return (typ t))
- [return tyIns, funD 'from fcs, funD 'to tcs]
-
-
-dataInstance :: Name -> Q [Dec]
-dataInstance n = do
- i <- reify n
- case i of
- TyConI (DataD _ n _ _ _) -> mkInstance n
- TyConI (NewtypeD _ n _ _ _) -> mkInstance n
- _ -> return []
- where
- mkInstance n = do
- ds <- mkDataData n
- is <- mkDataInstance n
- return $ [ds,is]
-
-constrInstance :: Name -> Q [Dec]
-constrInstance n = do
- i <- reify n
- case i of
- TyConI (DataD _ n _ cs _) -> mkInstance n cs
- TyConI (NewtypeD _ n _ c _) -> mkInstance n [c]
- _ -> return []
- where
- mkInstance n cs = do
- ds <- mapM (mkConstrData n) cs
- is <- mapM (mkConstrInstance n) cs
- return $ ds ++ is
-
-selectInstance :: Name -> Q [Dec]
-selectInstance n = do
- i <- reify n
- case i of
- TyConI (DataD _ n _ cs _) -> mkInstance n cs
- TyConI (NewtypeD _ n _ c _) -> mkInstance n [c]
- _ -> return []
- where
- mkInstance n cs = do
- ds <- mapM (mkSelectData n) cs
- is <- mapM (mkSelectInstance n) cs
- return $ concat (ds ++ is)
-
typeVariables :: Info -> [TyVarBndr]
typeVariables (TyConI (DataD _ _ tv _ _)) = tv
typeVariables (TyConI (NewtypeD _ _ tv _ _)) = tv
@@ -179,233 +49,9 @@ genName = mkName . (++"_") . intercalate "_" . map nameBase
genRepName :: Int -> Name -> Name
genRepName n = mkName . (++"_") . (("Rep" ++ show n) ++) . nameBase
-mkDataData :: Name -> Q Dec
-mkDataData n = dataD (cxt []) (genName [n]) [] [] []
-
-mkConstrData :: Name -> Con -> Q Dec
-mkConstrData dt (NormalC n _) =
- dataD (cxt []) (genName [dt, n]) [] [] []
-mkConstrData dt r@(RecC _ _) =
- mkConstrData dt (stripRecordNames r)
-mkConstrData dt (InfixC t1 n t2) =
- mkConstrData dt (NormalC n [t1,t2])
-
-mkSelectData :: Name -> Con -> Q [Dec]
-mkSelectData dt r@(RecC n fs) = return (map one fs)
- where one (f, _, _) = DataD [] (genName [dt, n, f]) [] [] []
-mkSelectData dt _ = return []
-
-
-mkDataInstance :: Name -> Q Dec
-mkDataInstance n =
- instanceD (cxt []) (appT (conT ''Datatype) (conT $ genName [n]))
- [funD 'datatypeName [clause [wildP] (normalB (stringE (nameBase n))) []]
- ,funD 'moduleName [clause [wildP] (normalB (stringE name)) []]]
- where
- name = maybe (error "Cannot fetch module name!") id (nameModule n)
-
-instance Lift Fixity where
- lift Prefix = conE 'Prefix
- lift (Infix a n) = conE 'Infix `appE` [| a |] `appE` [| n |]
-
-instance Lift Associativity where
- lift LeftAssociative = conE 'LeftAssociative
- lift RightAssociative = conE 'RightAssociative
- lift NotAssociative = conE 'NotAssociative
-
-mkConstrInstance :: Name -> Con -> Q Dec
-mkConstrInstance dt (NormalC n _) = mkConstrInstanceWith dt n []
-mkConstrInstance dt (RecC n _) = mkConstrInstanceWith dt n
- [ funD 'conIsRecord [clause [wildP] (normalB (conE 'True)) []]]
-mkConstrInstance dt (InfixC t1 n t2) =
- do
- i <- reify n
- let fi = case i of
- DataConI _ _ _ f -> convertFixity f
- _ -> Prefix
- instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
- [funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []],
- funD 'conFixity [clause [wildP] (normalB [| fi |]) []]]
- where
- convertFixity (Fixity n d) = Infix (convertDirection d) n
- convertDirection InfixL = LeftAssociative
- convertDirection InfixR = RightAssociative
- convertDirection InfixN = NotAssociative
-
-mkConstrInstanceWith :: Name -> Name -> [Q Dec] -> Q Dec
-mkConstrInstanceWith dt n extra =
- instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
- (funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)
-
-mkSelectInstance :: Name -> Con -> Q [Dec]
-mkSelectInstance dt r@(RecC n fs) = return (map one fs) where
- one (f, _, _) =
- InstanceD ([]) (AppT (ConT ''Selector) (ConT $ genName [dt, n, f]))
- [FunD 'selName [Clause [WildP]
- (NormalB (LitE (StringL (nameBase f)))) []]]
-mkSelectInstance _ _ = return []
-
-rep0Type :: Name -> Q Type
-rep0Type n =
- do
- -- runIO $ putStrLn $ "processing " ++ show n
- i <- reify n
- let b = case i of
- TyConI (DataD _ dt vs cs _) ->
- (conT ''D1) `appT` (conT $ genName [dt]) `appT`
- (foldr1' sum (conT ''V1)
- (map (rep0Con (dt, map tyVarBndrToName vs)) cs))
- TyConI (NewtypeD _ dt vs c _) ->
- (conT ''D1) `appT` (conT $ genName [dt]) `appT`
- (rep0Con (dt, map tyVarBndrToName vs) c)
- TyConI (TySynD t _ _) -> error "type synonym?"
- _ -> error "unknown construct"
- --appT b (conT $ mkName (nameBase n))
- b where
- sum :: Q Type -> Q Type -> Q Type
- sum a b = conT ''(:+:) `appT` a `appT` b
-
-
-rep0Con :: (Name, [Name]) -> Con -> Q Type
-rep0Con (dt, vs) (NormalC n []) =
- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
- (conT ''S1 `appT` conT ''NoSelector `appT` conT ''U1)
-rep0Con (dt, vs) (NormalC n fs) =
- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
- (foldr1 prod (map (repField (dt, vs) . snd) fs)) where
- prod :: Q Type -> Q Type -> Q Type
- prod a b = conT ''(:*:) `appT` a `appT` b
-rep0Con (dt, vs) r@(RecC n []) =
- conT ''C1 `appT` (conT $ genName [dt, n]) `appT` conT ''U1
-rep0Con (dt, vs) r@(RecC n fs) =
- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
- (foldr1 prod (map (repField' (dt, vs) n) fs)) where
- prod :: Q Type -> Q Type -> Q Type
- prod a b = conT ''(:*:) `appT` a `appT` b
-
-rep0Con d (InfixC t1 n t2) = rep0Con d (NormalC n [t1,t2])
-
---dataDeclToType :: (Name, [Name]) -> Type
---dataDeclToType (dt, vs) = foldl (\a b -> AppT a (VarT b)) (ConT dt) vs
-
-repField :: (Name, [Name]) -> Type -> Q Type
---repField d t | t == dataDeclToType d = conT ''I
-repField d t = conT ''S1 `appT` conT ''NoSelector `appT`
- (conT ''Rec0 `appT` return t)
-
-repField' :: (Name, [Name]) -> Name -> (Name, Strict, Type) -> Q Type
---repField' d ns (_, _, t) | t == dataDeclToType d = conT ''I
-repField' (dt, vs) ns (f, _, t) = conT ''S1 `appT` conT (genName [dt, ns, f])
- `appT` (conT ''Rec0 `appT` return t)
--- Note: we should generate Par0 too, at some point
-
-
-mkFrom :: Name -> Int -> Int -> Name -> Q [Q Clause]
-mkFrom ns m i n =
- do
- -- runIO $ putStrLn $ "processing " ++ show n
- let wrapE e = lrE m i e
- i <- reify n
- let b = case i of
- TyConI (DataD _ dt vs cs _) ->
- zipWith (fromCon wrapE ns (dt, map tyVarBndrToName vs)
- (length cs)) [0..] cs
- TyConI (NewtypeD _ dt vs c _) ->
- [fromCon wrapE ns (dt, map tyVarBndrToName vs) 1 0 c]
- TyConI (TySynD t _ _) -> error "type synonym?"
- -- [clause [varP (field 0)] (normalB (wrapE $ conE 'K1 `appE` varE (field 0))) []]
- _ -> error "unknown construct"
- return b
-
-mkTo :: Name -> Int -> Int -> Name -> Q [Q Clause]
-mkTo ns m i n =
- do
- -- runIO $ putStrLn $ "processing " ++ show n
- let wrapP p = lrP m i p
- i <- reify n
- let b = case i of
- TyConI (DataD _ dt vs cs _) ->
- zipWith (toCon wrapP ns (dt, map tyVarBndrToName vs)
- (length cs)) [0..] cs
- TyConI (NewtypeD _ dt vs c _) ->
- [toCon wrapP ns (dt, map tyVarBndrToName vs) 1 0 c]
- TyConI (TySynD t _ _) -> error "type synonym?"
- -- [clause [wrapP $ conP 'K1 [varP (field 0)]] (normalB $ varE (field 0)) []]
- _ -> error "unknown construct"
- return b
-
-fromCon :: (Q Exp -> Q Exp) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
-fromCon wrap ns (dt, vs) m i (NormalC cn []) =
- clause
- [conP cn []]
- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ appE (conE 'M1) $
- conE 'M1 `appE` (conE 'U1)) []
-fromCon wrap ns (dt, vs) m i (NormalC cn fs) =
- -- runIO (putStrLn ("constructor " ++ show ix)) >>
- clause
- [conP cn (map (varP . field) [0..length fs - 1])]
- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE`
- foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map snd fs))) []
- where prod x y = conE '(:*:) `appE` x `appE` y
-fromCon wrap ns (dt, vs) m i r@(RecC cn []) =
- clause
- [conP cn []]
- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` (conE 'U1)) []
-fromCon wrap ns (dt, vs) m i r@(RecC cn fs) =
- clause
- [conP cn (map (varP . field) [0..length fs - 1])]
- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE`
- foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map trd fs))) []
- where prod x y = conE '(:*:) `appE` x `appE` y
-fromCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
- fromCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
-
-fromField :: (Name, [Name]) -> Int -> Type -> Q Exp
---fromField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conE 'I `appE` varE (field nr)
-fromField (dt, vs) nr t = conE 'M1 `appE` (conE 'K1 `appE` varE (field nr))
-
-toCon :: (Q Pat -> Q Pat) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
-toCon wrap ns (dt, vs) m i (NormalC cn []) =
- clause
- [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'M1 [conP 'U1 []]]]]
- (normalB $ conE cn) []
-toCon wrap ns (dt, vs) m i (NormalC cn fs) =
- -- runIO (putStrLn ("constructor " ++ show ix)) >>
- clause
- [wrap $ conP 'M1 [lrP m i $ conP 'M1
- [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map snd fs))]]]
- (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
- where prod x y = conP '(:*:) [x,y]
-toCon wrap ns (dt, vs) m i r@(RecC cn []) =
- clause
- [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'U1 []]]]
- (normalB $ conE cn) []
-toCon wrap ns (dt, vs) m i r@(RecC cn fs) =
- clause
- [wrap $ conP 'M1 [lrP m i $ conP 'M1
- [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map trd fs))]]]
- (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
- where prod x y = conP '(:*:) [x,y]
-toCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
- toCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
-
-toField :: (Name, [Name]) -> Int -> Type -> Q Pat
---toField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conP 'I [varP (field nr)]
-toField (dt, vs) nr t = conP 'M1 [conP 'K1 [varP (field nr)]]
-
-
field :: Int -> Name
field n = mkName $ "f" ++ show n
-lrP :: Int -> Int -> (Q Pat -> Q Pat)
-lrP 1 0 p = p
-lrP m 0 p = conP 'L1 [p]
-lrP m i p = conP 'R1 [lrP (m-1) (i-1) p]
-
-lrE :: Int -> Int -> (Q Exp -> Q Exp)
-lrE 1 0 e = e
-lrE m 0 e = conE 'L1 `appE` e
-lrE m i e = conE 'R1 `appE` lrE (m-1) (i-1) e
trd (_,_,c) = c
--
1.8.5.1

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

@ -1,20 +1,20 @@
From 88ff2174944daf90530a33ee06e2e3f667089b6a Mon Sep 17 00:00:00 2001
From 10c9ade98b3ac2054947f411d77db2eb28896b9f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 02:06:43 +0000
Subject: [PATCH] remove TH
Date: Thu, 16 Oct 2014 01:43:10 +0000
Subject: [PATCH] avoid TH
---
lens.cabal | 16 +---------------
src/Control/Lens.hs | 6 ++----
lens.cabal | 17 +----------------
src/Control/Lens.hs | 8 ++------
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(+), 27 deletions(-)
7 files changed, 4 insertions(+), 30 deletions(-)
diff --git a/lens.cabal b/lens.cabal
index c7f6009..ab206c5 100644
index 5388301..d7b02b9 100644
--- a/lens.cabal
+++ b/lens.cabal
@@ -10,7 +10,7 @@ stability: provisional
@ -26,7 +26,15 @@ index c7f6009..ab206c5 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
@@ -230,8 +230,6 @@ library
@@ -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
Control.Lens.Internal.Context
Control.Lens.Internal.Deque
Control.Lens.Internal.Exception
@ -35,7 +43,7 @@ index c7f6009..ab206c5 100644
Control.Lens.Internal.Fold
Control.Lens.Internal.Getter
Control.Lens.Internal.Indexed
@@ -243,25 +241,21 @@ library
@@ -247,25 +244,21 @@ library
Control.Lens.Internal.Reflection
Control.Lens.Internal.Review
Control.Lens.Internal.Setter
@ -61,7 +69,7 @@ index c7f6009..ab206c5 100644
Control.Monad.Primitive.Lens
Control.Parallel.Strategies.Lens
Control.Seq.Lens
@@ -287,12 +281,8 @@ library
@@ -291,12 +284,8 @@ library
Data.Typeable.Lens
Data.Vector.Lens
Data.Vector.Generic.Lens
@ -74,7 +82,7 @@ index c7f6009..ab206c5 100644
Numeric.Lens
other-modules:
@@ -395,7 +385,6 @@ test-suite doctests
@@ -403,7 +392,6 @@ test-suite doctests
deepseq,
doctest >= 0.9.1,
filepath,
@ -82,7 +90,7 @@ index c7f6009..ab206c5 100644
mtl,
nats,
parallel,
@@ -433,7 +422,6 @@ benchmark plated
@@ -441,7 +429,6 @@ benchmark plated
comonad,
criterion,
deepseq,
@ -90,7 +98,7 @@ index c7f6009..ab206c5 100644
lens,
transformers
@@ -468,7 +456,6 @@ benchmark unsafe
@@ -476,7 +463,6 @@ benchmark unsafe
comonads-fd,
criterion,
deepseq,
@ -98,7 +106,7 @@ index c7f6009..ab206c5 100644
lens,
transformers
@@ -485,6 +472,5 @@ benchmark zipper
@@ -493,6 +479,5 @@ benchmark zipper
comonads-fd,
criterion,
deepseq,
@ -106,10 +114,18 @@ index c7f6009..ab206c5 100644
lens,
transformers
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
index d879c58..3d6015b 100644
index 7e15267..433f1fc 100644
--- a/src/Control/Lens.hs
+++ b/src/Control/Lens.hs
@@ -56,12 +56,11 @@ module Control.Lens
@@ -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
, module Control.Lens.Lens
, module Control.Lens.Level
, module Control.Lens.Loupe
@ -123,7 +139,15 @@ index d879c58..3d6015b 100644
, module Control.Lens.TH
#endif
, module Control.Lens.Traversal
@@ -83,12 +82,11 @@ import Control.Lens.Iso
@@ -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
import Control.Lens.Lens
import Control.Lens.Level
import Control.Lens.Loupe
@ -138,12 +162,12 @@ index d879c58..3d6015b 100644
#endif
import Control.Lens.Traversal
diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs
index 7b35db4..269f307 100644
index a80e9c8..7d27b80 100644
--- a/src/Control/Lens/Cons.hs
+++ b/src/Control/Lens/Cons.hs
@@ -56,8 +56,6 @@ import qualified Data.Vector.Unboxed as Unbox
@@ -55,8 +55,6 @@ import Data.Vector.Unboxed (Unbox)
import qualified Data.Vector.Unboxed as Unbox
import Data.Word
import Prelude
-{-# ANN module "HLint: ignore Eta reduce" #-}
-
@ -151,12 +175,12 @@ index 7b35db4..269f307 100644
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs
index 4bbde21..16295f4 100644
index ab09c6b..43aa905 100644
--- a/src/Control/Lens/Internal/Fold.hs
+++ b/src/Control/Lens/Internal/Fold.hs
@@ -35,8 +35,6 @@ import Data.Semigroup hiding (Min, getMin, Max, getMax)
@@ -37,8 +37,6 @@ import Data.Maybe
import Data.Semigroup hiding (Min, getMin, Max, getMax)
import Data.Reflection
import Prelude
-{-# ANN module "HLint: ignore Avoid lambda" #-}
-
@ -164,10 +188,10 @@ index 4bbde21..16295f4 100644
-- Folding
------------------------------------------------------------------------------
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
index 302f68e..1625fe5 100644
index 9992e63..631e8e6 100644
--- a/src/Control/Lens/Operators.hs
+++ b/src/Control/Lens/Operators.hs
@@ -104,7 +104,7 @@ module Control.Lens.Operators
@@ -111,7 +111,7 @@ module Control.Lens.Operators
, (<#~)
, (<#=)
-- * "Control.Lens.Plated"
@ -177,12 +201,12 @@ index 302f68e..1625fe5 100644
, ( # )
-- * "Control.Lens.Setter"
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
index 36152d6..3af6bd3 100644
index b75c870..c6c6596 100644
--- a/src/Control/Lens/Prism.hs
+++ b/src/Control/Lens/Prism.hs
@@ -62,8 +62,6 @@ import Data.Profunctor.Unsafe
@@ -61,8 +61,6 @@ import Unsafe.Coerce
import Data.Profunctor.Unsafe
#endif
import Prelude
-{-# ANN module "HLint: ignore Use camelCase" #-}
-
@ -190,17 +214,17 @@ index 36152d6..3af6bd3 100644
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs
index 8f1ec94..482764a 100644
index ee942c6..2f37134 100644
--- a/src/Control/Monad/Primitive/Lens.hs
+++ b/src/Control/Monad/Primitive/Lens.hs
@@ -26,7 +26,6 @@ import Control.Lens
import Control.Monad.Primitive
@@ -20,7 +20,6 @@ import Control.Lens
import Control.Monad.Primitive (PrimMonad(..))
import GHC.Prim (State#)
-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
#if MIN_VERSION_primitive(0,6,0)
prim :: PrimBase m => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
prim = iso internal primitive
--
2.1.4
2.1.1

27
standalone/no-th/haskell-patches/monad-logger_remove-TH.patch Normal file
View file

@ -0,0 +1,27 @@
From 8e78a25ce0cc19e52d063f66bd4cd316462393d4 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 6 Mar 2014 23:27:06 +0000
Subject: [PATCH] disable th
---
monad-logger.cabal | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/monad-logger.cabal b/monad-logger.cabal
index b0aa271..cd56c0f 100644
--- a/monad-logger.cabal
+++ b/monad-logger.cabal
@@ -14,8 +14,8 @@ cabal-version: >=1.8
flag template_haskell {
Description: Enable Template Haskell support
- Default: True
- Manual: True
+ Default: False
+ Manual: False
}
library
--
1.9.0

0
standalone/android/haskell-patches/optparse-applicative_remove-ANN.patch → standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch
View file

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

@ -0,0 +1,41 @@
From aae3ace106cf26c931cc94c96fb6fbfe83f950f2 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Wed, 15 Oct 2014 17:05:37 +0000
Subject: [PATCH] avoid TH
---
Database/Persist/Sql/Raw.hs | 4 +---
1 file changed, 1 insertion(+), 3 deletions(-)
diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
index 3ac2ca9..bcc2011 100644
--- a/Database/Persist/Sql/Raw.hs
+++ b/Database/Persist/Sql/Raw.hs
@@ -11,7 +11,7 @@ import Data.IORef (writeIORef, readIORef, newIORef)
import Control.Exception (throwIO)
import Control.Monad (when, liftM)
import Data.Text (Text, pack)
-import Control.Monad.Logger (logDebugS)
+--import Control.Monad.Logger (logDebugS)
import Data.Int (Int64)
import Control.Monad.Trans.Class (lift)
import qualified Data.Text as T
@@ -23,7 +23,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m)
-> [PersistValue]
-> Source m [PersistValue]
rawQuery sql vals = do
- lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
conn <- lift askSqlConn
bracketP
(getStmtConn conn sql)
@@ -35,7 +34,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y
rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
rawExecuteCount sql vals = do
- $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
stmt <- getStmt sql
res <- liftIO $ stmtExecute stmt vals
liftIO $ stmtReset stmt
--
2.1.1

0
standalone/android/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch → standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch
View file

59
standalone/no-th/haskell-patches/reflection_remove-TH.patch Normal file
View file

@ -0,0 +1,59 @@
From c0f5dcfd6ba7a05bb84b6adc4664c8dde109e6ac Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 7 Mar 2014 04:30:22 +0000
Subject: [PATCH] remove TH
---
fast/Data/Reflection.hs | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs
index ca57d35..d3f8356 100644
--- a/fast/Data/Reflection.hs
+++ b/fast/Data/Reflection.hs
@@ -59,7 +59,7 @@ module Data.Reflection
, Given(..)
, give
-- * Template Haskell reflection
- , int, nat
+ --, int, nat
-- * Useful compile time naturals
, Z, D, SD, PD
) where
@@ -161,6 +161,7 @@ instance Reifies n Int => Reifies (PD n) Int where
-- instead of @$(int 3)@. Sometimes the two will produce the same
-- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor
-- directive).
+{-
int :: Int -> TypeQ
int n = case quotRem n 2 of
(0, 0) -> conT ''Z
@@ -176,7 +177,7 @@ nat :: Int -> TypeQ
nat n
| n >= 0 = int n
| otherwise = error "nat: negative"
-
+-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704
instance Show (Q a)
instance Eq (Q a)
@@ -195,6 +196,7 @@ instance Fractional a => Fractional (Q a) where
recip = fmap recip
fromRational = return . fromRational
+{-
-- | This permits the use of $(5) as a type splice.
instance Num Type where
#ifdef USE_TYPE_LITS
@@ -254,7 +256,7 @@ instance Num Exp where
abs = onProxyType1 abs
signum = onProxyType1 signum
fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n)
-
+-}
#ifdef USE_TYPE_LITS
addProxy :: Proxy a -> Proxy b -> Proxy (a + b)
addProxy _ _ = Proxy
--
1.9.0

366
standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch Normal file
View file

@ -0,0 +1,366 @@
From 657fa7135bbcf3d5adb3cc0032e09887dd80a2a7 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 16 Oct 2014 02:05:14 +0000
Subject: [PATCH] hack TH
---
Text/Cassius.hs | 23 --------
Text/Css.hs | 151 --------------------------------------------------
Text/CssCommon.hs | 4 --
Text/Lucius.hs | 46 +--------------
shakespeare-css.cabal | 2 +-
5 files changed, 3 insertions(+), 223 deletions(-)
diff --git a/Text/Cassius.hs b/Text/Cassius.hs
index 91fc90f..c515807 100644
--- a/Text/Cassius.hs
+++ b/Text/Cassius.hs
@@ -13,10 +13,6 @@ module Text.Cassius
, renderCss
, renderCssUrl
-- * Parsing
- , cassius
- , cassiusFile
- , cassiusFileDebug
- , cassiusFileReload
-- * ToCss instances
-- ** Color
, Color (..)
@@ -27,11 +23,8 @@ module Text.Cassius
, AbsoluteUnit (..)
, AbsoluteSize (..)
, absoluteSize
- , EmSize (..)
- , ExSize (..)
, PercentageSize (..)
, percentageSize
- , PixelSize (..)
-- * Internal
, cassiusUsedIdentifiers
) where
@@ -43,25 +36,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import qualified Data.Text.Lazy as TL
import Text.CssCommon
-import Text.Lucius (lucius)
import qualified Text.Lucius
import Text.IndentToBrace (i2b)
-cassius :: QuasiQuoter
-cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }
-
-cassiusFile :: FilePath -> Q Exp
-cassiusFile fp = do
-#ifdef GHC_7_4
- qAddDependentFile fp
-#endif
- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
- quoteExp cassius contents
-
-cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp
-cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels
-cassiusFileReload = cassiusFileDebug
-
-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
diff --git a/Text/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..8c40e8c 100644
--- a/Text/CssCommon.hs
+++ b/Text/CssCommon.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
@@ -156,6 +155,3 @@ showSize :: Rational -> String -> String
showSize value' unit = printf "%f" value ++ unit
where value = fromRational value' :: Double
-mkSizeType "EmSize" "em"
-mkSizeType "ExSize" "ex"
-mkSizeType "PixelSize" "px"
diff --git a/Text/Lucius.hs b/Text/Lucius.hs
index 346883d..f38492b 100644
--- a/Text/Lucius.hs
+++ b/Text/Lucius.hs
@@ -8,13 +8,9 @@
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Lucius
( -- * Parsing
- lucius
- , luciusFile
- , luciusFileDebug
- , luciusFileReload
-- ** Mixins
- , luciusMixin
- , Mixin
+ -- luciusMixin
+ Mixin
-- ** Runtime
, luciusRT
, luciusRT'
@@ -40,11 +36,8 @@ module Text.Lucius
, AbsoluteUnit (..)
, AbsoluteSize (..)
, absoluteSize
- , EmSize (..)
- , ExSize (..)
, PercentageSize (..)
, percentageSize
- , PixelSize (..)
-- * Internal
, parseTopLevels
, luciusUsedIdentifiers
@@ -67,18 +60,6 @@ import Data.List (isSuffixOf)
import Control.Arrow (second)
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 ()
@@ -218,17 +199,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 =
@@ -377,15 +347,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $
-- creating systems like yesod devel.
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/shakespeare-css.cabal b/shakespeare-css.cabal
index 2d3b25a..cc0553c 100644
--- a/shakespeare-css.cabal
+++ b/shakespeare-css.cabal
@@ -35,8 +35,8 @@ library
exposed-modules: Text.Cassius
Text.Lucius
- other-modules: Text.MkSizeType
Text.Css
+ other-modules: Text.MkSizeType
Text.IndentToBrace
Text.CssCommon
ghc-options: -Wall
--
2.1.1

316
standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch Normal file
View file

@ -0,0 +1,316 @@
From 26f7328b0123d3ffa66873b91189ba3bdae3356c Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 16 Oct 2014 02:07:32 +0000
Subject: [PATCH] hack TH
---
Text/Coffee.hs | 56 ++++-----------------------------------------
Text/Julius.hs | 67 +++++++++---------------------------------------------
Text/Roy.hs | 51 ++++-------------------------------------
Text/TypeScript.hs | 51 ++++-------------------------------------
4 files changed, 24 insertions(+), 201 deletions(-)
diff --git a/Text/Coffee.hs b/Text/Coffee.hs
index 488c81b..61db85b 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/Julius.hs b/Text/Julius.hs
index ec30690..5b5a075 100644
--- a/Text/Julius.hs
+++ b/Text/Julius.hs
@@ -14,17 +14,17 @@ 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
+ -- js
+ -- julius
+ -- juliusFile
+ -- jsFile
+ --, juliusFileDebug
+ --, jsFileDebug
+ --, juliusFileReload
+ --, jsFileReload
-- * Datatypes
- , JavascriptUrl
+ JavascriptUrl
, Javascript (..)
, RawJavascript (..)
@@ -37,9 +37,9 @@ module Text.Julius
, renderJavascriptUrl
-- ** internal, used by 'Text.Coffee'
- , javascriptSettings
+ --, javascriptSettings
-- ** internal
- , juliusUsedIdentifiers
+ --, juliusUsedIdentifiers
, asJavascriptUrl
) where
@@ -102,48 +102,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/Roy.hs b/Text/Roy.hs
index 6e5e246..9ab0dbc 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
@@ -53,46 +53,3 @@ 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/TypeScript.hs b/Text/TypeScript.hs
index 70c8820..5be994a 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
@@ -71,46 +71,3 @@ import Language.Haskell.TH.Syntax
import Text.Shakespeare
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 Roy 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
--
2.1.1

1283
standalone/no-th/haskell-patches/shakespeare_remove-TH.patch
View file

File diff suppressed because it is too large Load diff

0
standalone/android/haskell-patches/skein_hardcode_little-endian.patch → standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch
View file

49
standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch Normal file
View file

@ -0,0 +1,49 @@
From 6ffd4fcb7d27ec6df709d80a40a262406446a259 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Wed, 15 Oct 2014 17:00:56 +0000
Subject: [PATCH] cross build
---
Data/Vector/Fusion/Stream/Monadic.hs | 1 -
Data/Vector/Unboxed/Base.hs | 13 -------------
2 files changed, 14 deletions(-)
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
index 51fec75..b089b3d 100644
--- a/Data/Vector/Fusion/Stream/Monadic.hs
+++ b/Data/Vector/Fusion/Stream/Monadic.hs
@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )
data SPEC = SPEC | SPEC2
#if __GLASGOW_HASKELL__ >= 700
-{-# ANN type SPEC ForceSpecConstr #-}
#endif
emptyStream :: String
diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs
index 00350cb..34bfc4a 100644
--- a/Data/Vector/Unboxed/Base.hs
+++ b/Data/Vector/Unboxed/Base.hs
@@ -65,19 +65,6 @@ vectorTyCon = mkTyCon3 "vector"
vectorTyCon m s = mkTyCon $ m ++ "." ++ s
#endif
-instance Typeable1 Vector where
- typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") []
-
-instance Typeable2 MVector where
- typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") []
-
-instance (Data a, Unbox a) => Data (Vector a) where
- gfoldl = G.gfoldl
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector"
- dataCast1 = G.dataCast
-
-- ----
-- Unit
-- ----
--
2.1.1

24
standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch
View file

@ -1,8 +1,12 @@
From a020dd27eda45263db6ac887df4a94efb6ca86db Mon Sep 17 00:00:00 2001
From 3aef808eee43c973ae1fbf6e8769d89b7f0d355b Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 2 Jul 2015 21:36:02 +0000
Date: Tue, 10 Jun 2014 14:47:42 +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 ++++----
@ -10,10 +14,10 @@ Subject: [PATCH] deal with TH
3 files changed, 5 insertions(+), 11 deletions(-)
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
index 228582d..7d72bb0 100644
index db2b835..b2c1aec 100644
--- a/Network/Wai/Application/Static.hs
+++ b/Network/Wai/Application/Static.hs
@@ -34,8 +34,6 @@ import Control.Monad.IO.Class (liftIO)
@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
import Blaze.ByteString.Builder (toByteString)
@ -22,10 +26,10 @@ index 228582d..7d72bb0 100644
import Data.Text (Text)
import qualified Data.Text as T
@@ -218,8 +216,6 @@ staticAppPieces _ _ req sendResponse
@@ -198,8 +196,6 @@ staticAppPieces _ _ req sendResponse
H.status405
[("Content-Type", "text/plain")]
"Only GET or HEAD is supported"
"Only GET 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
@ -51,10 +55,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 4cca237..3fbfcee 100644
index ef6f898..9a59d71 100644
--- a/wai-app-static.cabal
+++ b/wai-app-static.cabal
@@ -35,7 +35,6 @@ library
@@ -33,7 +33,6 @@ library
, containers >= 0.2
, time >= 1.1.4
, old-locale >= 1.0.0.2
@ -62,7 +66,7 @@ index 4cca237..3fbfcee 100644
, text >= 0.7
, blaze-builder >= 0.2.1.4
, base64-bytestring >= 0.1
@@ -63,9 +62,8 @@ library
@@ -61,9 +60,8 @@ library
WaiAppStatic.Listing
WaiAppStatic.Types
WaiAppStatic.CmdLine
@ -74,5 +78,5 @@ index 4cca237..3fbfcee 100644
extensions: CPP
--
2.1.4
2.0.0

108
standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch Normal file
View file

@ -0,0 +1,108 @@
From b53713fbb4f3bb6bdd25b07afcaed4940b32dfa8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 18 Dec 2013 03:32:44 +0000
Subject: [PATCH] remove TH
---
Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
1 file changed, 1 insertion(+), 80 deletions(-)
diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
index f587410..4e830bd 100644
--- a/Text/Hamlet/XML.hs
+++ b/Text/Hamlet/XML.hs
@@ -1,9 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Hamlet.XML
- ( xml
- , xmlFile
- ) where
+ () where
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote
@@ -19,80 +17,3 @@ import qualified Data.Foldable as F
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
-xml :: QuasiQuoter
-xml = QuasiQuoter { quoteExp = strToExp }
-
-xmlFile :: FilePath -> Q Exp
-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
-
-strToExp :: String -> Q Exp
-strToExp s =
- case parseDoc s of
- Error e -> error e
- Ok x -> docsToExp [] x
-
-docsToExp :: Scope -> [Doc] -> Q Exp
-docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
-
-docToExp :: Scope -> Doc -> Q Exp
-docToExp scope (DocTag name attrs cs) =
- [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
- ] |]
-docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
-docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
-docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
-docToExp scope (DocForall deref ident@(Ident ident') inside) = do
- let list' = derefToExp scope deref
- name <- newName ident'
- let scope' = (ident, VarE name) : scope
- inside' <- docsToExp scope' inside
- let lam = LamE [VarP name] inside'
- [| F.concatMap $(return lam) $(return list') |]
-docToExp scope (DocWith [] inside) = docsToExp scope inside
-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
- let deref' = derefToExp scope deref
- name' <- newName name
- let scope' = (ident, VarE name') : scope
- inside' <- docToExp scope' (DocWith dis inside)
- let lam = LamE [VarP name'] inside'
- return $ lam `AppE` deref'
-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
- let deref' = derefToExp scope deref
- name' <- newName name
- let scope' = (ident, VarE name') : scope
- inside' <- docsToExp scope' just
- let inside'' = LamE [VarP name'] inside'
- nothing' <-
- case nothing of
- Nothing -> [| [] |]
- Just n -> docsToExp scope n
- [| maybe $(return nothing') $(return inside'') $(return deref') |]
-docToExp scope (DocCond conds final) = do
- unit <- [| () |]
- body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
- return $ CaseE unit [Match (TupP []) body []]
- where
- go (deref, inside) = do
- inside' <- docsToExp scope inside
- return (NormalG $ derefToExp scope deref, inside')
-
-mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
-mkAttrs _ [] = [| Map.empty |]
-mkAttrs scope ((mderef, name, value):rest) = do
- rest' <- mkAttrs scope rest
- this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
- let with = [| $(return this) $(return rest') |]
- case mderef of
- Nothing -> with
- Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
- where
- go (ContentRaw s) = [| pack $(lift s) |]
- go (ContentVar d) = return $ derefToExp scope d
- go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
-
-liftName :: String -> Q Exp
-liftName s = do
- X.Name local mns _ <- return $ fromString s
- case mns of
- Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
- Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
--
1.8.5.1

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

@ -1,6 +1,6 @@
From bec7dac77cc7fbe9a620c371d7c2cdbcf234eac6 Mon Sep 17 00:00:00 2001
From f1feea61dcba0b16afed5ce8dd5d2433fe505461 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 00:39:53 +0000
Date: Thu, 16 Oct 2014 02:15:23 +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 f7436e6..2fa62cc 100644
index 9b29317..7c0792d 100644
--- a/Yesod/Core.hs
+++ b/Yesod/Core.hs
@@ -31,16 +31,16 @@ module Yesod.Core
@ -45,7 +45,7 @@ index f7436e6..2fa62cc 100644
-- * Sessions
, SessionBackend (..)
, customizeSessionCookies
@@ -90,17 +90,15 @@ module Yesod.Core
@@ -87,17 +87,15 @@ module Yesod.Core
, readIntegral
-- * Shakespeare
-- ** Hamlet
@ -68,10 +68,10 @@ index f7436e6..2fa62cc 100644
, renderCssUrl
) where
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
index c2e707a..b594353 100644
index 8631d27..c40eb10 100644
--- a/Yesod/Core/Class/Yesod.hs
+++ b/Yesod/Core/Class/Yesod.hs
@@ -5,11 +5,15 @@
@@ -5,18 +5,22 @@
{-# LANGUAGE CPP #-}
module Yesod.Core.Class.Yesod where
@ -88,16 +88,15 @@ index c2e707a..b594353 100644
import Blaze.ByteString.Builder (Builder)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
@@ -18,7 +22,7 @@ import Control.Exception (bracket)
import Control.Arrow ((***), second)
import Control.Monad (forM, when, void)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
- LogSource)
+ LogSource, Loc)
import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState)
-import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
+import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther),
LogSource)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
@@ -35,7 +39,6 @@ import qualified Data.Text.Encoding.Error as TEE
@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Word (Word64)
@ -105,7 +104,7 @@ index c2e707a..b594353 100644
import Network.HTTP.Types (encodePath)
import qualified Network.Wai as W
import Data.Default (def)
@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where
@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where
defaultLayout w = do
p <- widgetToPageContent w
mmsg <- getMessage
@ -144,7 +143,7 @@ index c2e707a..b594353 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
@@ -410,45 +421,103 @@ widgetToPageContent w = do
@@ -374,45 +385,103 @@ widgetToPageContent w = do
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
-- the asynchronous loader means your page doesn't have to wait for all the js to load
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
@ -287,7 +286,7 @@ index c2e707a..b594353 100644
return $ PageContent title headAll $
case jsLoader master of
@@ -478,10 +547,13 @@ defaultErrorHandler NotFound = selectRep $ do
@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do
r <- waiRequest
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
setTitle "Not Found"
@ -305,7 +304,7 @@ index c2e707a..b594353 100644
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
-- For API requests.
@@ -491,10 +563,11 @@ defaultErrorHandler NotFound = selectRep $ do
@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do
defaultErrorHandler NotAuthenticated = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Not logged in"
@ -321,7 +320,7 @@ index c2e707a..b594353 100644
provideRep $ do
-- 401 *MUST* include a WWW-Authenticate header
@@ -516,10 +589,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
@@ -480,10 +553,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Permission Denied"
@ -339,7 +338,7 @@ index c2e707a..b594353 100644
provideRep $
return $ object $ [
"message" .= ("Permission Denied. " <> msg)
@@ -528,30 +604,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
@@ -492,30 +568,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Invalid Arguments"
@ -397,7 +396,7 @@ index c2e707a..b594353 100644
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
asyncHelper :: (url -> [x] -> Text)
@@ -718,8 +806,4 @@ loadClientSession key getCachedDate sessionName req = load
@@ -682,8 +770,4 @@ loadClientSession key getCachedDate sessionName req = load
-- turn the TH Loc loaction information into a human readable string
-- leaving out the loc_end parameter
fileLocationToString :: Loc -> String
@ -408,7 +407,7 @@ index c2e707a..b594353 100644
- char = show . snd . loc_start
+fileLocationToString loc = "unknown"
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
index 7e43f74..625a901 100644
index e0d1f0e..cc23fdd 100644
--- a/Yesod/Core/Dispatch.hs
+++ b/Yesod/Core/Dispatch.hs
@@ -1,4 +1,3 @@
@ -445,9 +444,9 @@ index 7e43f74..625a901 100644
, PathMultiPiece (..)
, Texts
-- * Convert to WAI
@@ -141,13 +140,6 @@ toWaiAppLogger logger site = do
@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do
, yreSite = site
, yreSessionBackend = sb
, yreGen = gen
}
- messageLoggerSource
- site
@ -459,10 +458,10 @@ index 7e43f74..625a901 100644
middleware <- mkDefaultMiddlewares logger
return $ middleware $ toWaiAppYre yre
@@ -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 ->
@@ -170,14 +162,7 @@ warp port site = do
]
-}
, Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
- when (shouldLog' e) $
- messageLoggerSource
- site
@ -470,12 +469,12 @@ index 7e43f74..625a901 100644
- $(qLocation >>= liftLoc)
- "yesod-core"
- LevelError
- (toLogStr $ "Exception from Warp: " ++ show e)) $
+ when (shouldLog' e) $ error (show e)) $
Network.Wai.Handler.Warp.defaultSettings)
- (toLogStr $ "Exception from Warp: " ++ show e)
+ when (shouldLog' e) $ error (show e)
}
where
shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException
@@ -208,7 +193,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
shouldLog' =
@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
-- | Deprecated synonym for 'warp'.
warpDebug :: YesodDispatch site => Int -> site -> IO ()
warpDebug = warp
@ -484,10 +483,10 @@ index 7e43f74..625a901 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 19f4152..c97fb24 100644
index d2b196b..13cac17 100644
--- a/Yesod/Core/Handler.hs
+++ b/Yesod/Core/Handler.hs
@@ -178,7 +178,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
@@ -174,7 +174,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as TL
import qualified Text.Blaze.Html.Renderer.Text as RenderText
@ -496,7 +495,7 @@ index 19f4152..c97fb24 100644
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
@@ -206,6 +206,7 @@ import Control.Exception (throwIO)
@@ -203,6 +203,7 @@ import Control.Exception (throwIO)
import Blaze.ByteString.Builder (Builder)
import Safe (headMay)
import Data.CaseInsensitive (CI)
@ -504,7 +503,7 @@ index 19f4152..c97fb24 100644
import qualified Data.Conduit.List as CL
import Control.Monad (unless)
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
@@ -848,19 +849,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
-> m a
redirectToPost url = do
urlText <- toTextUrl url
@ -534,7 +533,7 @@ index 19f4152..c97fb24 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 651c11c..46e1d2a 100644
index 311f208..63f666f 100644
--- a/Yesod/Core/Internal/Run.hs
+++ b/Yesod/Core/Internal/Run.hs
@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch)
@ -544,18 +543,18 @@ index 651c11c..46e1d2a 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)
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
import qualified Data.ByteString as S
@@ -32,7 +32,7 @@ import Data.Text.Encoding (encodeUtf8)
@@ -31,7 +31,7 @@ import qualified Data.Text as T
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
import Network.Wai.Internal
@@ -160,8 +160,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
#if MIN_VERSION_wai(2, 0, 0)
@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ErrorResponse
-> YesodApp
safeEh log' er req = do
@ -684,26 +683,26 @@ index 7e84c1c..a273c29 100644
- ]
- return $ LetE [fun] (VarE helper)
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
index 5fa5c3d..1646d54 100644
index 388dfe3..b3fce0f 100644
--- a/Yesod/Core/Types.hs
+++ b/Yesod/Core/Types.hs
@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase))
import Control.Monad.Catch (MonadCatch (..))
@@ -21,6 +21,7 @@ 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 (..))
@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv
@@ -191,7 +192,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
@ -765,5 +764,5 @@ index 481199e..8489fbe 100644
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m))
--
2.1.4
2.1.1

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

File diff suppressed because it is too large Load diff

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

@ -1,6 +1,6 @@
From 4d8650bd806f50aa2538270f80fa93261c43d056 Mon Sep 17 00:00:00 2001
From e82ed4e6fd7b5ea6dbe474b5de2755ec5794161c Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 00:12:02 +0000
Date: Thu, 16 Oct 2014 02:23:50 +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 c3bc1bf..1727dba 100644
index b116f3a..017b184 100644
--- a/yesod-persistent.cabal
+++ b/yesod-persistent.cabal
@@ -15,16 +15,6 @@ extra-source-files: README.md ChangeLog.md
@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod.
library
build-depends: base >= 4 && < 5
- , yesod-core >= 1.4.0 && < 1.5
- , persistent >= 2.1 && < 2.2
- , persistent-template >= 2.1 && < 2.2
- , yesod-core >= 1.2.2 && < 1.3
- , persistent >= 1.2 && < 2.1
- , persistent-template >= 1.2 && < 2.1
- , transformers >= 0.2.2
- , blaze-builder
- , conduit
@ -29,5 +29,5 @@ index c3bc1bf..1727dba 100644
test-suite test
--
2.1.4
2.1.1

170
standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch Normal file
View file

@ -0,0 +1,170 @@
From 8ba08c0efc035486a65f2fd33916a5da7e5210e7 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 26 Dec 2013 19:32:55 -0400
Subject: [PATCH] remove TH
---
Yesod/Routes/Parse.hs | 40 +++++-----------------------------------
Yesod/Routes/TH.hs | 16 ++++++++--------
Yesod/Routes/TH/Types.hs | 16 ----------------
yesod-routes.cabal | 4 ----
4 files changed, 13 insertions(+), 63 deletions(-)
diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs
index 232982d..7df7750 100644
--- a/Yesod/Routes/Parse.hs
+++ b/Yesod/Routes/Parse.hs
@@ -2,11 +2,11 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter
module Yesod.Routes.Parse
- ( parseRoutes
- , parseRoutesFile
- , parseRoutesNoCheck
- , parseRoutesFileNoCheck
- , parseType
+ --( parseRoutes
+ --, parseRoutesFile
+ --, parseRoutesNoCheck
+ --, parseRoutesFileNoCheck
+ ( parseType
, parseTypeTree
, TypeTree (..)
) where
@@ -19,42 +19,12 @@ import Yesod.Routes.TH
import Yesod.Routes.Overlap (findOverlapNames)
import Data.List (foldl')
--- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for
--- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the
--- checking. See documentation site for details on syntax.
-parseRoutes :: QuasiQuoter
-parseRoutes = QuasiQuoter { quoteExp = x }
- where
- x s = do
- let res = resourcesFromString s
- case findOverlapNames res of
- [] -> lift res
- z -> error $ unlines $ "Overlapping routes: " : map show z
-
-parseRoutesFile :: FilePath -> Q Exp
-parseRoutesFile = parseRoutesFileWith parseRoutes
-
-parseRoutesFileNoCheck :: FilePath -> Q Exp
-parseRoutesFileNoCheck = parseRoutesFileWith parseRoutesNoCheck
-
-parseRoutesFileWith :: QuasiQuoter -> FilePath -> Q Exp
-parseRoutesFileWith qq fp = do
- qAddDependentFile fp
- s <- qRunIO $ readUtf8File fp
- quoteExp qq s
-
readUtf8File :: FilePath -> IO String
readUtf8File fp = do
h <- SIO.openFile fp SIO.ReadMode
SIO.hSetEncoding h SIO.utf8_bom
SIO.hGetContents h
--- | Same as 'parseRoutes', but performs no overlap checking.
-parseRoutesNoCheck :: QuasiQuoter
-parseRoutesNoCheck = QuasiQuoter
- { quoteExp = lift . resourcesFromString
- }
-
-- | Convert a multi-line string to a set of resources. See documentation for
-- the format of this string. This is a partial function which calls 'error' on
-- invalid input.
diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs
index 7b2e50b..b05fc57 100644
--- a/Yesod/Routes/TH.hs
+++ b/Yesod/Routes/TH.hs
@@ -2,15 +2,15 @@
module Yesod.Routes.TH
( module Yesod.Routes.TH.Types
-- * Functions
- , module Yesod.Routes.TH.RenderRoute
- , module Yesod.Routes.TH.ParseRoute
- , module Yesod.Routes.TH.RouteAttrs
+ -- , module Yesod.Routes.TH.RenderRoute
+ -- , module Yesod.Routes.TH.ParseRoute
+ -- , module Yesod.Routes.TH.RouteAttrs
-- ** Dispatch
- , module Yesod.Routes.TH.Dispatch
+ -- , module Yesod.Routes.TH.Dispatch
) where
import Yesod.Routes.TH.Types
-import Yesod.Routes.TH.RenderRoute
-import Yesod.Routes.TH.ParseRoute
-import Yesod.Routes.TH.RouteAttrs
-import Yesod.Routes.TH.Dispatch
+--import Yesod.Routes.TH.RenderRoute
+--import Yesod.Routes.TH.ParseRoute
+--import Yesod.Routes.TH.RouteAttrs
+--import Yesod.Routes.TH.Dispatch
diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs
index d0a0405..3232e99 100644
--- a/Yesod/Routes/TH/Types.hs
+++ b/Yesod/Routes/TH/Types.hs
@@ -31,10 +31,6 @@ instance Functor ResourceTree where
fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r)
fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c
-instance Lift t => Lift (ResourceTree t) where
- lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|]
- lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|]
-
data Resource typ = Resource
{ resourceName :: String
, resourcePieces :: [(CheckOverlap, Piece typ)]
@@ -48,9 +44,6 @@ type CheckOverlap = Bool
instance Functor Resource where
fmap f (Resource a b c d) = Resource a (map (second $ fmap f) b) (fmap f c) d
-instance Lift t => Lift (Resource t) where
- lift (Resource a b c d) = [|Resource a b c d|]
-
data Piece typ = Static String | Dynamic typ
deriving Show
@@ -58,10 +51,6 @@ instance Functor Piece where
fmap _ (Static s) = (Static s)
fmap f (Dynamic t) = Dynamic (f t)
-instance Lift t => Lift (Piece t) where
- lift (Static s) = [|Static $(lift s)|]
- lift (Dynamic t) = [|Dynamic $(lift t)|]
-
data Dispatch typ =
Methods
{ methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
@@ -77,11 +66,6 @@ instance Functor Dispatch where
fmap f (Methods a b) = Methods (fmap f a) b
fmap f (Subsite a b) = Subsite (f a) b
-instance Lift t => Lift (Dispatch t) where
- lift (Methods Nothing b) = [|Methods Nothing $(lift b)|]
- lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|]
- lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|]
-
resourceMulti :: Resource typ -> Maybe typ
resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t
resourceMulti _ = Nothing
diff --git a/yesod-routes.cabal b/yesod-routes.cabal
index 61980d1..33d2380 100644
--- a/yesod-routes.cabal
+++ b/yesod-routes.cabal
@@ -27,10 +27,6 @@ library
Yesod.Routes.Class
Yesod.Routes.Parse
Yesod.Routes.Overlap
- other-modules: Yesod.Routes.TH.Dispatch
- Yesod.Routes.TH.RenderRoute
- Yesod.Routes.TH.ParseRoute
- Yesod.Routes.TH.RouteAttrs
Yesod.Routes.TH.Types
ghc-options: -Wall
--
1.7.10.4

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

@ -1,6 +1,6 @@
From 09d7340ff4c9b43f7c8c2ad6529a6c60871d265f Mon Sep 17 00:00:00 2001
From 606c5f4f4b2d476d274907eb2bb8c12b60fc451f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 01:39:14 +0000
Date: Wed, 21 May 2014 04:43:30 +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 a18d88e..afb1cda 100644
index 725ebf4..33eaffd 100644
--- a/Yesod/Static.hs
+++ b/Yesod/Static.hs
@@ -37,8 +37,8 @@ module Yesod.Static
@ -99,7 +99,7 @@ index a18d88e..afb1cda 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 False
publicFiles dir = mkStaticFiles' dir "StaticRoute" False
-
+-}
@ -111,17 +111,17 @@ index a18d88e..afb1cda 100644
+{-
mkStaticFiles :: Prelude.FilePath -> Q [Dec]
mkStaticFiles fp = mkStaticFiles' fp True
mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
@@ -354,6 +358,7 @@ mkStaticFilesList fp fs makeHash = do
[ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) []
@@ -357,6 +361,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
[ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
]
]
+-}
base64md5File :: Prelude.FilePath -> IO String
base64md5File = fmap (base64 . encode) . hashFile
@@ -392,7 +397,7 @@ base64 = map tr
@@ -395,7 +400,7 @@ base64 = map tr
-- single static file at compile time.
data CombineType = JS | CSS
@ -130,7 +130,7 @@ index a18d88e..afb1cda 100644
combineStatics' :: CombineType
-> CombineSettings
-> [Route Static] -- ^ files to combine
@@ -426,7 +431,7 @@ combineStatics' combineType CombineSettings {..} routes = do
@@ -429,7 +434,7 @@ combineStatics' combineType CombineSettings {..} routes = do
case combineType of
JS -> "js"
CSS -> "css"
@ -139,7 +139,7 @@ index a18d88e..afb1cda 100644
-- | Data type for holding all settings for combining files.
--
-- This data type is a settings type. For more information, see:
@@ -502,6 +507,7 @@ instance Default CombineSettings where
@@ -505,6 +510,7 @@ instance Default CombineSettings where
errorIntro :: [FilePath] -> [Char] -> [Char]
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
@ -147,7 +147,7 @@ index a18d88e..afb1cda 100644
liftRoutes :: [Route Static] -> Q Exp
liftRoutes =
fmap ListE . mapM go
@@ -548,4 +554,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
@@ -551,4 +557,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
-> Q Exp
combineScripts' development cs con routes
| development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
@ -155,18 +155,18 @@ index a18d88e..afb1cda 100644
+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a
+-}
diff --git a/yesod-static.cabal b/yesod-static.cabal
index 4ccb0d7..8758aaa 100644
index 2582a95..5df03b3 100644
--- a/yesod-static.cabal
+++ b/yesod-static.cabal
@@ -50,7 +50,6 @@ library
, system-fileio >= 0.3
@@ -49,7 +49,6 @@ library
, data-default
, shakespeare-css >= 1.0.3
, mime-types >= 0.1
- , hjsmin
, filepath >= 1.3
, resourcet >= 0.4
, unordered-containers >= 0.2
@@ -63,13 +62,6 @@ library
@@ -62,13 +61,6 @@ library
, hashable >= 1.1
exposed-modules: Yesod.Static
@ -181,13 +181,13 @@ index 4ccb0d7..8758aaa 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.1.4
2.0.0.rc2

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

@ -1,13 +1,13 @@
From 86e7cf433fcd3386893556d690748781f46d3f03 Mon Sep 17 00:00:00 2001
From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 01:33:03 +0000
Date: Thu, 16 Oct 2014 02:36:37 +0000
Subject: [PATCH] hack TH
---
Yesod.hs | 19 ++++++++++++--
Yesod/Default/Main.hs | 28 +--------------------
Yesod/Default/Util.hs | 68 ++-------------------------------------------------
3 files changed, 20 insertions(+), 95 deletions(-)
Yesod/Default/Main.hs | 31 +----------------------
Yesod/Default/Util.hs | 69 ++-------------------------------------------------
3 files changed, 20 insertions(+), 99 deletions(-)
diff --git a/Yesod.hs b/Yesod.hs
index b367144..fbe309c 100644
@ -41,7 +41,7 @@ index b367144..fbe309c 100644
+insert = undefined
+
diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs
index 2694825..5a5fbb9 100644
index 565ed35..bf46642 100644
--- a/Yesod/Default/Main.hs
+++ b/Yesod/Default/Main.hs
@@ -1,10 +1,8 @@
@ -64,7 +64,7 @@ index 2694825..5a5fbb9 100644
import System.Log.FastLogger (LogStr, toLogStr)
import Language.Haskell.TH.Syntax (qLocation)
@@ -56,30 +54,6 @@ defaultMain load getApp = do
@@ -55,33 +53,6 @@ defaultMain load getApp = do
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
@ -79,24 +79,27 @@ index 2694825..5a5fbb9 100644
-defaultMainLog load getApp = do
- config <- load
- (app, logFunc) <- getApp config
- runSettings
- ( setPort (appPort config)
- $ setHost (appHost config)
- $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc
- runSettings defaultSettings
- { settingsPort = appPort config
- , settingsHost = appHost config
- , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc
- $(qLocation >>= liftLoc)
- "yesod"
- LevelError
- (toLogStr $ "Exception from Warp: " ++ show e))
- $ defaultSettings
- ) app
- (toLogStr $ "Exception from Warp: " ++ show e)
- } app
- where
- shouldLog' = Warp.defaultShouldDisplayException
-
- shouldLog' =
-#if MIN_VERSION_warp(2,1,3)
- Warp.defaultShouldDisplayException
-#else
- const True
-#endif
-- | Run your application continously, listening for SIGINT and exiting
-- when received
--
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
index 488312a..5476b54 100644
index a10358e..0547424 100644
--- a/Yesod/Default/Util.hs
+++ b/Yesod/Default/Util.hs
@@ -5,10 +5,9 @@
@ -122,7 +125,7 @@ index 488312a..5476b54 100644
import Text.Hamlet (HamletSettings, defaultHamletSettings)
import Data.Maybe (catMaybes)
import Data.Default (Default (def))
@@ -69,68 +65,8 @@ data TemplateLanguage = TemplateLanguage
@@ -69,68 +65,7 @@ data TemplateLanguage = TemplateLanguage
, tlReload :: FilePath -> Q Exp
}
@ -140,7 +143,7 @@ index 488312a..5476b54 100644
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
, wfsHamletSettings :: HamletSettings
}
-
-instance Default WidgetFileSettings where
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
-
@ -159,7 +162,7 @@ index 488312a..5476b54 100644
- , func
- , " on "
- , show file
- , ", but no templates were found."
- , ", but no template were found."
- ]
- exps -> return $ DoE $ map NoBindS exps
- where
@ -192,5 +195,5 @@ index 488312a..5476b54 100644
- else return $ Just ex
- else return Nothing
--
2.1.4
2.1.1