Merge orca:/tmp/git-annex
This commit is contained in:
commit
1b35c6c60c
37 changed files with 2158 additions and 1714 deletions
|
@ -0,0 +1,8 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="threadshuffle"
|
||||||
|
subject="cont'd"
|
||||||
|
date="2015-07-31T22:05:14Z"
|
||||||
|
content="""
|
||||||
|
Hi joey, I know my english is not quite correct. What i was trying to say was that i managed to avoid certain parts of the code, because they're governed by some conditions by setting some env variables (what i remember was GIT_SSH and something, but can't say for sure now). So i haven't compiled the code, just went on different code paths based on the conditions described by the code.
|
||||||
|
I will get back to this shortly (maybe next week), install the latest version of git-annex and if that still doesn't work, im gonna build a devenv for haskell and try to see what's happening. I'm gonna be able to provide more details at that point.
|
||||||
|
"""]]
|
|
@ -0,0 +1,31 @@
|
||||||
|
I can put `git-annex fsck` in a loop to check a large directory like this:
|
||||||
|
|
||||||
|
`-S` starts an incremental check, `-m` continues the started incremental check, `&>>` appends all output (both `stdout` and `stderr`) into the `fsck.log` file.
|
||||||
|
|
||||||
|
```
|
||||||
|
$ git-annex fsck -S large-directory --from remote-repo --time-limit=60s &>>~/log/fsck.log
|
||||||
|
#...
|
||||||
|
#...
|
||||||
|
#...
|
||||||
|
$ while (sleep 10); do
|
||||||
|
git-annex fsck -m large-directory --from remote-repo --time-limit=1h &>>~/log/fsck.log
|
||||||
|
#...
|
||||||
|
#...
|
||||||
|
#...
|
||||||
|
done;
|
||||||
|
```
|
||||||
|
|
||||||
|
I need the loop because the connection to `remote-repo` fails after some time (or because remote server error) and needs a reconnect, after that, everything is ok.
|
||||||
|
|
||||||
|
Suppose, I have many large directories and it would be faster to check them if I could run them parallelly. Many small files, they do not take too much bandwidth but more I/O and network communication.
|
||||||
|
|
||||||
|
I know that the progress of `fsck` is stored in a database (now after every 1000 files or 5 minutes or `--time-limit`) but is the checked directory (large-directory) is taken into account when starting/storing the progress?
|
||||||
|
|
||||||
|
**Is the checked directory/path in the primary-key?** Or is it much more complicated?
|
||||||
|
|
||||||
|
If I could start checking many directories in the same time, `fsck` would finish much faster (think about thousands of small icon files). Is it just me or somebody else could profit from this?
|
||||||
|
|
||||||
|
(This is _not_ a feature request, I would like to know if anybody needs this, if possible at all.)
|
||||||
|
|
||||||
|
Thanks,
|
||||||
|
parhuzamos
|
|
@ -14,3 +14,23 @@ you're using sha1 and don't want to spend a long time checksumming everything.
|
||||||
|
|
||||||
# git annex fsck my_cool_big_file
|
# git annex fsck my_cool_big_file
|
||||||
fsck my_cool_big_file (checksum...) ok
|
fsck my_cool_big_file (checksum...) ok
|
||||||
|
|
||||||
|
If you have a large repo, you may want to check it in smaller steps. You may
|
||||||
|
start and continue an aborted or time-limited check.
|
||||||
|
|
||||||
|
# git annex fsck -S <optional-directory> --time-limit=1m
|
||||||
|
fsck some_file (checksum...) ok
|
||||||
|
fsck my_cool_big_file (checksum...) ok
|
||||||
|
|
||||||
|
Time limit (1m) reached!
|
||||||
|
|
||||||
|
# git annex fsck -m <optional-directory>
|
||||||
|
fsck my_other_big_file (checksum...) ok
|
||||||
|
...
|
||||||
|
|
||||||
|
Use `-S` or `--incremental` to start the incremental check. Use `-m`
|
||||||
|
or `--more` to continue the started check and continue where it left
|
||||||
|
off. Note that saving the progress of `fsck` is performed after every
|
||||||
|
1000 files or 5 minutes or when `--time-limit` occours. There may be
|
||||||
|
files that will be checked again when `git-annex` exists abnormally
|
||||||
|
eg. Ctrl+C and the check is restarted.
|
||||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -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
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] port
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -9,48 +9,48 @@ Subject: [PATCH] port
|
||||||
2 files changed, 9 insertions(+), 5 deletions(-)
|
2 files changed, 9 insertions(+), 5 deletions(-)
|
||||||
|
|
||||||
diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs
|
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
|
--- a/Network/DNS/Resolver.hs
|
||||||
+++ b/Network/DNS/Resolver.hs
|
+++ b/Network/DNS/Resolver.hs
|
||||||
@@ -18,7 +18,7 @@ module Network.DNS.Resolver (
|
@@ -19,7 +19,7 @@ module Network.DNS.Resolver (
|
||||||
, fromDNSFormat
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Applicative ((<$>), (<*>), pure)
|
||||||
-import Control.Exception (bracket)
|
-import Control.Exception (bracket)
|
||||||
+import Control.Exception (bracket, catch, IOException)
|
+import Control.Exception (bracket, catch, IOException)
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace)
|
||||||
import Data.List (isPrefixOf)
|
import Data.List (isPrefixOf)
|
||||||
import Data.Maybe (fromMaybe)
|
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), defaultHints, getAddrInfo
|
||||||
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(
|
|
||||||
import Prelude hiding (lookup)
|
import Prelude hiding (lookup)
|
||||||
import System.Random (getStdRandom, randomR)
|
import System.Random (getStdRandom, randomR)
|
||||||
import System.Timeout (timeout)
|
import System.Timeout (timeout)
|
||||||
+import System.Process
|
+import System.Process
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 709
|
#if mingw32_HOST_OS == 1
|
||||||
import Control.Applicative ((<$>), (<*>), pure)
|
import Network.Socket (send)
|
||||||
@@ -136,10 +137,12 @@ makeResolvSeed conf = ResolvSeed <$> addr
|
@@ -130,10 +131,12 @@ makeResolvSeed conf = ResolvSeed <$> addr
|
||||||
|
where
|
||||||
addr = case resolvInfo conf of
|
addr = case resolvInfo conf of
|
||||||
RCHostName numhost -> makeAddrInfo numhost Nothing
|
RCHostName numhost -> makeAddrInfo numhost
|
||||||
RCHostPort numhost mport -> makeAddrInfo numhost $ Just mport
|
- RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo
|
||||||
- RCFilePath file -> toAddr <$> readFile file >>= \i -> makeAddrInfo i Nothing
|
|
||||||
- toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
|
- toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
|
||||||
- in extract l
|
- in extract l
|
||||||
- extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
|
- extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
|
||||||
+ RCFilePath file -> do
|
+ RCFilePath file -> do
|
||||||
+ -- Android has no /etc/resolv.conf; use getprop command.
|
+ -- Android has no /etc/resolv.conf; use getprop command.
|
||||||
+ ls <- catch (lines <$> readProcess "getprop" ["net.dns1"] []) (const (return []) :: IOException -> IO [String])
|
+ 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
|
+ [] -> "8.8.8.8" -- google public dns as a fallback only
|
||||||
+ (l:_) -> l
|
+ (l:_) -> l
|
||||||
|
|
||||||
makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
|
makeAddrInfo :: HostName -> IO AddrInfo
|
||||||
makeAddrInfo addr mport = do
|
makeAddrInfo addr = do
|
||||||
diff --git a/dns.cabal b/dns.cabal
|
diff --git a/dns.cabal b/dns.cabal
|
||||||
index 0745754..8cf4b67 100644
|
index ceaf5f4..cd15e61 100644
|
||||||
--- a/dns.cabal
|
--- a/dns.cabal
|
||||||
+++ b/dns.cabal
|
+++ b/dns.cabal
|
||||||
@@ -39,6 +39,7 @@ Library
|
@@ -37,6 +37,7 @@ Library
|
||||||
, network >= 2.3
|
, network >= 2.3
|
||||||
, random
|
, random
|
||||||
, resourcet
|
, resourcet
|
||||||
|
@ -59,5 +59,5 @@ index 0745754..8cf4b67 100644
|
||||||
Build-Depends: base >= 4 && < 5
|
Build-Depends: base >= 4 && < 5
|
||||||
, attoparsec
|
, attoparsec
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
|
@ -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
|
||||||
|
|
|
@ -1,31 +1,31 @@
|
||||||
From b2b88224426fe6c7c72ebdec2946fd1ddbacbfaf Mon Sep 17 00:00:00 2001
|
From 7beec2e707d59f9573aa2dc7c57bd2a62f16b480 Mon Sep 17 00:00:00 2001
|
||||||
From: dummy <dummy@example.com>
|
From: Joey Hess <joey@kitenet.net>
|
||||||
Date: Thu, 2 Jul 2015 20:42:50 +0000
|
Date: Wed, 15 May 2013 19:06:03 -0400
|
||||||
Subject: [PATCH] build without IPv6 stuff
|
Subject: [PATCH] build without IPv6 stuff
|
||||||
|
|
||||||
---
|
---
|
||||||
Data/IP.hs | 2 +-
|
Data/IP.hs | 2 +-
|
||||||
Data/IP/Addr.hs | 3 +++
|
Data/IP/Addr.hs | 3 +++
|
||||||
2 files changed, 4 insertions(+), 1 deletion(-)
|
2 files changed, 4 insertions(+), 1 deletion(-)
|
||||||
|
|
||||||
diff --git a/Data/IP.hs b/Data/IP.hs
|
diff --git a/Data/IP.hs b/Data/IP.hs
|
||||||
index 306a488..e3f252e 100644
|
index cffef93..ea486c9 100644
|
||||||
--- a/Data/IP.hs
|
--- a/Data/IP.hs
|
||||||
+++ b/Data/IP.hs
|
+++ b/Data/IP.hs
|
||||||
@@ -6,7 +6,7 @@ module Data.IP (
|
@@ -6,7 +6,7 @@ module Data.IP (
|
||||||
-- ** IP data
|
-- ** IP data
|
||||||
IP (..)
|
IP (..)
|
||||||
, IPv4, toIPv4, fromIPv4, fromHostAddress, toHostAddress
|
, IPv4, toIPv4, fromIPv4, fromHostAddress, toHostAddress
|
||||||
- , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b, fromHostAddress6, toHostAddress6
|
- , IPv6, toIPv6, fromIPv6, fromHostAddress6, toHostAddress6
|
||||||
+ , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b -- , fromHostAddress6, toHostAddress6
|
+ , IPv6, toIPv6, fromIPv6 -- , fromHostAddress6, toHostAddress6
|
||||||
-- ** IP range data
|
-- ** IP range data
|
||||||
, IPRange (..)
|
, IPRange (..)
|
||||||
, AddrRange (addr, mask, mlen)
|
, AddrRange (addr, mask, mlen)
|
||||||
diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs
|
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
|
--- a/Data/IP/Addr.hs
|
||||||
+++ b/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
|
| byteOrder == LittleEndian = fixByteOrder addr4
|
||||||
| otherwise = addr4
|
| otherwise = addr4
|
||||||
|
|
||||||
|
@ -33,7 +33,7 @@ index 8d4131e..868a572 100644
|
||||||
-- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.
|
-- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.
|
||||||
fromHostAddress6 :: HostAddress6 -> IPv6
|
fromHostAddress6 :: HostAddress6 -> IPv6
|
||||||
fromHostAddress6 = IP6
|
fromHostAddress6 = IP6
|
||||||
@@ -384,6 +385,8 @@ fromHostAddress6 = IP6
|
@@ -320,6 +321,8 @@ fromHostAddress6 = IP6
|
||||||
toHostAddress6 :: IPv6 -> HostAddress6
|
toHostAddress6 :: IPv6 -> HostAddress6
|
||||||
toHostAddress6 (IP6 addr6) = addr6
|
toHostAddress6 (IP6 addr6) = addr6
|
||||||
|
|
||||||
|
@ -43,5 +43,5 @@ index 8d4131e..868a572 100644
|
||||||
fixByteOrder s = d1 .|. d2 .|. d3 .|. d4
|
fixByteOrder s = d1 .|. d2 .|. d3 .|. d4
|
||||||
where
|
where
|
||||||
--
|
--
|
||||||
2.1.4
|
1.7.10.4
|
||||||
|
|
||||||
|
|
|
@ -1,17 +1,17 @@
|
||||||
From 508b4701c1610d9772564b97a74b5fa01dab48e2 Mon Sep 17 00:00:00 2001
|
From 7861b133bb269b50fcf709291449cb0473818902 Mon Sep 17 00:00:00 2001
|
||||||
From: dummy <dummy@example.com>
|
From: Joey Hess <joey@kitenet.net>
|
||||||
Date: Thu, 2 Jul 2015 20:12:59 +0000
|
Date: Sun, 29 Dec 2013 21:29:23 +0000
|
||||||
Subject: [PATCH] remove Network.BSD symbols not available in bionic
|
Subject: [PATCH] remove Network.BSD symbols not available in bionic
|
||||||
|
|
||||||
---
|
---
|
||||||
Network/BSD.hsc | 100 --------------------------------------------------------
|
Network/BSD.hsc | 98 -------------------------------------------------------
|
||||||
1 file changed, 100 deletions(-)
|
1 file changed, 98 deletions(-)
|
||||||
|
|
||||||
diff --git a/Network/BSD.hsc b/Network/BSD.hsc
|
diff --git a/Network/BSD.hsc b/Network/BSD.hsc
|
||||||
index b5e9a26..f085f2a 100644
|
index d6dae85..27910f4 100644
|
||||||
--- a/Network/BSD.hsc
|
--- a/Network/BSD.hsc
|
||||||
+++ b/Network/BSD.hsc
|
+++ b/Network/BSD.hsc
|
||||||
@@ -27,15 +27,6 @@ module Network.BSD
|
@@ -30,15 +30,6 @@ module Network.BSD
|
||||||
, getHostByAddr
|
, getHostByAddr
|
||||||
, hostAddress
|
, hostAddress
|
||||||
|
|
||||||
|
@ -27,7 +27,7 @@ index b5e9a26..f085f2a 100644
|
||||||
-- * Service names
|
-- * Service names
|
||||||
, ServiceEntry(..)
|
, ServiceEntry(..)
|
||||||
, ServiceName
|
, ServiceName
|
||||||
@@ -61,14 +52,6 @@ module Network.BSD
|
@@ -64,14 +55,6 @@ module Network.BSD
|
||||||
, getProtocolNumber
|
, getProtocolNumber
|
||||||
, defaultProtocol
|
, defaultProtocol
|
||||||
|
|
||||||
|
@ -42,7 +42,7 @@ index b5e9a26..f085f2a 100644
|
||||||
-- * Port numbers
|
-- * Port numbers
|
||||||
, PortNumber
|
, 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)
|
#if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32)
|
||||||
, getNetworkByName
|
, getNetworkByName
|
||||||
, getNetworkByAddr
|
, getNetworkByAddr
|
||||||
|
@ -52,9 +52,9 @@ index b5e9a26..f085f2a 100644
|
||||||
- , getNetworkEntry
|
- , getNetworkEntry
|
||||||
- , endNetworkEntry
|
- , endNetworkEntry
|
||||||
#endif
|
#endif
|
||||||
|
) where
|
||||||
|
|
||||||
#if defined(HAVE_IF_NAMETOINDEX)
|
@@ -303,31 +282,6 @@ getProtocolNumber proto = do
|
||||||
@@ -298,31 +277,6 @@ getProtocolNumber proto = do
|
|
||||||
(ProtocolEntry _ _ num) <- getProtocolByName proto
|
(ProtocolEntry _ _ num) <- getProtocolByName proto
|
||||||
return num
|
return num
|
||||||
|
|
||||||
|
@ -62,18 +62,18 @@ index b5e9a26..f085f2a 100644
|
||||||
-getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
|
-getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
|
||||||
-getProtocolEntry = withLock $ do
|
-getProtocolEntry = withLock $ do
|
||||||
- ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry"
|
- ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry"
|
||||||
- $ c_getprotoent
|
- $ trySysCall c_getprotoent
|
||||||
- peek ent
|
- peek ent
|
||||||
-
|
-
|
||||||
-foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)
|
-foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)
|
||||||
-
|
-
|
||||||
-setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
|
-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 ()
|
-foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO ()
|
||||||
-
|
-
|
||||||
-endProtocolEntry :: IO ()
|
-endProtocolEntry :: IO ()
|
||||||
-endProtocolEntry = withLock $ c_endprotoent
|
-endProtocolEntry = withLock $ trySysCall $ c_endprotoent
|
||||||
-
|
-
|
||||||
-foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()
|
-foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()
|
||||||
-
|
-
|
||||||
|
@ -86,7 +86,7 @@ index b5e9a26..f085f2a 100644
|
||||||
-- ---------------------------------------------------------------------------
|
-- ---------------------------------------------------------------------------
|
||||||
-- Host lookups
|
-- Host lookups
|
||||||
|
|
||||||
@@ -397,31 +351,6 @@ getHostByAddr family addr = do
|
@@ -402,31 +356,6 @@ getHostByAddr family addr = do
|
||||||
foreign import CALLCONV safe "gethostbyaddr"
|
foreign import CALLCONV safe "gethostbyaddr"
|
||||||
c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
|
c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
|
||||||
|
|
||||||
|
@ -94,13 +94,13 @@ index b5e9a26..f085f2a 100644
|
||||||
-getHostEntry :: IO HostEntry
|
-getHostEntry :: IO HostEntry
|
||||||
-getHostEntry = withLock $ do
|
-getHostEntry = withLock $ do
|
||||||
- throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry"
|
- throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry"
|
||||||
- $ c_gethostent
|
- $ trySysCall $ c_gethostent
|
||||||
- >>= peek
|
- >>= peek
|
||||||
-
|
-
|
||||||
-foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)
|
-foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)
|
||||||
-
|
-
|
||||||
-setHostEntry :: Bool -> IO ()
|
-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 ()
|
-foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO ()
|
||||||
-
|
-
|
||||||
|
@ -118,14 +118,14 @@ index b5e9a26..f085f2a 100644
|
||||||
-- ---------------------------------------------------------------------------
|
-- ---------------------------------------------------------------------------
|
||||||
-- Accessing network information
|
-- 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"
|
foreign import ccall unsafe "getnetbyaddr"
|
||||||
c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)
|
c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)
|
||||||
|
|
||||||
-getNetworkEntry :: IO NetworkEntry
|
-getNetworkEntry :: IO NetworkEntry
|
||||||
-getNetworkEntry = withLock $ do
|
-getNetworkEntry = withLock $ do
|
||||||
- throwNoSuchThingIfNull "getNetworkEntry" "no more network entries"
|
- throwNoSuchThingIfNull "getNetworkEntry" "no more network entries"
|
||||||
- $ c_getnetent
|
- $ trySysCall $ c_getnetent
|
||||||
- >>= peek
|
- >>= peek
|
||||||
-
|
-
|
||||||
-foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)
|
-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
|
--- whether a connection is maintained open between various
|
||||||
--- networkEntry calls
|
--- networkEntry calls
|
||||||
-setNetworkEntry :: Bool -> IO ()
|
-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 ()
|
-foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO ()
|
||||||
-
|
-
|
||||||
--- | Close the connection to the network name database.
|
--- | Close the connection to the network name database.
|
||||||
-endNetworkEntry :: IO ()
|
-endNetworkEntry :: IO ()
|
||||||
-endNetworkEntry = withLock $ c_endnetent
|
-endNetworkEntry = withLock $ trySysCall $ c_endnetent
|
||||||
-
|
-
|
||||||
-foreign import ccall unsafe "endnetent" c_endnetent :: IO ()
|
-foreign import ccall unsafe "endnetent" c_endnetent :: IO ()
|
||||||
-
|
-
|
||||||
|
@ -149,11 +149,9 @@ index b5e9a26..f085f2a 100644
|
||||||
-getNetworkEntries stayOpen = do
|
-getNetworkEntries stayOpen = do
|
||||||
- setNetworkEntry stayOpen
|
- setNetworkEntry stayOpen
|
||||||
- getEntries (getNetworkEntry) (endNetworkEntry)
|
- getEntries (getNetworkEntry) (endNetworkEntry)
|
||||||
-#endif
|
#endif
|
||||||
-
|
|
||||||
-- ---------------------------------------------------------------------------
|
|
||||||
-- Interface names
|
|
||||||
|
|
||||||
|
-- Mutex for name service lockdown
|
||||||
--
|
--
|
||||||
2.1.4
|
1.7.10.4
|
||||||
|
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] avoid accept4
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -8,19 +8,19 @@ Subject: [PATCH] avoid accept4
|
||||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||||
|
|
||||||
diff --git a/Network/Socket.hsc b/Network/Socket.hsc
|
diff --git a/Network/Socket.hsc b/Network/Socket.hsc
|
||||||
index 6553bfc..802a7e9 100644
|
index 2fe62ee..94db7a4 100644
|
||||||
--- a/Network/Socket.hsc
|
--- a/Network/Socket.hsc
|
||||||
+++ b/Network/Socket.hsc
|
+++ b/Network/Socket.hsc
|
||||||
@@ -489,7 +489,7 @@ accept sock@(MkSocket s family stype protocol status) = do
|
@@ -511,7 +511,7 @@ accept sock@(MkSocket s family stype protocol status) = do
|
||||||
return new_sock
|
|
||||||
#else
|
#else
|
||||||
with (fromIntegral sz) $ \ ptr_len -> do
|
with (fromIntegral sz) $ \ ptr_len -> do
|
||||||
|
new_sock <-
|
||||||
-# ifdef HAVE_ACCEPT4
|
-# ifdef HAVE_ACCEPT4
|
||||||
+#if 0
|
+#if 0
|
||||||
new_sock <- throwSocketErrorIfMinus1RetryMayBlock "accept"
|
throwSocketErrorIfMinus1RetryMayBlock "accept"
|
||||||
(threadWaitRead (fromIntegral s))
|
(threadWaitRead (fromIntegral s))
|
||||||
(c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK))
|
(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
|
c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt
|
||||||
foreign import CALLCONV unsafe "accept"
|
foreign import CALLCONV unsafe "accept"
|
||||||
c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt
|
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
|
c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt
|
||||||
#endif
|
#endif
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] hack for bionic
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -9,10 +9,10 @@ Subject: [PATCH] hack for bionic
|
||||||
2 files changed, 1 insertion(+), 13 deletions(-)
|
2 files changed, 1 insertion(+), 13 deletions(-)
|
||||||
|
|
||||||
diff --git a/Data/UnixTime/Types.hsc b/Data/UnixTime/Types.hsc
|
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
|
--- a/Data/UnixTime/Types.hsc
|
||||||
+++ b/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>
|
#include <sys/time.h>
|
||||||
|
|
||||||
|
@ -20,8 +20,8 @@ index 6253b27..fb5b3fa 100644
|
||||||
-
|
-
|
||||||
-- |
|
-- |
|
||||||
-- Data structure for Unix time.
|
-- Data structure for Unix time.
|
||||||
--
|
data UnixTime = UnixTime {
|
||||||
@@ -33,16 +31,6 @@ data UnixTime = UnixTime {
|
@@ -20,16 +18,6 @@ data UnixTime = UnixTime {
|
||||||
, utMicroSeconds :: {-# UNPACK #-} !Int32
|
, utMicroSeconds :: {-# UNPACK #-} !Int32
|
||||||
} deriving (Eq,Ord,Show)
|
} deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
|
@ -35,14 +35,14 @@ index 6253b27..fb5b3fa 100644
|
||||||
- (#poke struct timeval, tv_sec) ptr (utSeconds ut)
|
- (#poke struct timeval, tv_sec) ptr (utSeconds ut)
|
||||||
- (#poke struct timeval, tv_usec) ptr (utMicroSeconds ut)
|
- (#poke struct timeval, tv_usec) ptr (utMicroSeconds ut)
|
||||||
-
|
-
|
||||||
#if __GLASGOW_HASKELL__ >= 704
|
-- |
|
||||||
instance Binary UnixTime where
|
-- Format of the strptime()/strftime() style.
|
||||||
put (UnixTime (CTime sec) msec) = do
|
type Format = ByteString
|
||||||
diff --git a/cbits/conv.c b/cbits/conv.c
|
diff --git a/cbits/conv.c b/cbits/conv.c
|
||||||
index 669cfda..8fa5f9a 100644
|
index ec31fef..b7bc0f9 100644
|
||||||
--- a/cbits/conv.c
|
--- a/cbits/conv.c
|
||||||
+++ b/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
|
#else
|
||||||
strptime(src, fmt, &dst);
|
strptime(src, fmt, &dst);
|
||||||
#endif
|
#endif
|
||||||
|
@ -52,5 +52,5 @@ index 669cfda..8fa5f9a 100644
|
||||||
|
|
||||||
size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
|
size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
|
@ -1,15 +1,16 @@
|
||||||
From 04a1230cf4d740d37ab427165eef4b4db2a3898f Mon Sep 17 00:00:00 2001
|
From 87283f9b6f992a7f0e36c7b1bafc288bf2bf106a Mon Sep 17 00:00:00 2001
|
||||||
From: dummy <dummy@example.com>
|
From: androidbuilder <androidbuilder@example.com>
|
||||||
Date: Fri, 3 Jul 2015 02:20:42 +0000
|
Date: Mon, 11 Nov 2013 02:46:27 +0000
|
||||||
Subject: [PATCH] build without v1 uuid which needs network-info
|
Subject: [PATCH] build without v1 uuid which needs network-ino
|
||||||
|
|
||||||
---
|
---
|
||||||
Data/UUID/Util.hs | 11 -----------
|
Data/UUID/Util.hs | 11 -----------
|
||||||
uuid.cabal | 2 --
|
Data/UUID/V1.hs | 2 --
|
||||||
2 files changed, 13 deletions(-)
|
uuid.cabal | 2 --
|
||||||
|
3 files changed, 15 deletions(-)
|
||||||
|
|
||||||
diff --git a/Data/UUID/Util.hs b/Data/UUID/Util.hs
|
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
|
--- a/Data/UUID/Util.hs
|
||||||
+++ b/Data/UUID/Util.hs
|
+++ b/Data/UUID/Util.hs
|
||||||
@@ -3,7 +3,6 @@ module Data.UUID.Util (
|
@@ -3,7 +3,6 @@ module Data.UUID.Util (
|
||||||
|
@ -23,37 +24,49 @@ index 8817f51..0d43b01 100644
|
||||||
@@ -13,7 +12,6 @@ import Data.Word
|
@@ -13,7 +12,6 @@ import Data.Word
|
||||||
import Data.Word.Util
|
import Data.Word.Util
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
import Data.UUID.Types.Internal
|
import Data.UUID.Internal
|
||||||
-import Network.Info
|
-import Network.Info
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
|
|
||||||
version :: UUID -> Int
|
version :: UUID -> Int
|
||||||
@@ -42,12 +40,3 @@ extractTime uuid =
|
@@ -43,12 +41,3 @@ extractTime uuid =
|
||||||
|
|
||||||
timeAndVersionToTime :: Word16 -> Word16
|
timeAndVersionToTime :: Word16 -> Word16
|
||||||
timeAndVersionToTime tv = tv .&. 0x0FFF
|
timeAndVersionToTime tv = tv .&. 0x0FFF
|
||||||
-
|
|
||||||
-extractMac :: UUID -> Maybe MAC
|
-extractMac :: UUID -> Maybe MAC
|
||||||
-extractMac uuid =
|
-extractMac uuid =
|
||||||
- if version uuid == 1
|
- 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)
|
- MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)
|
||||||
- else Nothing
|
- else Nothing
|
||||||
- where
|
- where
|
||||||
- unpacked = unpack uuid
|
- 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
|
diff --git a/uuid.cabal b/uuid.cabal
|
||||||
index 2fa548b..9d86fd2 100644
|
index 0a53059..57b1b86 100644
|
||||||
--- a/uuid.cabal
|
--- a/uuid.cabal
|
||||||
+++ b/uuid.cabal
|
+++ b/uuid.cabal
|
||||||
@@ -30,7 +30,6 @@ Library
|
@@ -32,14 +32,12 @@ Library
|
||||||
binary >= 0.4 && < 0.8,
|
|
||||||
bytestring >= 0.9 && < 0.11,
|
|
||||||
cryptohash >= 0.7 && < 0.12,
|
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.*,
|
- network-info == 0.2.*,
|
||||||
random >= 1.0.1 && < 1.2,
|
random >= 1.0.1 && < 1.1,
|
||||||
time >= 1.1 && < 1.6,
|
time >= 1.1 && < 1.5
|
||||||
uuid-types >= 1.0 && < 2
|
|
||||||
@@ -38,7 +37,6 @@ Library
|
|
||||||
Exposed-Modules:
|
Exposed-Modules:
|
||||||
Data.UUID
|
Data.UUID
|
||||||
Data.UUID.Util
|
Data.UUID.Util
|
||||||
|
@ -62,5 +75,5 @@ index 2fa548b..9d86fd2 100644
|
||||||
Data.UUID.V4
|
Data.UUID.V4
|
||||||
Data.UUID.V5
|
Data.UUID.V5
|
||||||
--
|
--
|
||||||
2.1.4
|
1.7.10.4
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -55,7 +55,7 @@ patched () {
|
||||||
if [ -e config.guess ]; then
|
if [ -e config.guess ]; then
|
||||||
cp /usr/share/misc/config.guess .
|
cp /usr/share/misc/config.guess .
|
||||||
fi
|
fi
|
||||||
cabal install # --reinstall --force-reinstalls
|
cabal install # --force-reinstalls --reinstall
|
||||||
rm -f cabal.config
|
rm -f cabal.config
|
||||||
|
|
||||||
rm -rf $pkg*
|
rm -rf $pkg*
|
||||||
|
@ -65,7 +65,7 @@ patched () {
|
||||||
installgitannexdeps () {
|
installgitannexdeps () {
|
||||||
pushd ../..
|
pushd ../..
|
||||||
ln -sf standalone/android/cabal.config
|
ln -sf standalone/android/cabal.config
|
||||||
cabal install --only-dependencies "$@"
|
cabal install --only-dependencies "$@" # --force-reinstalls --reinstall
|
||||||
rm -f cabal.config
|
rm -f cabal.config
|
||||||
popd
|
popd
|
||||||
}
|
}
|
||||||
|
@ -86,9 +86,9 @@ EOF
|
||||||
patched iproute
|
patched iproute
|
||||||
patched primitive
|
patched primitive
|
||||||
patched socks
|
patched socks
|
||||||
patched entropy
|
|
||||||
patched vector
|
patched vector
|
||||||
patched stm-chans
|
patched stm-chans
|
||||||
|
patched persistent
|
||||||
patched profunctors
|
patched profunctors
|
||||||
patched skein
|
patched skein
|
||||||
patched lens
|
patched lens
|
||||||
|
@ -97,32 +97,35 @@ EOF
|
||||||
patched persistent-template
|
patched persistent-template
|
||||||
patched system-filepath
|
patched system-filepath
|
||||||
patched optparse-applicative
|
patched optparse-applicative
|
||||||
patched warp
|
|
||||||
patched wai-app-static
|
patched wai-app-static
|
||||||
|
patched yesod-routes
|
||||||
patched shakespeare
|
patched shakespeare
|
||||||
patched yesod-core
|
patched yesod-core
|
||||||
|
patched yesod-persistent
|
||||||
patched yesod-form
|
patched yesod-form
|
||||||
|
patched crypto-numbers
|
||||||
patched clock
|
patched clock
|
||||||
patched yesod-auth
|
patched yesod-auth
|
||||||
patched yesod
|
patched yesod
|
||||||
patched process-conduit
|
patched process-conduit
|
||||||
patched DAV
|
patched DAV
|
||||||
patched yesod-static
|
patched yesod-static
|
||||||
patched uuid
|
|
||||||
patched dns
|
patched dns
|
||||||
patched gnutls
|
patched gnutls
|
||||||
patched unbounded-delays
|
patched unbounded-delays
|
||||||
|
patched gnuidn
|
||||||
patched network-protocol-xmpp
|
patched network-protocol-xmpp
|
||||||
|
patched uuid
|
||||||
|
|
||||||
cd ..
|
cd ..
|
||||||
|
|
||||||
installgitannexdeps -fAndroid -f-Pairing
|
installgitannexdeps -fAndroid -f-Pairing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cabal update
|
||||||
setupcabal
|
setupcabal
|
||||||
|
|
||||||
# Install packages for host ghc.
|
# Install packages for host ghc.
|
||||||
cabal update
|
|
||||||
installgitannexdeps
|
installgitannexdeps
|
||||||
|
|
||||||
# Install packages for cross ghc, with patches as necessary.
|
# Install packages for cross ghc, with patches as necessary.
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] remove TH
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -10,7 +10,7 @@ Subject: [PATCH] remove TH
|
||||||
3 files changed, 306 insertions(+), 46 deletions(-)
|
3 files changed, 306 insertions(+), 46 deletions(-)
|
||||||
|
|
||||||
diff --git a/DAV.cabal b/DAV.cabal
|
diff --git a/DAV.cabal b/DAV.cabal
|
||||||
index f78c2e5..1ec4d80 100644
|
index 95fffd8..5669c51 100644
|
||||||
--- a/DAV.cabal
|
--- a/DAV.cabal
|
||||||
+++ b/DAV.cabal
|
+++ b/DAV.cabal
|
||||||
@@ -47,33 +47,7 @@ library
|
@@ -47,33 +47,7 @@ library
|
||||||
|
@ -27,7 +27,7 @@ index f78c2e5..1ec4d80 100644
|
||||||
- , containers
|
- , containers
|
||||||
- , data-default
|
- , data-default
|
||||||
- , either >= 4.3
|
- , either >= 4.3
|
||||||
- , errors < 2.0
|
- , errors
|
||||||
- , exceptions
|
- , exceptions
|
||||||
- , http-client >= 0.2
|
- , http-client >= 0.2
|
||||||
- , http-client-tls >= 0.2
|
- , http-client-tls >= 0.2
|
||||||
|
@ -49,7 +49,7 @@ index f78c2e5..1ec4d80 100644
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
|
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
|
--- a/Network/Protocol/HTTP/DAV.hs
|
||||||
+++ b/Network/Protocol/HTTP/DAV.hs
|
+++ b/Network/Protocol/HTTP/DAV.hs
|
||||||
@@ -82,6 +82,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho
|
@@ -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))
|
+ Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg))
|
||||||
+{-# INLINE userAgent #-}
|
+{-# INLINE userAgent #-}
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
40
standalone/no-th/haskell-patches/aeson_remove-TH.patch
Normal file
40
standalone/no-th/haskell-patches/aeson_remove-TH.patch
Normal 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
132
standalone/no-th/haskell-patches/file-embed_remove-TH.patch
Normal 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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>
|
From: dummy <dummy@example.com>
|
||||||
Date: Fri, 3 Jul 2015 02:06:43 +0000
|
Date: Thu, 16 Oct 2014 01:43:10 +0000
|
||||||
Subject: [PATCH] remove TH
|
Subject: [PATCH] avoid TH
|
||||||
|
|
||||||
---
|
---
|
||||||
lens.cabal | 16 +---------------
|
lens.cabal | 17 +----------------
|
||||||
src/Control/Lens.hs | 6 ++----
|
src/Control/Lens.hs | 8 ++------
|
||||||
src/Control/Lens/Cons.hs | 2 --
|
src/Control/Lens/Cons.hs | 2 --
|
||||||
src/Control/Lens/Internal/Fold.hs | 2 --
|
src/Control/Lens/Internal/Fold.hs | 2 --
|
||||||
src/Control/Lens/Operators.hs | 2 +-
|
src/Control/Lens/Operators.hs | 2 +-
|
||||||
src/Control/Lens/Prism.hs | 2 --
|
src/Control/Lens/Prism.hs | 2 --
|
||||||
src/Control/Monad/Primitive/Lens.hs | 1 -
|
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
|
diff --git a/lens.cabal b/lens.cabal
|
||||||
index c7f6009..ab206c5 100644
|
index 5388301..d7b02b9 100644
|
||||||
--- a/lens.cabal
|
--- a/lens.cabal
|
||||||
+++ b/lens.cabal
|
+++ b/lens.cabal
|
||||||
@@ -10,7 +10,7 @@ stability: provisional
|
@@ -10,7 +10,7 @@ stability: provisional
|
||||||
|
@ -26,7 +26,15 @@ index c7f6009..ab206c5 100644
|
||||||
-- build-tools: cpphs
|
-- 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
|
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
|
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.Context
|
||||||
Control.Lens.Internal.Deque
|
Control.Lens.Internal.Deque
|
||||||
Control.Lens.Internal.Exception
|
Control.Lens.Internal.Exception
|
||||||
|
@ -35,7 +43,7 @@ index c7f6009..ab206c5 100644
|
||||||
Control.Lens.Internal.Fold
|
Control.Lens.Internal.Fold
|
||||||
Control.Lens.Internal.Getter
|
Control.Lens.Internal.Getter
|
||||||
Control.Lens.Internal.Indexed
|
Control.Lens.Internal.Indexed
|
||||||
@@ -243,25 +241,21 @@ library
|
@@ -247,25 +244,21 @@ library
|
||||||
Control.Lens.Internal.Reflection
|
Control.Lens.Internal.Reflection
|
||||||
Control.Lens.Internal.Review
|
Control.Lens.Internal.Review
|
||||||
Control.Lens.Internal.Setter
|
Control.Lens.Internal.Setter
|
||||||
|
@ -61,7 +69,7 @@ index c7f6009..ab206c5 100644
|
||||||
Control.Monad.Primitive.Lens
|
Control.Monad.Primitive.Lens
|
||||||
Control.Parallel.Strategies.Lens
|
Control.Parallel.Strategies.Lens
|
||||||
Control.Seq.Lens
|
Control.Seq.Lens
|
||||||
@@ -287,12 +281,8 @@ library
|
@@ -291,12 +284,8 @@ library
|
||||||
Data.Typeable.Lens
|
Data.Typeable.Lens
|
||||||
Data.Vector.Lens
|
Data.Vector.Lens
|
||||||
Data.Vector.Generic.Lens
|
Data.Vector.Generic.Lens
|
||||||
|
@ -74,7 +82,7 @@ index c7f6009..ab206c5 100644
|
||||||
Numeric.Lens
|
Numeric.Lens
|
||||||
|
|
||||||
other-modules:
|
other-modules:
|
||||||
@@ -395,7 +385,6 @@ test-suite doctests
|
@@ -403,7 +392,6 @@ test-suite doctests
|
||||||
deepseq,
|
deepseq,
|
||||||
doctest >= 0.9.1,
|
doctest >= 0.9.1,
|
||||||
filepath,
|
filepath,
|
||||||
|
@ -82,7 +90,7 @@ index c7f6009..ab206c5 100644
|
||||||
mtl,
|
mtl,
|
||||||
nats,
|
nats,
|
||||||
parallel,
|
parallel,
|
||||||
@@ -433,7 +422,6 @@ benchmark plated
|
@@ -441,7 +429,6 @@ benchmark plated
|
||||||
comonad,
|
comonad,
|
||||||
criterion,
|
criterion,
|
||||||
deepseq,
|
deepseq,
|
||||||
|
@ -90,7 +98,7 @@ index c7f6009..ab206c5 100644
|
||||||
lens,
|
lens,
|
||||||
transformers
|
transformers
|
||||||
|
|
||||||
@@ -468,7 +456,6 @@ benchmark unsafe
|
@@ -476,7 +463,6 @@ benchmark unsafe
|
||||||
comonads-fd,
|
comonads-fd,
|
||||||
criterion,
|
criterion,
|
||||||
deepseq,
|
deepseq,
|
||||||
|
@ -98,7 +106,7 @@ index c7f6009..ab206c5 100644
|
||||||
lens,
|
lens,
|
||||||
transformers
|
transformers
|
||||||
|
|
||||||
@@ -485,6 +472,5 @@ benchmark zipper
|
@@ -493,6 +479,5 @@ benchmark zipper
|
||||||
comonads-fd,
|
comonads-fd,
|
||||||
criterion,
|
criterion,
|
||||||
deepseq,
|
deepseq,
|
||||||
|
@ -106,10 +114,18 @@ index c7f6009..ab206c5 100644
|
||||||
lens,
|
lens,
|
||||||
transformers
|
transformers
|
||||||
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
|
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
|
--- a/src/Control/Lens.hs
|
||||||
+++ b/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.Lens
|
||||||
, module Control.Lens.Level
|
, module Control.Lens.Level
|
||||||
, module Control.Lens.Loupe
|
, module Control.Lens.Loupe
|
||||||
|
@ -123,7 +139,15 @@ index d879c58..3d6015b 100644
|
||||||
, module Control.Lens.TH
|
, module Control.Lens.TH
|
||||||
#endif
|
#endif
|
||||||
, module Control.Lens.Traversal
|
, 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.Lens
|
||||||
import Control.Lens.Level
|
import Control.Lens.Level
|
||||||
import Control.Lens.Loupe
|
import Control.Lens.Loupe
|
||||||
|
@ -138,12 +162,12 @@ index d879c58..3d6015b 100644
|
||||||
#endif
|
#endif
|
||||||
import Control.Lens.Traversal
|
import Control.Lens.Traversal
|
||||||
diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs
|
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
|
--- a/src/Control/Lens/Cons.hs
|
||||||
+++ b/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 Data.Word
|
||||||
import Prelude
|
|
||||||
|
|
||||||
-{-# ANN module "HLint: ignore Eta reduce" #-}
|
-{-# ANN module "HLint: ignore Eta reduce" #-}
|
||||||
-
|
-
|
||||||
|
@ -151,12 +175,12 @@ index 7b35db4..269f307 100644
|
||||||
-- >>> :set -XNoOverloadedStrings
|
-- >>> :set -XNoOverloadedStrings
|
||||||
-- >>> import Control.Lens
|
-- >>> import Control.Lens
|
||||||
diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs
|
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
|
--- a/src/Control/Lens/Internal/Fold.hs
|
||||||
+++ b/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 Data.Reflection
|
||||||
import Prelude
|
|
||||||
|
|
||||||
-{-# ANN module "HLint: ignore Avoid lambda" #-}
|
-{-# ANN module "HLint: ignore Avoid lambda" #-}
|
||||||
-
|
-
|
||||||
|
@ -164,10 +188,10 @@ index 4bbde21..16295f4 100644
|
||||||
-- Folding
|
-- Folding
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
|
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
|
--- a/src/Control/Lens/Operators.hs
|
||||||
+++ b/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"
|
-- * "Control.Lens.Plated"
|
||||||
|
@ -177,12 +201,12 @@ index 302f68e..1625fe5 100644
|
||||||
, ( # )
|
, ( # )
|
||||||
-- * "Control.Lens.Setter"
|
-- * "Control.Lens.Setter"
|
||||||
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
|
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
|
--- a/src/Control/Lens/Prism.hs
|
||||||
+++ b/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
|
#endif
|
||||||
import Prelude
|
|
||||||
|
|
||||||
-{-# ANN module "HLint: ignore Use camelCase" #-}
|
-{-# ANN module "HLint: ignore Use camelCase" #-}
|
||||||
-
|
-
|
||||||
|
@ -190,17 +214,17 @@ index 36152d6..3af6bd3 100644
|
||||||
-- >>> :set -XNoOverloadedStrings
|
-- >>> :set -XNoOverloadedStrings
|
||||||
-- >>> import Control.Lens
|
-- >>> import Control.Lens
|
||||||
diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs
|
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
|
--- a/src/Control/Monad/Primitive/Lens.hs
|
||||||
+++ b/src/Control/Monad/Primitive/Lens.hs
|
+++ b/src/Control/Monad/Primitive/Lens.hs
|
||||||
@@ -26,7 +26,6 @@ import Control.Lens
|
@@ -20,7 +20,6 @@ import Control.Lens
|
||||||
import Control.Monad.Primitive
|
import Control.Monad.Primitive (PrimMonad(..))
|
||||||
import GHC.Prim (State#)
|
import GHC.Prim (State#)
|
||||||
|
|
||||||
-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
|
-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
|
||||||
|
|
||||||
#if MIN_VERSION_primitive(0,6,0)
|
prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
|
||||||
prim :: PrimBase m => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
|
prim = iso internal primitive
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
|
@ -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,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
|
||||||
|
|
59
standalone/no-th/haskell-patches/reflection_remove-TH.patch
Normal file
59
standalone/no-th/haskell-patches/reflection_remove-TH.patch
Normal 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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>
|
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
|
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 ----
|
Network/Wai/Application/Static.hs | 4 ----
|
||||||
WaiAppStatic/Storage/Embedded.hs | 8 ++++----
|
WaiAppStatic/Storage/Embedded.hs | 8 ++++----
|
||||||
|
@ -10,10 +14,10 @@ Subject: [PATCH] deal with TH
|
||||||
3 files changed, 5 insertions(+), 11 deletions(-)
|
3 files changed, 5 insertions(+), 11 deletions(-)
|
||||||
|
|
||||||
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
|
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
|
--- a/Network/Wai/Application/Static.hs
|
||||||
+++ b/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)
|
import Blaze.ByteString.Builder (toByteString)
|
||||||
|
|
||||||
|
@ -22,10 +26,10 @@ index 228582d..7d72bb0 100644
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
@@ -218,8 +216,6 @@ staticAppPieces _ _ req sendResponse
|
@@ -198,8 +196,6 @@ staticAppPieces _ _ req sendResponse
|
||||||
H.status405
|
H.status405
|
||||||
[("Content-Type", "text/plain")]
|
[("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", "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 _ [".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
|
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
|
||||||
+--import WaiAppStatic.Storage.Embedded.TH
|
+--import WaiAppStatic.Storage.Embedded.TH
|
||||||
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
|
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
|
--- a/wai-app-static.cabal
|
||||||
+++ b/wai-app-static.cabal
|
+++ b/wai-app-static.cabal
|
||||||
@@ -35,7 +35,6 @@ library
|
@@ -33,7 +33,6 @@ library
|
||||||
, containers >= 0.2
|
, containers >= 0.2
|
||||||
, time >= 1.1.4
|
, time >= 1.1.4
|
||||||
, old-locale >= 1.0.0.2
|
, old-locale >= 1.0.0.2
|
||||||
|
@ -62,7 +66,7 @@ index 4cca237..3fbfcee 100644
|
||||||
, text >= 0.7
|
, text >= 0.7
|
||||||
, blaze-builder >= 0.2.1.4
|
, blaze-builder >= 0.2.1.4
|
||||||
, base64-bytestring >= 0.1
|
, base64-bytestring >= 0.1
|
||||||
@@ -63,9 +62,8 @@ library
|
@@ -61,9 +60,8 @@ library
|
||||||
WaiAppStatic.Listing
|
WaiAppStatic.Listing
|
||||||
WaiAppStatic.Types
|
WaiAppStatic.Types
|
||||||
WaiAppStatic.CmdLine
|
WaiAppStatic.CmdLine
|
||||||
|
@ -74,5 +78,5 @@ index 4cca237..3fbfcee 100644
|
||||||
extensions: CPP
|
extensions: CPP
|
||||||
|
|
||||||
--
|
--
|
||||||
2.1.4
|
2.0.0
|
||||||
|
|
||||||
|
|
108
standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
Normal file
108
standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
Normal 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
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] hack TH
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -15,7 +15,7 @@ Subject: [PATCH] hack TH
|
||||||
8 files changed, 213 insertions(+), 288 deletions(-)
|
8 files changed, 213 insertions(+), 288 deletions(-)
|
||||||
|
|
||||||
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
|
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
|
||||||
index f7436e6..2fa62cc 100644
|
index 9b29317..7c0792d 100644
|
||||||
--- a/Yesod/Core.hs
|
--- a/Yesod/Core.hs
|
||||||
+++ b/Yesod/Core.hs
|
+++ b/Yesod/Core.hs
|
||||||
@@ -31,16 +31,16 @@ module Yesod.Core
|
@@ -31,16 +31,16 @@ module Yesod.Core
|
||||||
|
@ -45,7 +45,7 @@ index f7436e6..2fa62cc 100644
|
||||||
-- * Sessions
|
-- * Sessions
|
||||||
, SessionBackend (..)
|
, SessionBackend (..)
|
||||||
, customizeSessionCookies
|
, customizeSessionCookies
|
||||||
@@ -90,17 +90,15 @@ module Yesod.Core
|
@@ -87,17 +87,15 @@ module Yesod.Core
|
||||||
, readIntegral
|
, readIntegral
|
||||||
-- * Shakespeare
|
-- * Shakespeare
|
||||||
-- ** Hamlet
|
-- ** Hamlet
|
||||||
|
@ -68,10 +68,10 @@ index f7436e6..2fa62cc 100644
|
||||||
, renderCssUrl
|
, renderCssUrl
|
||||||
) where
|
) where
|
||||||
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
|
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
|
--- a/Yesod/Core/Class/Yesod.hs
|
||||||
+++ b/Yesod/Core/Class/Yesod.hs
|
+++ b/Yesod/Core/Class/Yesod.hs
|
||||||
@@ -5,11 +5,15 @@
|
@@ -5,18 +5,22 @@
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
module Yesod.Core.Class.Yesod where
|
module Yesod.Core.Class.Yesod where
|
||||||
|
|
||||||
|
@ -88,16 +88,15 @@ index c2e707a..b594353 100644
|
||||||
|
|
||||||
import Blaze.ByteString.Builder (Builder)
|
import Blaze.ByteString.Builder (Builder)
|
||||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
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 (forM, when, void)
|
||||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||||
import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
|
-import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
|
||||||
- LogSource)
|
+import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther),
|
||||||
+ LogSource, Loc)
|
LogSource)
|
||||||
import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState)
|
|
||||||
import qualified Data.ByteString.Char8 as S8
|
import qualified Data.ByteString.Char8 as S8
|
||||||
import qualified Data.ByteString.Lazy as L
|
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.Builder (toLazyText)
|
||||||
import Data.Text.Lazy.Encoding (encodeUtf8)
|
import Data.Text.Lazy.Encoding (encodeUtf8)
|
||||||
import Data.Word (Word64)
|
import Data.Word (Word64)
|
||||||
|
@ -105,7 +104,7 @@ index c2e707a..b594353 100644
|
||||||
import Network.HTTP.Types (encodePath)
|
import Network.HTTP.Types (encodePath)
|
||||||
import qualified Network.Wai as W
|
import qualified Network.Wai as W
|
||||||
import Data.Default (def)
|
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
|
defaultLayout w = do
|
||||||
p <- widgetToPageContent w
|
p <- widgetToPageContent w
|
||||||
mmsg <- getMessage
|
mmsg <- getMessage
|
||||||
|
@ -144,7 +143,7 @@ index c2e707a..b594353 100644
|
||||||
|
|
||||||
-- | Override the rendering function for a particular URL. One use case for
|
-- | 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
|
-- 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
|
-- 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
|
-- 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
|
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||||
|
@ -287,7 +286,7 @@ index c2e707a..b594353 100644
|
||||||
|
|
||||||
return $ PageContent title headAll $
|
return $ PageContent title headAll $
|
||||||
case jsLoader master of
|
case jsLoader master of
|
||||||
@@ -478,10 +547,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||||
r <- waiRequest
|
r <- waiRequest
|
||||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||||
setTitle "Not Found"
|
setTitle "Not Found"
|
||||||
|
@ -305,7 +304,7 @@ index c2e707a..b594353 100644
|
||||||
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
|
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
|
||||||
|
|
||||||
-- For API requests.
|
-- For API requests.
|
||||||
@@ -491,10 +563,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||||
defaultErrorHandler NotAuthenticated = selectRep $ do
|
defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||||
provideRep $ defaultLayout $ do
|
provideRep $ defaultLayout $ do
|
||||||
setTitle "Not logged in"
|
setTitle "Not logged in"
|
||||||
|
@ -321,7 +320,7 @@ index c2e707a..b594353 100644
|
||||||
|
|
||||||
provideRep $ do
|
provideRep $ do
|
||||||
-- 401 *MUST* include a WWW-Authenticate header
|
-- 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
|
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||||
provideRep $ defaultLayout $ do
|
provideRep $ defaultLayout $ do
|
||||||
setTitle "Permission Denied"
|
setTitle "Permission Denied"
|
||||||
|
@ -339,7 +338,7 @@ index c2e707a..b594353 100644
|
||||||
provideRep $
|
provideRep $
|
||||||
return $ object $ [
|
return $ object $ [
|
||||||
"message" .= ("Permission Denied. " <> msg)
|
"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
|
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
|
||||||
provideRep $ defaultLayout $ do
|
provideRep $ defaultLayout $ do
|
||||||
setTitle "Invalid Arguments"
|
setTitle "Invalid Arguments"
|
||||||
|
@ -397,7 +396,7 @@ index c2e707a..b594353 100644
|
||||||
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
|
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
|
||||||
|
|
||||||
asyncHelper :: (url -> [x] -> Text)
|
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
|
-- turn the TH Loc loaction information into a human readable string
|
||||||
-- leaving out the loc_end parameter
|
-- leaving out the loc_end parameter
|
||||||
fileLocationToString :: Loc -> String
|
fileLocationToString :: Loc -> String
|
||||||
|
@ -408,7 +407,7 @@ index c2e707a..b594353 100644
|
||||||
- char = show . snd . loc_start
|
- char = show . snd . loc_start
|
||||||
+fileLocationToString loc = "unknown"
|
+fileLocationToString loc = "unknown"
|
||||||
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
|
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
|
--- a/Yesod/Core/Dispatch.hs
|
||||||
+++ b/Yesod/Core/Dispatch.hs
|
+++ b/Yesod/Core/Dispatch.hs
|
||||||
@@ -1,4 +1,3 @@
|
@@ -1,4 +1,3 @@
|
||||||
|
@ -445,9 +444,9 @@ index 7e43f74..625a901 100644
|
||||||
, PathMultiPiece (..)
|
, PathMultiPiece (..)
|
||||||
, Texts
|
, Texts
|
||||||
-- * Convert to WAI
|
-- * Convert to WAI
|
||||||
@@ -141,13 +140,6 @@ toWaiAppLogger logger site = do
|
@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do
|
||||||
|
, yreSite = site
|
||||||
, yreSessionBackend = sb
|
, yreSessionBackend = sb
|
||||||
, yreGen = gen
|
|
||||||
}
|
}
|
||||||
- messageLoggerSource
|
- messageLoggerSource
|
||||||
- site
|
- site
|
||||||
|
@ -459,10 +458,10 @@ index 7e43f74..625a901 100644
|
||||||
middleware <- mkDefaultMiddlewares logger
|
middleware <- mkDefaultMiddlewares logger
|
||||||
return $ middleware $ toWaiAppYre yre
|
return $ middleware $ toWaiAppYre yre
|
||||||
|
|
||||||
@@ -167,14 +159,7 @@ warp port site = do
|
@@ -170,14 +162,7 @@ warp port site = do
|
||||||
Network.Wai.Handler.Warp.setPort port $
|
]
|
||||||
Network.Wai.Handler.Warp.setServerName serverValue $
|
-}
|
||||||
Network.Wai.Handler.Warp.setOnException (\_ e ->
|
, Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
|
||||||
- when (shouldLog' e) $
|
- when (shouldLog' e) $
|
||||||
- messageLoggerSource
|
- messageLoggerSource
|
||||||
- site
|
- site
|
||||||
|
@ -470,12 +469,12 @@ index 7e43f74..625a901 100644
|
||||||
- $(qLocation >>= liftLoc)
|
- $(qLocation >>= liftLoc)
|
||||||
- "yesod-core"
|
- "yesod-core"
|
||||||
- LevelError
|
- LevelError
|
||||||
- (toLogStr $ "Exception from Warp: " ++ show e)) $
|
- (toLogStr $ "Exception from Warp: " ++ show e)
|
||||||
+ when (shouldLog' e) $ error (show e)) $
|
+ when (shouldLog' e) $ error (show e)
|
||||||
Network.Wai.Handler.Warp.defaultSettings)
|
}
|
||||||
where
|
where
|
||||||
shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException
|
shouldLog' =
|
||||||
@@ -208,7 +193,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
|
@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
|
||||||
-- | Deprecated synonym for 'warp'.
|
-- | Deprecated synonym for 'warp'.
|
||||||
warpDebug :: YesodDispatch site => Int -> site -> IO ()
|
warpDebug :: YesodDispatch site => Int -> site -> IO ()
|
||||||
warpDebug = warp
|
warpDebug = warp
|
||||||
|
@ -484,10 +483,10 @@ index 7e43f74..625a901 100644
|
||||||
-- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It
|
-- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It
|
||||||
-- reads port information from the PORT environment variable, as used by tools
|
-- reads port information from the PORT environment variable, as used by tools
|
||||||
diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
|
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
|
--- a/Yesod/Core/Handler.hs
|
||||||
+++ b/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 Data.Text.Encoding.Error (lenientDecode)
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
import qualified Text.Blaze.Html.Renderer.Text as RenderText
|
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 as S
|
||||||
import qualified Data.ByteString.Lazy as L
|
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 Blaze.ByteString.Builder (Builder)
|
||||||
import Safe (headMay)
|
import Safe (headMay)
|
||||||
import Data.CaseInsensitive (CI)
|
import Data.CaseInsensitive (CI)
|
||||||
|
@ -504,7 +503,7 @@ index 19f4152..c97fb24 100644
|
||||||
import qualified Data.Conduit.List as CL
|
import qualified Data.Conduit.List as CL
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
|
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
|
-> m a
|
||||||
redirectToPost url = do
|
redirectToPost url = do
|
||||||
urlText <- toTextUrl url
|
urlText <- toTextUrl url
|
||||||
|
@ -534,7 +533,7 @@ index 19f4152..c97fb24 100644
|
||||||
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
|
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
|
||||||
hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
|
hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
|
||||||
diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs
|
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
|
--- a/Yesod/Core/Internal/Run.hs
|
||||||
+++ b/Yesod/Core/Internal/Run.hs
|
+++ b/Yesod/Core/Internal/Run.hs
|
||||||
@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch)
|
@@ -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 (LogLevel (LevelError), LogSource,
|
||||||
+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource,
|
+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource,
|
||||||
liftLoc)
|
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
|
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 (decodeUtf8With)
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
import Data.Time (getCurrentTime, addUTCTime)
|
|
||||||
-import Language.Haskell.TH.Syntax (Loc, qLocation)
|
-import Language.Haskell.TH.Syntax (Loc, qLocation)
|
||||||
+import Language.Haskell.TH.Syntax (qLocation)
|
+import Language.Haskell.TH.Syntax (qLocation)
|
||||||
import qualified Network.HTTP.Types as H
|
import qualified Network.HTTP.Types as H
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
import Network.Wai.Internal
|
#if MIN_VERSION_wai(2, 0, 0)
|
||||||
@@ -160,8 +160,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||||
-> ErrorResponse
|
-> ErrorResponse
|
||||||
-> YesodApp
|
-> YesodApp
|
||||||
safeEh log' er req = do
|
safeEh log' er req = do
|
||||||
|
@ -684,26 +683,26 @@ index 7e84c1c..a273c29 100644
|
||||||
- ]
|
- ]
|
||||||
- return $ LetE [fun] (VarE helper)
|
- return $ LetE [fun] (VarE helper)
|
||||||
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
|
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
|
--- a/Yesod/Core/Types.hs
|
||||||
+++ b/Yesod/Core/Types.hs
|
+++ b/Yesod/Core/Types.hs
|
||||||
@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase))
|
@@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..))
|
||||||
import Control.Monad.Catch (MonadCatch (..))
|
|
||||||
import Control.Monad.Catch (MonadMask (..))
|
import Control.Monad.Catch (MonadMask (..))
|
||||||
|
#endif
|
||||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||||
+import qualified Control.Monad.Logger
|
+import qualified Control.Monad.Logger
|
||||||
import Control.Monad.Logger (LogLevel, LogSource,
|
import Control.Monad.Logger (LogLevel, LogSource,
|
||||||
MonadLogger (..))
|
MonadLogger (..))
|
||||||
import Control.Monad.Trans.Control (MonadBaseControl (..))
|
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))
|
, rheRoute :: !(Maybe (Route site))
|
||||||
, rheSite :: !site
|
, rheSite :: !site
|
||||||
, rheUpload :: !(RequestBodyLength -> FileUpload)
|
, rheUpload :: !(RequestBodyLength -> FileUpload)
|
||||||
- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||||
+ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
+ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||||
, rheOnError :: !(ErrorResponse -> YesodApp)
|
, rheOnError :: !(ErrorResponse -> YesodApp)
|
||||||
, rheGetMaxExpires :: IO Text
|
|
||||||
-- ^ How to respond when an error is thrown internally.
|
-- ^ How to respond when an error is thrown internally.
|
||||||
|
--
|
||||||
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
|
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
|
||||||
index 481199e..8489fbe 100644
|
index 481199e..8489fbe 100644
|
||||||
--- a/Yesod/Core/Widget.hs
|
--- a/Yesod/Core/Widget.hs
|
||||||
|
@ -765,5 +764,5 @@ index 481199e..8489fbe 100644
|
||||||
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
|
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
|
||||||
=> HtmlUrlI18n message (Route (HandlerSite m))
|
=> HtmlUrlI18n message (Route (HandlerSite m))
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -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>
|
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
|
Subject: [PATCH] stub out
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -8,16 +8,16 @@ Subject: [PATCH] stub out
|
||||||
1 file changed, 10 deletions(-)
|
1 file changed, 10 deletions(-)
|
||||||
|
|
||||||
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
|
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
|
||||||
index c3bc1bf..1727dba 100644
|
index b116f3a..017b184 100644
|
||||||
--- a/yesod-persistent.cabal
|
--- a/yesod-persistent.cabal
|
||||||
+++ b/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
|
library
|
||||||
build-depends: base >= 4 && < 5
|
build-depends: base >= 4 && < 5
|
||||||
- , yesod-core >= 1.4.0 && < 1.5
|
- , yesod-core >= 1.2.2 && < 1.3
|
||||||
- , persistent >= 2.1 && < 2.2
|
- , persistent >= 1.2 && < 2.1
|
||||||
- , persistent-template >= 2.1 && < 2.2
|
- , persistent-template >= 1.2 && < 2.1
|
||||||
- , transformers >= 0.2.2
|
- , transformers >= 0.2.2
|
||||||
- , blaze-builder
|
- , blaze-builder
|
||||||
- , conduit
|
- , conduit
|
||||||
|
@ -29,5 +29,5 @@ index c3bc1bf..1727dba 100644
|
||||||
|
|
||||||
test-suite test
|
test-suite test
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
170
standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch
Normal file
170
standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch
Normal 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
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] remove TH
|
||||||
|
|
||||||
---
|
---
|
||||||
|
@ -31,7 +31,7 @@ index 08febb9..e3a6d51 100644
|
||||||
-- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript.
|
-- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript.
|
||||||
-- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@
|
-- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@
|
||||||
diff --git a/Yesod/Static.hs b/Yesod/Static.hs
|
diff --git a/Yesod/Static.hs b/Yesod/Static.hs
|
||||||
index a18d88e..afb1cda 100644
|
index 725ebf4..33eaffd 100644
|
||||||
--- a/Yesod/Static.hs
|
--- a/Yesod/Static.hs
|
||||||
+++ b/Yesod/Static.hs
|
+++ b/Yesod/Static.hs
|
||||||
@@ -37,8 +37,8 @@ module Yesod.Static
|
@@ -37,8 +37,8 @@ module Yesod.Static
|
||||||
|
@ -99,7 +99,7 @@ index a18d88e..afb1cda 100644
|
||||||
@@ -267,7 +270,7 @@ staticFilesList dir fs =
|
@@ -267,7 +270,7 @@ staticFilesList dir fs =
|
||||||
-- see if their copy is up-to-date.
|
-- see if their copy is up-to-date.
|
||||||
publicFiles :: Prelude.FilePath -> Q [Dec]
|
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 :: Prelude.FilePath -> Q [Dec]
|
||||||
mkStaticFiles fp = mkStaticFiles' fp True
|
mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
|
||||||
|
|
||||||
@@ -354,6 +358,7 @@ mkStaticFilesList fp fs makeHash = do
|
@@ -357,6 +361,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
|
||||||
[ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) []
|
[ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
+-}
|
+-}
|
||||||
|
|
||||||
base64md5File :: Prelude.FilePath -> IO String
|
base64md5File :: Prelude.FilePath -> IO String
|
||||||
base64md5File = fmap (base64 . encode) . hashFile
|
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.
|
-- single static file at compile time.
|
||||||
|
|
||||||
data CombineType = JS | CSS
|
data CombineType = JS | CSS
|
||||||
|
@ -130,7 +130,7 @@ index a18d88e..afb1cda 100644
|
||||||
combineStatics' :: CombineType
|
combineStatics' :: CombineType
|
||||||
-> CombineSettings
|
-> CombineSettings
|
||||||
-> [Route Static] -- ^ files to combine
|
-> [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
|
case combineType of
|
||||||
JS -> "js"
|
JS -> "js"
|
||||||
CSS -> "css"
|
CSS -> "css"
|
||||||
|
@ -139,7 +139,7 @@ index a18d88e..afb1cda 100644
|
||||||
-- | Data type for holding all settings for combining files.
|
-- | Data type for holding all settings for combining files.
|
||||||
--
|
--
|
||||||
-- This data type is a settings type. For more information, see:
|
-- 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 :: [FilePath] -> [Char] -> [Char]
|
||||||
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
|
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
|
||||||
|
|
||||||
|
@ -147,7 +147,7 @@ index a18d88e..afb1cda 100644
|
||||||
liftRoutes :: [Route Static] -> Q Exp
|
liftRoutes :: [Route Static] -> Q Exp
|
||||||
liftRoutes =
|
liftRoutes =
|
||||||
fmap ListE . mapM go
|
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
|
-> Q Exp
|
||||||
combineScripts' development cs con routes
|
combineScripts' development cs con routes
|
||||||
| development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes 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
|
+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a
|
||||||
+-}
|
+-}
|
||||||
diff --git a/yesod-static.cabal b/yesod-static.cabal
|
diff --git a/yesod-static.cabal b/yesod-static.cabal
|
||||||
index 4ccb0d7..8758aaa 100644
|
index 2582a95..5df03b3 100644
|
||||||
--- a/yesod-static.cabal
|
--- a/yesod-static.cabal
|
||||||
+++ b/yesod-static.cabal
|
+++ b/yesod-static.cabal
|
||||||
@@ -50,7 +50,6 @@ library
|
@@ -49,7 +49,6 @@ library
|
||||||
, system-fileio >= 0.3
|
|
||||||
, data-default
|
, data-default
|
||||||
|
, shakespeare-css >= 1.0.3
|
||||||
, mime-types >= 0.1
|
, mime-types >= 0.1
|
||||||
- , hjsmin
|
- , hjsmin
|
||||||
, filepath >= 1.3
|
, filepath >= 1.3
|
||||||
, resourcet >= 0.4
|
, resourcet >= 0.4
|
||||||
, unordered-containers >= 0.2
|
, unordered-containers >= 0.2
|
||||||
@@ -63,13 +62,6 @@ library
|
@@ -62,13 +61,6 @@ library
|
||||||
, hashable >= 1.1
|
, hashable >= 1.1
|
||||||
|
|
||||||
exposed-modules: Yesod.Static
|
exposed-modules: Yesod.Static
|
||||||
|
@ -181,13 +181,13 @@ index 4ccb0d7..8758aaa 100644
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
extensions: TemplateHaskell
|
extensions: TemplateHaskell
|
||||||
@@ -108,7 +100,6 @@ test-suite tests
|
@@ -108,7 +100,6 @@ test-suite tests
|
||||||
, system-fileio
|
|
||||||
, data-default
|
, data-default
|
||||||
|
, shakespeare-css
|
||||||
, mime-types
|
, mime-types
|
||||||
- , hjsmin
|
- , hjsmin
|
||||||
, filepath
|
, filepath
|
||||||
, resourcet
|
, resourcet
|
||||||
, unordered-containers
|
, unordered-containers
|
||||||
--
|
--
|
||||||
2.1.4
|
2.0.0.rc2
|
||||||
|
|
||||||
|
|
|
@ -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>
|
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
|
Subject: [PATCH] hack TH
|
||||||
|
|
||||||
---
|
---
|
||||||
Yesod.hs | 19 ++++++++++++--
|
Yesod.hs | 19 ++++++++++++--
|
||||||
Yesod/Default/Main.hs | 28 +--------------------
|
Yesod/Default/Main.hs | 31 +----------------------
|
||||||
Yesod/Default/Util.hs | 68 ++-------------------------------------------------
|
Yesod/Default/Util.hs | 69 ++-------------------------------------------------
|
||||||
3 files changed, 20 insertions(+), 95 deletions(-)
|
3 files changed, 20 insertions(+), 99 deletions(-)
|
||||||
|
|
||||||
diff --git a/Yesod.hs b/Yesod.hs
|
diff --git a/Yesod.hs b/Yesod.hs
|
||||||
index b367144..fbe309c 100644
|
index b367144..fbe309c 100644
|
||||||
|
@ -41,7 +41,7 @@ index b367144..fbe309c 100644
|
||||||
+insert = undefined
|
+insert = undefined
|
||||||
+
|
+
|
||||||
diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs
|
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
|
--- a/Yesod/Default/Main.hs
|
||||||
+++ b/Yesod/Default/Main.hs
|
+++ b/Yesod/Default/Main.hs
|
||||||
@@ -1,10 +1,8 @@
|
@@ -1,10 +1,8 @@
|
||||||
|
@ -64,7 +64,7 @@ index 2694825..5a5fbb9 100644
|
||||||
import System.Log.FastLogger (LogStr, toLogStr)
|
import System.Log.FastLogger (LogStr, toLogStr)
|
||||||
import Language.Haskell.TH.Syntax (qLocation)
|
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 ()
|
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
|
||||||
|
|
||||||
|
@ -79,24 +79,27 @@ index 2694825..5a5fbb9 100644
|
||||||
-defaultMainLog load getApp = do
|
-defaultMainLog load getApp = do
|
||||||
- config <- load
|
- config <- load
|
||||||
- (app, logFunc) <- getApp config
|
- (app, logFunc) <- getApp config
|
||||||
- runSettings
|
- runSettings defaultSettings
|
||||||
- ( setPort (appPort config)
|
- { settingsPort = appPort config
|
||||||
- $ setHost (appHost config)
|
- , settingsHost = appHost config
|
||||||
- $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc
|
- , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc
|
||||||
- $(qLocation >>= liftLoc)
|
- $(qLocation >>= liftLoc)
|
||||||
- "yesod"
|
- "yesod"
|
||||||
- LevelError
|
- LevelError
|
||||||
- (toLogStr $ "Exception from Warp: " ++ show e))
|
- (toLogStr $ "Exception from Warp: " ++ show e)
|
||||||
- $ defaultSettings
|
- } app
|
||||||
- ) app
|
|
||||||
- where
|
- 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
|
-- | Run your application continously, listening for SIGINT and exiting
|
||||||
-- when received
|
-- when received
|
||||||
--
|
|
||||||
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
|
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
|
--- a/Yesod/Default/Util.hs
|
||||||
+++ b/Yesod/Default/Util.hs
|
+++ b/Yesod/Default/Util.hs
|
||||||
@@ -5,10 +5,9 @@
|
@@ -5,10 +5,9 @@
|
||||||
|
@ -122,7 +125,7 @@ index 488312a..5476b54 100644
|
||||||
import Text.Hamlet (HamletSettings, defaultHamletSettings)
|
import Text.Hamlet (HamletSettings, defaultHamletSettings)
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import Data.Default (Default (def))
|
import Data.Default (Default (def))
|
||||||
@@ -69,68 +65,8 @@ data TemplateLanguage = TemplateLanguage
|
@@ -69,68 +65,7 @@ data TemplateLanguage = TemplateLanguage
|
||||||
, tlReload :: FilePath -> Q Exp
|
, tlReload :: FilePath -> Q Exp
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -140,7 +143,7 @@ index 488312a..5476b54 100644
|
||||||
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
|
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
|
||||||
, wfsHamletSettings :: HamletSettings
|
, wfsHamletSettings :: HamletSettings
|
||||||
}
|
}
|
||||||
|
-
|
||||||
-instance Default WidgetFileSettings where
|
-instance Default WidgetFileSettings where
|
||||||
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
|
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
|
||||||
-
|
-
|
||||||
|
@ -159,7 +162,7 @@ index 488312a..5476b54 100644
|
||||||
- , func
|
- , func
|
||||||
- , " on "
|
- , " on "
|
||||||
- , show file
|
- , show file
|
||||||
- , ", but no templates were found."
|
- , ", but no template were found."
|
||||||
- ]
|
- ]
|
||||||
- exps -> return $ DoE $ map NoBindS exps
|
- exps -> return $ DoE $ map NoBindS exps
|
||||||
- where
|
- where
|
||||||
|
@ -192,5 +195,5 @@ index 488312a..5476b54 100644
|
||||||
- else return $ Just ex
|
- else return $ Just ex
|
||||||
- else return Nothing
|
- else return Nothing
|
||||||
--
|
--
|
||||||
2.1.4
|
2.1.1
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue