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
|
||||
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>
|
||||
Date: Fri, 3 Jul 2015 02:24:19 +0000
|
||||
Date: Thu, 16 Oct 2014 02:59:11 +0000
|
||||
Subject: [PATCH] port
|
||||
|
||||
---
|
||||
|
@ -9,48 +9,48 @@ Subject: [PATCH] port
|
|||
2 files changed, 9 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs
|
||||
index 31f6373..6487c7b 100644
|
||||
index 5721e03..c4400d1 100644
|
||||
--- a/Network/DNS/Resolver.hs
|
||||
+++ b/Network/DNS/Resolver.hs
|
||||
@@ -18,7 +18,7 @@ module Network.DNS.Resolver (
|
||||
, fromDNSFormat
|
||||
@@ -19,7 +19,7 @@ module Network.DNS.Resolver (
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<$>), (<*>), pure)
|
||||
-import Control.Exception (bracket)
|
||||
+import Control.Exception (bracket, catch, IOException)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (isPrefixOf)
|
||||
import Data.Maybe (fromMaybe)
|
||||
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(
|
||||
@@ -32,6 +32,7 @@ import Network.Socket (AddrInfoFlag(..), AddrInfo(..), defaultHints, getAddrInfo
|
||||
import Prelude hiding (lookup)
|
||||
import System.Random (getStdRandom, randomR)
|
||||
import System.Timeout (timeout)
|
||||
+import System.Process
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 709
|
||||
import Control.Applicative ((<$>), (<*>), pure)
|
||||
@@ -136,10 +137,12 @@ makeResolvSeed conf = ResolvSeed <$> addr
|
||||
#if mingw32_HOST_OS == 1
|
||||
import Network.Socket (send)
|
||||
@@ -130,10 +131,12 @@ makeResolvSeed conf = ResolvSeed <$> addr
|
||||
where
|
||||
addr = case resolvInfo conf of
|
||||
RCHostName numhost -> makeAddrInfo numhost Nothing
|
||||
RCHostPort numhost mport -> makeAddrInfo numhost $ Just mport
|
||||
- RCFilePath file -> toAddr <$> readFile file >>= \i -> makeAddrInfo i Nothing
|
||||
RCHostName numhost -> makeAddrInfo numhost
|
||||
- RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo
|
||||
- toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
|
||||
- in extract l
|
||||
- extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
|
||||
+ RCFilePath file -> do
|
||||
+ -- Android has no /etc/resolv.conf; use getprop command.
|
||||
+ ls <- catch (lines <$> readProcess "getprop" ["net.dns1"] []) (const (return []) :: IOException -> IO [String])
|
||||
+ flip makeAddrInfo Nothing $ case ls of
|
||||
+ makeAddrInfo $ case ls of
|
||||
+ [] -> "8.8.8.8" -- google public dns as a fallback only
|
||||
+ (l:_) -> l
|
||||
|
||||
makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
|
||||
makeAddrInfo addr mport = do
|
||||
makeAddrInfo :: HostName -> IO AddrInfo
|
||||
makeAddrInfo addr = do
|
||||
diff --git a/dns.cabal b/dns.cabal
|
||||
index 0745754..8cf4b67 100644
|
||||
index ceaf5f4..cd15e61 100644
|
||||
--- a/dns.cabal
|
||||
+++ b/dns.cabal
|
||||
@@ -39,6 +39,7 @@ Library
|
||||
@@ -37,6 +37,7 @@ Library
|
||||
, network >= 2.3
|
||||
, random
|
||||
, resourcet
|
||||
|
@ -59,5 +59,5 @@ index 0745754..8cf4b67 100644
|
|||
Build-Depends: base >= 4 && < 5
|
||||
, attoparsec
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
|
@ -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: dummy <dummy@example.com>
|
||||
Date: Thu, 2 Jul 2015 20:42:50 +0000
|
||||
From 7beec2e707d59f9573aa2dc7c57bd2a62f16b480 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Wed, 15 May 2013 19:06:03 -0400
|
||||
Subject: [PATCH] build without IPv6 stuff
|
||||
|
||||
---
|
||||
Data/IP.hs | 2 +-
|
||||
Data/IP/Addr.hs | 3 +++
|
||||
Data/IP.hs | 2 +-
|
||||
Data/IP/Addr.hs | 3 +++
|
||||
2 files changed, 4 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/Data/IP.hs b/Data/IP.hs
|
||||
index 306a488..e3f252e 100644
|
||||
index cffef93..ea486c9 100644
|
||||
--- a/Data/IP.hs
|
||||
+++ b/Data/IP.hs
|
||||
@@ -6,7 +6,7 @@ module Data.IP (
|
||||
-- ** IP data
|
||||
IP (..)
|
||||
, IPv4, toIPv4, fromIPv4, fromHostAddress, toHostAddress
|
||||
- , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b, fromHostAddress6, toHostAddress6
|
||||
+ , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b -- , fromHostAddress6, toHostAddress6
|
||||
- , IPv6, toIPv6, fromIPv6, fromHostAddress6, toHostAddress6
|
||||
+ , IPv6, toIPv6, fromIPv6 -- , fromHostAddress6, toHostAddress6
|
||||
-- ** IP range data
|
||||
, IPRange (..)
|
||||
, AddrRange (addr, mask, mlen)
|
||||
diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs
|
||||
index 8d4131e..868a572 100644
|
||||
index faaf0c7..5b556fb 100644
|
||||
--- a/Data/IP/Addr.hs
|
||||
+++ b/Data/IP/Addr.hs
|
||||
@@ -376,6 +376,7 @@ toHostAddress (IP4 addr4)
|
||||
@@ -312,6 +312,7 @@ toHostAddress (IP4 addr4)
|
||||
| byteOrder == LittleEndian = fixByteOrder addr4
|
||||
| otherwise = addr4
|
||||
|
||||
|
@ -33,7 +33,7 @@ index 8d4131e..868a572 100644
|
|||
-- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.
|
||||
fromHostAddress6 :: HostAddress6 -> IPv6
|
||||
fromHostAddress6 = IP6
|
||||
@@ -384,6 +385,8 @@ fromHostAddress6 = IP6
|
||||
@@ -320,6 +321,8 @@ fromHostAddress6 = IP6
|
||||
toHostAddress6 :: IPv6 -> HostAddress6
|
||||
toHostAddress6 (IP6 addr6) = addr6
|
||||
|
||||
|
@ -43,5 +43,5 @@ index 8d4131e..868a572 100644
|
|||
fixByteOrder s = d1 .|. d2 .|. d3 .|. d4
|
||||
where
|
||||
--
|
||||
2.1.4
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
From 508b4701c1610d9772564b97a74b5fa01dab48e2 Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Thu, 2 Jul 2015 20:12:59 +0000
|
||||
From 7861b133bb269b50fcf709291449cb0473818902 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Sun, 29 Dec 2013 21:29:23 +0000
|
||||
Subject: [PATCH] remove Network.BSD symbols not available in bionic
|
||||
|
||||
---
|
||||
Network/BSD.hsc | 100 --------------------------------------------------------
|
||||
1 file changed, 100 deletions(-)
|
||||
Network/BSD.hsc | 98 -------------------------------------------------------
|
||||
1 file changed, 98 deletions(-)
|
||||
|
||||
diff --git a/Network/BSD.hsc b/Network/BSD.hsc
|
||||
index b5e9a26..f085f2a 100644
|
||||
index d6dae85..27910f4 100644
|
||||
--- a/Network/BSD.hsc
|
||||
+++ b/Network/BSD.hsc
|
||||
@@ -27,15 +27,6 @@ module Network.BSD
|
||||
@@ -30,15 +30,6 @@ module Network.BSD
|
||||
, getHostByAddr
|
||||
, hostAddress
|
||||
|
||||
|
@ -27,7 +27,7 @@ index b5e9a26..f085f2a 100644
|
|||
-- * Service names
|
||||
, ServiceEntry(..)
|
||||
, ServiceName
|
||||
@@ -61,14 +52,6 @@ module Network.BSD
|
||||
@@ -64,14 +55,6 @@ module Network.BSD
|
||||
, getProtocolNumber
|
||||
, defaultProtocol
|
||||
|
||||
|
@ -42,7 +42,7 @@ index b5e9a26..f085f2a 100644
|
|||
-- * Port numbers
|
||||
, PortNumber
|
||||
|
||||
@@ -80,11 +63,7 @@ module Network.BSD
|
||||
@@ -83,11 +66,7 @@ module Network.BSD
|
||||
#if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32)
|
||||
, getNetworkByName
|
||||
, getNetworkByAddr
|
||||
|
@ -52,9 +52,9 @@ index b5e9a26..f085f2a 100644
|
|||
- , getNetworkEntry
|
||||
- , endNetworkEntry
|
||||
#endif
|
||||
) where
|
||||
|
||||
#if defined(HAVE_IF_NAMETOINDEX)
|
||||
@@ -298,31 +277,6 @@ getProtocolNumber proto = do
|
||||
@@ -303,31 +282,6 @@ getProtocolNumber proto = do
|
||||
(ProtocolEntry _ _ num) <- getProtocolByName proto
|
||||
return num
|
||||
|
||||
|
@ -62,18 +62,18 @@ index b5e9a26..f085f2a 100644
|
|||
-getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
|
||||
-getProtocolEntry = withLock $ do
|
||||
- ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry"
|
||||
- $ c_getprotoent
|
||||
- $ trySysCall c_getprotoent
|
||||
- peek ent
|
||||
-
|
||||
-foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)
|
||||
-
|
||||
-setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
|
||||
-setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg)
|
||||
-setProtocolEntry flg = withLock $ trySysCall $ c_setprotoent (fromBool flg)
|
||||
-
|
||||
-foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO ()
|
||||
-
|
||||
-endProtocolEntry :: IO ()
|
||||
-endProtocolEntry = withLock $ c_endprotoent
|
||||
-endProtocolEntry = withLock $ trySysCall $ c_endprotoent
|
||||
-
|
||||
-foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()
|
||||
-
|
||||
|
@ -86,7 +86,7 @@ index b5e9a26..f085f2a 100644
|
|||
-- ---------------------------------------------------------------------------
|
||||
-- Host lookups
|
||||
|
||||
@@ -397,31 +351,6 @@ getHostByAddr family addr = do
|
||||
@@ -402,31 +356,6 @@ getHostByAddr family addr = do
|
||||
foreign import CALLCONV safe "gethostbyaddr"
|
||||
c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)
|
||||
|
||||
|
@ -94,13 +94,13 @@ index b5e9a26..f085f2a 100644
|
|||
-getHostEntry :: IO HostEntry
|
||||
-getHostEntry = withLock $ do
|
||||
- throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry"
|
||||
- $ c_gethostent
|
||||
- $ trySysCall $ c_gethostent
|
||||
- >>= peek
|
||||
-
|
||||
-foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)
|
||||
-
|
||||
-setHostEntry :: Bool -> IO ()
|
||||
-setHostEntry flg = withLock $ c_sethostent (fromBool flg)
|
||||
-setHostEntry flg = withLock $ trySysCall $ c_sethostent (fromBool flg)
|
||||
-
|
||||
-foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO ()
|
||||
-
|
||||
|
@ -118,14 +118,14 @@ index b5e9a26..f085f2a 100644
|
|||
-- ---------------------------------------------------------------------------
|
||||
-- Accessing network information
|
||||
|
||||
@@ -483,35 +412,6 @@ getNetworkByAddr addr family = withLock $ do
|
||||
@@ -488,33 +417,6 @@ getNetworkByAddr addr family = withLock $ do
|
||||
foreign import ccall unsafe "getnetbyaddr"
|
||||
c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)
|
||||
|
||||
-getNetworkEntry :: IO NetworkEntry
|
||||
-getNetworkEntry = withLock $ do
|
||||
- throwNoSuchThingIfNull "getNetworkEntry" "no more network entries"
|
||||
- $ c_getnetent
|
||||
- $ trySysCall $ c_getnetent
|
||||
- >>= peek
|
||||
-
|
||||
-foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)
|
||||
|
@ -134,13 +134,13 @@ index b5e9a26..f085f2a 100644
|
|||
--- whether a connection is maintained open between various
|
||||
--- networkEntry calls
|
||||
-setNetworkEntry :: Bool -> IO ()
|
||||
-setNetworkEntry flg = withLock $ c_setnetent (fromBool flg)
|
||||
-setNetworkEntry flg = withLock $ trySysCall $ c_setnetent (fromBool flg)
|
||||
-
|
||||
-foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO ()
|
||||
-
|
||||
--- | Close the connection to the network name database.
|
||||
-endNetworkEntry :: IO ()
|
||||
-endNetworkEntry = withLock $ c_endnetent
|
||||
-endNetworkEntry = withLock $ trySysCall $ c_endnetent
|
||||
-
|
||||
-foreign import ccall unsafe "endnetent" c_endnetent :: IO ()
|
||||
-
|
||||
|
@ -149,11 +149,9 @@ index b5e9a26..f085f2a 100644
|
|||
-getNetworkEntries stayOpen = do
|
||||
- setNetworkEntry stayOpen
|
||||
- getEntries (getNetworkEntry) (endNetworkEntry)
|
||||
-#endif
|
||||
-
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Interface names
|
||||
#endif
|
||||
|
||||
-- Mutex for name service lockdown
|
||||
--
|
||||
2.1.4
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
From 21af25e922b00171c07f951a235ff7d7edbbd2be Mon Sep 17 00:00:00 2001
|
||||
From 478fc7ae42030c1345e75727e54e1f8f895d3e22 Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Thu, 2 Jul 2015 20:14:40 +0000
|
||||
Date: Wed, 15 Oct 2014 15:16:21 +0000
|
||||
Subject: [PATCH] avoid accept4
|
||||
|
||||
---
|
||||
|
@ -8,19 +8,19 @@ Subject: [PATCH] avoid accept4
|
|||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/Network/Socket.hsc b/Network/Socket.hsc
|
||||
index 6553bfc..802a7e9 100644
|
||||
index 2fe62ee..94db7a4 100644
|
||||
--- a/Network/Socket.hsc
|
||||
+++ b/Network/Socket.hsc
|
||||
@@ -489,7 +489,7 @@ accept sock@(MkSocket s family stype protocol status) = do
|
||||
return new_sock
|
||||
@@ -511,7 +511,7 @@ accept sock@(MkSocket s family stype protocol status) = do
|
||||
#else
|
||||
with (fromIntegral sz) $ \ ptr_len -> do
|
||||
new_sock <-
|
||||
-# ifdef HAVE_ACCEPT4
|
||||
+#if 0
|
||||
new_sock <- throwSocketErrorIfMinus1RetryMayBlock "accept"
|
||||
throwSocketErrorIfMinus1RetryMayBlock "accept"
|
||||
(threadWaitRead (fromIntegral s))
|
||||
(c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK))
|
||||
@@ -1565,7 +1565,7 @@ foreign import CALLCONV SAFE_ON_WIN "connect"
|
||||
@@ -1602,7 +1602,7 @@ foreign import CALLCONV SAFE_ON_WIN "connect"
|
||||
c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt
|
||||
foreign import CALLCONV unsafe "accept"
|
||||
c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt
|
||||
|
@ -30,5 +30,5 @@ index 6553bfc..802a7e9 100644
|
|||
c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt
|
||||
#endif
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
|
@ -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>
|
||||
Date: Thu, 2 Jul 2015 20:34:05 +0000
|
||||
Date: Wed, 15 Oct 2014 16:37:32 +0000
|
||||
Subject: [PATCH] hack for bionic
|
||||
|
||||
---
|
||||
|
@ -9,10 +9,10 @@ Subject: [PATCH] hack for bionic
|
|||
2 files changed, 1 insertion(+), 13 deletions(-)
|
||||
|
||||
diff --git a/Data/UnixTime/Types.hsc b/Data/UnixTime/Types.hsc
|
||||
index 6253b27..fb5b3fa 100644
|
||||
index d30f39b..ec7ca4c 100644
|
||||
--- a/Data/UnixTime/Types.hsc
|
||||
+++ b/Data/UnixTime/Types.hsc
|
||||
@@ -12,8 +12,6 @@ import Data.Binary
|
||||
@@ -9,8 +9,6 @@ import Foreign.Storable
|
||||
|
||||
#include <sys/time.h>
|
||||
|
||||
|
@ -20,8 +20,8 @@ index 6253b27..fb5b3fa 100644
|
|||
-
|
||||
-- |
|
||||
-- Data structure for Unix time.
|
||||
--
|
||||
@@ -33,16 +31,6 @@ data UnixTime = UnixTime {
|
||||
data UnixTime = UnixTime {
|
||||
@@ -20,16 +18,6 @@ data UnixTime = UnixTime {
|
||||
, utMicroSeconds :: {-# UNPACK #-} !Int32
|
||||
} deriving (Eq,Ord,Show)
|
||||
|
||||
|
@ -35,14 +35,14 @@ index 6253b27..fb5b3fa 100644
|
|||
- (#poke struct timeval, tv_sec) ptr (utSeconds ut)
|
||||
- (#poke struct timeval, tv_usec) ptr (utMicroSeconds ut)
|
||||
-
|
||||
#if __GLASGOW_HASKELL__ >= 704
|
||||
instance Binary UnixTime where
|
||||
put (UnixTime (CTime sec) msec) = do
|
||||
-- |
|
||||
-- Format of the strptime()/strftime() style.
|
||||
type Format = ByteString
|
||||
diff --git a/cbits/conv.c b/cbits/conv.c
|
||||
index 669cfda..8fa5f9a 100644
|
||||
index ec31fef..b7bc0f9 100644
|
||||
--- a/cbits/conv.c
|
||||
+++ b/cbits/conv.c
|
||||
@@ -98,7 +98,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
|
||||
@@ -96,7 +96,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
|
||||
#else
|
||||
strptime(src, fmt, &dst);
|
||||
#endif
|
||||
|
@ -52,5 +52,5 @@ index 669cfda..8fa5f9a 100644
|
|||
|
||||
size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
|
@ -1,15 +1,16 @@
|
|||
From 04a1230cf4d740d37ab427165eef4b4db2a3898f Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Fri, 3 Jul 2015 02:20:42 +0000
|
||||
Subject: [PATCH] build without v1 uuid which needs network-info
|
||||
From 87283f9b6f992a7f0e36c7b1bafc288bf2bf106a Mon Sep 17 00:00:00 2001
|
||||
From: androidbuilder <androidbuilder@example.com>
|
||||
Date: Mon, 11 Nov 2013 02:46:27 +0000
|
||||
Subject: [PATCH] build without v1 uuid which needs network-ino
|
||||
|
||||
---
|
||||
Data/UUID/Util.hs | 11 -----------
|
||||
uuid.cabal | 2 --
|
||||
2 files changed, 13 deletions(-)
|
||||
Data/UUID/Util.hs | 11 -----------
|
||||
Data/UUID/V1.hs | 2 --
|
||||
uuid.cabal | 2 --
|
||||
3 files changed, 15 deletions(-)
|
||||
|
||||
diff --git a/Data/UUID/Util.hs b/Data/UUID/Util.hs
|
||||
index 8817f51..0d43b01 100644
|
||||
index 581391a..399e508 100644
|
||||
--- a/Data/UUID/Util.hs
|
||||
+++ b/Data/UUID/Util.hs
|
||||
@@ -3,7 +3,6 @@ module Data.UUID.Util (
|
||||
|
@ -23,37 +24,49 @@ index 8817f51..0d43b01 100644
|
|||
@@ -13,7 +12,6 @@ import Data.Word
|
||||
import Data.Word.Util
|
||||
import Data.Bits
|
||||
import Data.UUID.Types.Internal
|
||||
import Data.UUID.Internal
|
||||
-import Network.Info
|
||||
import Data.Int (Int64)
|
||||
|
||||
version :: UUID -> Int
|
||||
@@ -42,12 +40,3 @@ extractTime uuid =
|
||||
|
||||
@@ -43,12 +41,3 @@ extractTime uuid =
|
||||
timeAndVersionToTime :: Word16 -> Word16
|
||||
timeAndVersionToTime tv = tv .&. 0x0FFF
|
||||
-
|
||||
|
||||
-extractMac :: UUID -> Maybe MAC
|
||||
-extractMac uuid =
|
||||
-extractMac uuid =
|
||||
- if version uuid == 1
|
||||
- then Just $
|
||||
- then Just $
|
||||
- MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)
|
||||
- else Nothing
|
||||
- where
|
||||
- unpacked = unpack uuid
|
||||
-
|
||||
diff --git a/Data/UUID/V1.hs b/Data/UUID/V1.hs
|
||||
index 067e729..ca4c235 100644
|
||||
--- a/Data/UUID/V1.hs
|
||||
+++ b/Data/UUID/V1.hs
|
||||
@@ -37,8 +37,6 @@ import System.IO.Unsafe
|
||||
|
||||
import qualified System.Random as R
|
||||
|
||||
-import Network.Info
|
||||
-
|
||||
import Data.UUID.Builder
|
||||
import Data.UUID.Internal
|
||||
|
||||
diff --git a/uuid.cabal b/uuid.cabal
|
||||
index 2fa548b..9d86fd2 100644
|
||||
index 0a53059..57b1b86 100644
|
||||
--- a/uuid.cabal
|
||||
+++ b/uuid.cabal
|
||||
@@ -30,7 +30,6 @@ Library
|
||||
binary >= 0.4 && < 0.8,
|
||||
bytestring >= 0.9 && < 0.11,
|
||||
@@ -32,14 +32,12 @@ Library
|
||||
cryptohash >= 0.7 && < 0.12,
|
||||
deepseq == 1.3.*,
|
||||
hashable (>= 1.1.1.0 && < 1.2.0) || (>= 1.2.1 && < 1.3),
|
||||
- network-info == 0.2.*,
|
||||
random >= 1.0.1 && < 1.2,
|
||||
time >= 1.1 && < 1.6,
|
||||
uuid-types >= 1.0 && < 2
|
||||
@@ -38,7 +37,6 @@ Library
|
||||
random >= 1.0.1 && < 1.1,
|
||||
time >= 1.1 && < 1.5
|
||||
|
||||
Exposed-Modules:
|
||||
Data.UUID
|
||||
Data.UUID.Util
|
||||
|
@ -62,5 +75,5 @@ index 2fa548b..9d86fd2 100644
|
|||
Data.UUID.V4
|
||||
Data.UUID.V5
|
||||
--
|
||||
2.1.4
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -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
|
||||
cp /usr/share/misc/config.guess .
|
||||
fi
|
||||
cabal install # --reinstall --force-reinstalls
|
||||
cabal install # --force-reinstalls --reinstall
|
||||
rm -f cabal.config
|
||||
|
||||
rm -rf $pkg*
|
||||
|
@ -65,7 +65,7 @@ patched () {
|
|||
installgitannexdeps () {
|
||||
pushd ../..
|
||||
ln -sf standalone/android/cabal.config
|
||||
cabal install --only-dependencies "$@"
|
||||
cabal install --only-dependencies "$@" # --force-reinstalls --reinstall
|
||||
rm -f cabal.config
|
||||
popd
|
||||
}
|
||||
|
@ -86,9 +86,9 @@ EOF
|
|||
patched iproute
|
||||
patched primitive
|
||||
patched socks
|
||||
patched entropy
|
||||
patched vector
|
||||
patched stm-chans
|
||||
patched persistent
|
||||
patched profunctors
|
||||
patched skein
|
||||
patched lens
|
||||
|
@ -97,32 +97,35 @@ EOF
|
|||
patched persistent-template
|
||||
patched system-filepath
|
||||
patched optparse-applicative
|
||||
patched warp
|
||||
patched wai-app-static
|
||||
patched yesod-routes
|
||||
patched shakespeare
|
||||
patched yesod-core
|
||||
patched yesod-persistent
|
||||
patched yesod-form
|
||||
patched crypto-numbers
|
||||
patched clock
|
||||
patched yesod-auth
|
||||
patched yesod
|
||||
patched process-conduit
|
||||
patched DAV
|
||||
patched yesod-static
|
||||
patched uuid
|
||||
patched dns
|
||||
patched gnutls
|
||||
patched unbounded-delays
|
||||
patched gnuidn
|
||||
patched network-protocol-xmpp
|
||||
patched uuid
|
||||
|
||||
cd ..
|
||||
|
||||
installgitannexdeps -fAndroid -f-Pairing
|
||||
}
|
||||
|
||||
cabal update
|
||||
setupcabal
|
||||
|
||||
# Install packages for host ghc.
|
||||
cabal update
|
||||
installgitannexdeps
|
||||
|
||||
# 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>
|
||||
Date: Fri, 3 Jul 2015 01:36:31 +0000
|
||||
Date: Thu, 16 Oct 2014 02:51:28 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
|
@ -10,7 +10,7 @@ Subject: [PATCH] remove TH
|
|||
3 files changed, 306 insertions(+), 46 deletions(-)
|
||||
|
||||
diff --git a/DAV.cabal b/DAV.cabal
|
||||
index f78c2e5..1ec4d80 100644
|
||||
index 95fffd8..5669c51 100644
|
||||
--- a/DAV.cabal
|
||||
+++ b/DAV.cabal
|
||||
@@ -47,33 +47,7 @@ library
|
||||
|
@ -27,7 +27,7 @@ index f78c2e5..1ec4d80 100644
|
|||
- , containers
|
||||
- , data-default
|
||||
- , either >= 4.3
|
||||
- , errors < 2.0
|
||||
- , errors
|
||||
- , exceptions
|
||||
- , http-client >= 0.2
|
||||
- , http-client-tls >= 0.2
|
||||
|
@ -49,7 +49,7 @@ index f78c2e5..1ec4d80 100644
|
|||
source-repository head
|
||||
type: git
|
||||
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
|
||||
index 5d5d6fd..7265d42 100644
|
||||
index 4c6d68f..55979b6 100644
|
||||
--- a/Network/Protocol/HTTP/DAV.hs
|
||||
+++ b/Network/Protocol/HTTP/DAV.hs
|
||||
@@ -82,6 +82,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho
|
||||
|
@ -416,5 +416,5 @@ index 0ecd476..1653bf6 100644
|
|||
+ Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg))
|
||||
+{-# INLINE userAgent #-}
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
40
standalone/no-th/haskell-patches/aeson_remove-TH.patch
Normal file
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>
|
||||
Date: Fri, 3 Jul 2015 02:06:43 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
Date: Thu, 16 Oct 2014 01:43:10 +0000
|
||||
Subject: [PATCH] avoid TH
|
||||
|
||||
---
|
||||
lens.cabal | 16 +---------------
|
||||
src/Control/Lens.hs | 6 ++----
|
||||
lens.cabal | 17 +----------------
|
||||
src/Control/Lens.hs | 8 ++------
|
||||
src/Control/Lens/Cons.hs | 2 --
|
||||
src/Control/Lens/Internal/Fold.hs | 2 --
|
||||
src/Control/Lens/Operators.hs | 2 +-
|
||||
src/Control/Lens/Prism.hs | 2 --
|
||||
src/Control/Monad/Primitive/Lens.hs | 1 -
|
||||
7 files changed, 4 insertions(+), 27 deletions(-)
|
||||
7 files changed, 4 insertions(+), 30 deletions(-)
|
||||
|
||||
diff --git a/lens.cabal b/lens.cabal
|
||||
index c7f6009..ab206c5 100644
|
||||
index 5388301..d7b02b9 100644
|
||||
--- a/lens.cabal
|
||||
+++ b/lens.cabal
|
||||
@@ -10,7 +10,7 @@ stability: provisional
|
||||
|
@ -26,7 +26,15 @@ index c7f6009..ab206c5 100644
|
|||
-- build-tools: cpphs
|
||||
tested-with: GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2
|
||||
synopsis: Lenses, Folds and Traversals
|
||||
@@ -230,8 +230,6 @@ library
|
||||
@@ -217,7 +217,6 @@ library
|
||||
Control.Exception.Lens
|
||||
Control.Lens
|
||||
Control.Lens.Action
|
||||
- Control.Lens.At
|
||||
Control.Lens.Combinators
|
||||
Control.Lens.Cons
|
||||
Control.Lens.Each
|
||||
@@ -234,8 +233,6 @@ library
|
||||
Control.Lens.Internal.Context
|
||||
Control.Lens.Internal.Deque
|
||||
Control.Lens.Internal.Exception
|
||||
|
@ -35,7 +43,7 @@ index c7f6009..ab206c5 100644
|
|||
Control.Lens.Internal.Fold
|
||||
Control.Lens.Internal.Getter
|
||||
Control.Lens.Internal.Indexed
|
||||
@@ -243,25 +241,21 @@ library
|
||||
@@ -247,25 +244,21 @@ library
|
||||
Control.Lens.Internal.Reflection
|
||||
Control.Lens.Internal.Review
|
||||
Control.Lens.Internal.Setter
|
||||
|
@ -61,7 +69,7 @@ index c7f6009..ab206c5 100644
|
|||
Control.Monad.Primitive.Lens
|
||||
Control.Parallel.Strategies.Lens
|
||||
Control.Seq.Lens
|
||||
@@ -287,12 +281,8 @@ library
|
||||
@@ -291,12 +284,8 @@ library
|
||||
Data.Typeable.Lens
|
||||
Data.Vector.Lens
|
||||
Data.Vector.Generic.Lens
|
||||
|
@ -74,7 +82,7 @@ index c7f6009..ab206c5 100644
|
|||
Numeric.Lens
|
||||
|
||||
other-modules:
|
||||
@@ -395,7 +385,6 @@ test-suite doctests
|
||||
@@ -403,7 +392,6 @@ test-suite doctests
|
||||
deepseq,
|
||||
doctest >= 0.9.1,
|
||||
filepath,
|
||||
|
@ -82,7 +90,7 @@ index c7f6009..ab206c5 100644
|
|||
mtl,
|
||||
nats,
|
||||
parallel,
|
||||
@@ -433,7 +422,6 @@ benchmark plated
|
||||
@@ -441,7 +429,6 @@ benchmark plated
|
||||
comonad,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
@ -90,7 +98,7 @@ index c7f6009..ab206c5 100644
|
|||
lens,
|
||||
transformers
|
||||
|
||||
@@ -468,7 +456,6 @@ benchmark unsafe
|
||||
@@ -476,7 +463,6 @@ benchmark unsafe
|
||||
comonads-fd,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
@ -98,7 +106,7 @@ index c7f6009..ab206c5 100644
|
|||
lens,
|
||||
transformers
|
||||
|
||||
@@ -485,6 +472,5 @@ benchmark zipper
|
||||
@@ -493,6 +479,5 @@ benchmark zipper
|
||||
comonads-fd,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
@ -106,10 +114,18 @@ index c7f6009..ab206c5 100644
|
|||
lens,
|
||||
transformers
|
||||
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
|
||||
index d879c58..3d6015b 100644
|
||||
index 7e15267..433f1fc 100644
|
||||
--- a/src/Control/Lens.hs
|
||||
+++ b/src/Control/Lens.hs
|
||||
@@ -56,12 +56,11 @@ module Control.Lens
|
||||
@@ -41,7 +41,6 @@
|
||||
----------------------------------------------------------------------------
|
||||
module Control.Lens
|
||||
( module Control.Lens.Action
|
||||
- , module Control.Lens.At
|
||||
, module Control.Lens.Cons
|
||||
, module Control.Lens.Each
|
||||
, module Control.Lens.Empty
|
||||
@@ -53,12 +52,11 @@ module Control.Lens
|
||||
, module Control.Lens.Lens
|
||||
, module Control.Lens.Level
|
||||
, module Control.Lens.Loupe
|
||||
|
@ -123,7 +139,15 @@ index d879c58..3d6015b 100644
|
|||
, module Control.Lens.TH
|
||||
#endif
|
||||
, module Control.Lens.Traversal
|
||||
@@ -83,12 +82,11 @@ import Control.Lens.Iso
|
||||
@@ -69,7 +67,6 @@ module Control.Lens
|
||||
) where
|
||||
|
||||
import Control.Lens.Action
|
||||
-import Control.Lens.At
|
||||
import Control.Lens.Cons
|
||||
import Control.Lens.Each
|
||||
import Control.Lens.Empty
|
||||
@@ -81,12 +78,11 @@ import Control.Lens.Iso
|
||||
import Control.Lens.Lens
|
||||
import Control.Lens.Level
|
||||
import Control.Lens.Loupe
|
||||
|
@ -138,12 +162,12 @@ index d879c58..3d6015b 100644
|
|||
#endif
|
||||
import Control.Lens.Traversal
|
||||
diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs
|
||||
index 7b35db4..269f307 100644
|
||||
index a80e9c8..7d27b80 100644
|
||||
--- a/src/Control/Lens/Cons.hs
|
||||
+++ b/src/Control/Lens/Cons.hs
|
||||
@@ -56,8 +56,6 @@ import qualified Data.Vector.Unboxed as Unbox
|
||||
@@ -55,8 +55,6 @@ import Data.Vector.Unboxed (Unbox)
|
||||
import qualified Data.Vector.Unboxed as Unbox
|
||||
import Data.Word
|
||||
import Prelude
|
||||
|
||||
-{-# ANN module "HLint: ignore Eta reduce" #-}
|
||||
-
|
||||
|
@ -151,12 +175,12 @@ index 7b35db4..269f307 100644
|
|||
-- >>> :set -XNoOverloadedStrings
|
||||
-- >>> import Control.Lens
|
||||
diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs
|
||||
index 4bbde21..16295f4 100644
|
||||
index ab09c6b..43aa905 100644
|
||||
--- a/src/Control/Lens/Internal/Fold.hs
|
||||
+++ b/src/Control/Lens/Internal/Fold.hs
|
||||
@@ -35,8 +35,6 @@ import Data.Semigroup hiding (Min, getMin, Max, getMax)
|
||||
@@ -37,8 +37,6 @@ import Data.Maybe
|
||||
import Data.Semigroup hiding (Min, getMin, Max, getMax)
|
||||
import Data.Reflection
|
||||
import Prelude
|
||||
|
||||
-{-# ANN module "HLint: ignore Avoid lambda" #-}
|
||||
-
|
||||
|
@ -164,10 +188,10 @@ index 4bbde21..16295f4 100644
|
|||
-- Folding
|
||||
------------------------------------------------------------------------------
|
||||
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
|
||||
index 302f68e..1625fe5 100644
|
||||
index 9992e63..631e8e6 100644
|
||||
--- a/src/Control/Lens/Operators.hs
|
||||
+++ b/src/Control/Lens/Operators.hs
|
||||
@@ -104,7 +104,7 @@ module Control.Lens.Operators
|
||||
@@ -111,7 +111,7 @@ module Control.Lens.Operators
|
||||
, (<#~)
|
||||
, (<#=)
|
||||
-- * "Control.Lens.Plated"
|
||||
|
@ -177,12 +201,12 @@ index 302f68e..1625fe5 100644
|
|||
, ( # )
|
||||
-- * "Control.Lens.Setter"
|
||||
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
|
||||
index 36152d6..3af6bd3 100644
|
||||
index b75c870..c6c6596 100644
|
||||
--- a/src/Control/Lens/Prism.hs
|
||||
+++ b/src/Control/Lens/Prism.hs
|
||||
@@ -62,8 +62,6 @@ import Data.Profunctor.Unsafe
|
||||
@@ -61,8 +61,6 @@ import Unsafe.Coerce
|
||||
import Data.Profunctor.Unsafe
|
||||
#endif
|
||||
import Prelude
|
||||
|
||||
-{-# ANN module "HLint: ignore Use camelCase" #-}
|
||||
-
|
||||
|
@ -190,17 +214,17 @@ index 36152d6..3af6bd3 100644
|
|||
-- >>> :set -XNoOverloadedStrings
|
||||
-- >>> import Control.Lens
|
||||
diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs
|
||||
index 8f1ec94..482764a 100644
|
||||
index ee942c6..2f37134 100644
|
||||
--- a/src/Control/Monad/Primitive/Lens.hs
|
||||
+++ b/src/Control/Monad/Primitive/Lens.hs
|
||||
@@ -26,7 +26,6 @@ import Control.Lens
|
||||
import Control.Monad.Primitive
|
||||
@@ -20,7 +20,6 @@ import Control.Lens
|
||||
import Control.Monad.Primitive (PrimMonad(..))
|
||||
import GHC.Prim (State#)
|
||||
|
||||
-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
|
||||
|
||||
#if MIN_VERSION_primitive(0,6,0)
|
||||
prim :: PrimBase m => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
|
||||
prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
|
||||
prim = iso internal primitive
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
|
@ -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>
|
||||
Date: Thu, 2 Jul 2015 21:36:02 +0000
|
||||
Date: Tue, 10 Jun 2014 14:47:42 +0000
|
||||
Subject: [PATCH] deal with TH
|
||||
|
||||
Export modules referenced by it.
|
||||
|
||||
Should not need these icons in git-annex, so not worth using the Evil
|
||||
Splicer.
|
||||
---
|
||||
Network/Wai/Application/Static.hs | 4 ----
|
||||
WaiAppStatic/Storage/Embedded.hs | 8 ++++----
|
||||
|
@ -10,10 +14,10 @@ Subject: [PATCH] deal with TH
|
|||
3 files changed, 5 insertions(+), 11 deletions(-)
|
||||
|
||||
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
|
||||
index 228582d..7d72bb0 100644
|
||||
index db2b835..b2c1aec 100644
|
||||
--- a/Network/Wai/Application/Static.hs
|
||||
+++ b/Network/Wai/Application/Static.hs
|
||||
@@ -34,8 +34,6 @@ import Control.Monad.IO.Class (liftIO)
|
||||
@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
import Blaze.ByteString.Builder (toByteString)
|
||||
|
||||
|
@ -22,10 +26,10 @@ index 228582d..7d72bb0 100644
|
|||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
@@ -218,8 +216,6 @@ staticAppPieces _ _ req sendResponse
|
||||
@@ -198,8 +196,6 @@ staticAppPieces _ _ req sendResponse
|
||||
H.status405
|
||||
[("Content-Type", "text/plain")]
|
||||
"Only GET or HEAD is supported"
|
||||
"Only GET is supported"
|
||||
-staticAppPieces _ [".hidden", "folder.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]
|
||||
-staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]
|
||||
staticAppPieces ss rawPieces req sendResponse = liftIO $ do
|
||||
|
@ -51,10 +55,10 @@ index daa6e50..9873d4e 100644
|
|||
-import WaiAppStatic.Storage.Embedded.TH
|
||||
+--import WaiAppStatic.Storage.Embedded.TH
|
||||
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
|
||||
index 4cca237..3fbfcee 100644
|
||||
index ef6f898..9a59d71 100644
|
||||
--- a/wai-app-static.cabal
|
||||
+++ b/wai-app-static.cabal
|
||||
@@ -35,7 +35,6 @@ library
|
||||
@@ -33,7 +33,6 @@ library
|
||||
, containers >= 0.2
|
||||
, time >= 1.1.4
|
||||
, old-locale >= 1.0.0.2
|
||||
|
@ -62,7 +66,7 @@ index 4cca237..3fbfcee 100644
|
|||
, text >= 0.7
|
||||
, blaze-builder >= 0.2.1.4
|
||||
, base64-bytestring >= 0.1
|
||||
@@ -63,9 +62,8 @@ library
|
||||
@@ -61,9 +60,8 @@ library
|
||||
WaiAppStatic.Listing
|
||||
WaiAppStatic.Types
|
||||
WaiAppStatic.CmdLine
|
||||
|
@ -74,5 +78,5 @@ index 4cca237..3fbfcee 100644
|
|||
extensions: CPP
|
||||
|
||||
--
|
||||
2.1.4
|
||||
2.0.0
|
||||
|
||||
|
|
108
standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
Normal file
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>
|
||||
Date: Fri, 3 Jul 2015 00:39:53 +0000
|
||||
Date: Thu, 16 Oct 2014 02:15:23 +0000
|
||||
Subject: [PATCH] hack TH
|
||||
|
||||
---
|
||||
|
@ -15,7 +15,7 @@ Subject: [PATCH] hack TH
|
|||
8 files changed, 213 insertions(+), 288 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
|
||||
index f7436e6..2fa62cc 100644
|
||||
index 9b29317..7c0792d 100644
|
||||
--- a/Yesod/Core.hs
|
||||
+++ b/Yesod/Core.hs
|
||||
@@ -31,16 +31,16 @@ module Yesod.Core
|
||||
|
@ -45,7 +45,7 @@ index f7436e6..2fa62cc 100644
|
|||
-- * Sessions
|
||||
, SessionBackend (..)
|
||||
, customizeSessionCookies
|
||||
@@ -90,17 +90,15 @@ module Yesod.Core
|
||||
@@ -87,17 +87,15 @@ module Yesod.Core
|
||||
, readIntegral
|
||||
-- * Shakespeare
|
||||
-- ** Hamlet
|
||||
|
@ -68,10 +68,10 @@ index f7436e6..2fa62cc 100644
|
|||
, renderCssUrl
|
||||
) where
|
||||
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
|
||||
index c2e707a..b594353 100644
|
||||
index 8631d27..c40eb10 100644
|
||||
--- a/Yesod/Core/Class/Yesod.hs
|
||||
+++ b/Yesod/Core/Class/Yesod.hs
|
||||
@@ -5,11 +5,15 @@
|
||||
@@ -5,18 +5,22 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Core.Class.Yesod where
|
||||
|
||||
|
@ -88,16 +88,15 @@ index c2e707a..b594353 100644
|
|||
|
||||
import Blaze.ByteString.Builder (Builder)
|
||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
||||
@@ -18,7 +22,7 @@ import Control.Exception (bracket)
|
||||
import Control.Arrow ((***), second)
|
||||
import Control.Monad (forM, when, void)
|
||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||
import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
|
||||
- LogSource)
|
||||
+ LogSource, Loc)
|
||||
import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState)
|
||||
-import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
|
||||
+import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther),
|
||||
LogSource)
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
@@ -35,7 +39,6 @@ import qualified Data.Text.Encoding.Error as TEE
|
||||
@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import Data.Text.Lazy.Encoding (encodeUtf8)
|
||||
import Data.Word (Word64)
|
||||
|
@ -105,7 +104,7 @@ index c2e707a..b594353 100644
|
|||
import Network.HTTP.Types (encodePath)
|
||||
import qualified Network.Wai as W
|
||||
import Data.Default (def)
|
||||
@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where
|
||||
@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where
|
||||
defaultLayout w = do
|
||||
p <- widgetToPageContent w
|
||||
mmsg <- getMessage
|
||||
|
@ -144,7 +143,7 @@ index c2e707a..b594353 100644
|
|||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
@@ -410,45 +421,103 @@ widgetToPageContent w = do
|
||||
@@ -374,45 +385,103 @@ widgetToPageContent w = do
|
||||
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
|
||||
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
||||
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||
|
@ -287,7 +286,7 @@ index c2e707a..b594353 100644
|
|||
|
||||
return $ PageContent title headAll $
|
||||
case jsLoader master of
|
||||
@@ -478,10 +547,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
r <- waiRequest
|
||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
setTitle "Not Found"
|
||||
|
@ -305,7 +304,7 @@ index c2e707a..b594353 100644
|
|||
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
|
||||
|
||||
-- For API requests.
|
||||
@@ -491,10 +563,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Not logged in"
|
||||
|
@ -321,7 +320,7 @@ index c2e707a..b594353 100644
|
|||
|
||||
provideRep $ do
|
||||
-- 401 *MUST* include a WWW-Authenticate header
|
||||
@@ -516,10 +589,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
@@ -480,10 +553,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Permission Denied"
|
||||
|
@ -339,7 +338,7 @@ index c2e707a..b594353 100644
|
|||
provideRep $
|
||||
return $ object $ [
|
||||
"message" .= ("Permission Denied. " <> msg)
|
||||
@@ -528,30 +604,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
@@ -492,30 +568,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Invalid Arguments"
|
||||
|
@ -397,7 +396,7 @@ index c2e707a..b594353 100644
|
|||
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
|
||||
|
||||
asyncHelper :: (url -> [x] -> Text)
|
||||
@@ -718,8 +806,4 @@ loadClientSession key getCachedDate sessionName req = load
|
||||
@@ -682,8 +770,4 @@ loadClientSession key getCachedDate sessionName req = load
|
||||
-- turn the TH Loc loaction information into a human readable string
|
||||
-- leaving out the loc_end parameter
|
||||
fileLocationToString :: Loc -> String
|
||||
|
@ -408,7 +407,7 @@ index c2e707a..b594353 100644
|
|||
- char = show . snd . loc_start
|
||||
+fileLocationToString loc = "unknown"
|
||||
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
|
||||
index 7e43f74..625a901 100644
|
||||
index e0d1f0e..cc23fdd 100644
|
||||
--- a/Yesod/Core/Dispatch.hs
|
||||
+++ b/Yesod/Core/Dispatch.hs
|
||||
@@ -1,4 +1,3 @@
|
||||
|
@ -445,9 +444,9 @@ index 7e43f74..625a901 100644
|
|||
, PathMultiPiece (..)
|
||||
, Texts
|
||||
-- * Convert to WAI
|
||||
@@ -141,13 +140,6 @@ toWaiAppLogger logger site = do
|
||||
@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do
|
||||
, yreSite = site
|
||||
, yreSessionBackend = sb
|
||||
, yreGen = gen
|
||||
}
|
||||
- messageLoggerSource
|
||||
- site
|
||||
|
@ -459,10 +458,10 @@ index 7e43f74..625a901 100644
|
|||
middleware <- mkDefaultMiddlewares logger
|
||||
return $ middleware $ toWaiAppYre yre
|
||||
|
||||
@@ -167,14 +159,7 @@ warp port site = do
|
||||
Network.Wai.Handler.Warp.setPort port $
|
||||
Network.Wai.Handler.Warp.setServerName serverValue $
|
||||
Network.Wai.Handler.Warp.setOnException (\_ e ->
|
||||
@@ -170,14 +162,7 @@ warp port site = do
|
||||
]
|
||||
-}
|
||||
, Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
|
||||
- when (shouldLog' e) $
|
||||
- messageLoggerSource
|
||||
- site
|
||||
|
@ -470,12 +469,12 @@ index 7e43f74..625a901 100644
|
|||
- $(qLocation >>= liftLoc)
|
||||
- "yesod-core"
|
||||
- LevelError
|
||||
- (toLogStr $ "Exception from Warp: " ++ show e)) $
|
||||
+ when (shouldLog' e) $ error (show e)) $
|
||||
Network.Wai.Handler.Warp.defaultSettings)
|
||||
- (toLogStr $ "Exception from Warp: " ++ show e)
|
||||
+ when (shouldLog' e) $ error (show e)
|
||||
}
|
||||
where
|
||||
shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException
|
||||
@@ -208,7 +193,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
|
||||
shouldLog' =
|
||||
@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
|
||||
-- | Deprecated synonym for 'warp'.
|
||||
warpDebug :: YesodDispatch site => Int -> site -> IO ()
|
||||
warpDebug = warp
|
||||
|
@ -484,10 +483,10 @@ index 7e43f74..625a901 100644
|
|||
-- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It
|
||||
-- reads port information from the PORT environment variable, as used by tools
|
||||
diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
|
||||
index 19f4152..c97fb24 100644
|
||||
index d2b196b..13cac17 100644
|
||||
--- a/Yesod/Core/Handler.hs
|
||||
+++ b/Yesod/Core/Handler.hs
|
||||
@@ -178,7 +178,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
|
||||
@@ -174,7 +174,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Text.Blaze.Html.Renderer.Text as RenderText
|
||||
|
@ -496,7 +495,7 @@ index 19f4152..c97fb24 100644
|
|||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
@@ -206,6 +206,7 @@ import Control.Exception (throwIO)
|
||||
@@ -203,6 +203,7 @@ import Control.Exception (throwIO)
|
||||
import Blaze.ByteString.Builder (Builder)
|
||||
import Safe (headMay)
|
||||
import Data.CaseInsensitive (CI)
|
||||
|
@ -504,7 +503,7 @@ index 19f4152..c97fb24 100644
|
|||
import qualified Data.Conduit.List as CL
|
||||
import Control.Monad (unless)
|
||||
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
|
||||
@@ -848,19 +849,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
|
||||
@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
|
||||
-> m a
|
||||
redirectToPost url = do
|
||||
urlText <- toTextUrl url
|
||||
|
@ -534,7 +533,7 @@ index 19f4152..c97fb24 100644
|
|||
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
|
||||
hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
|
||||
diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs
|
||||
index 651c11c..46e1d2a 100644
|
||||
index 311f208..63f666f 100644
|
||||
--- a/Yesod/Core/Internal/Run.hs
|
||||
+++ b/Yesod/Core/Internal/Run.hs
|
||||
@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch)
|
||||
|
@ -544,18 +543,18 @@ index 651c11c..46e1d2a 100644
|
|||
-import Control.Monad.Logger (LogLevel (LevelError), LogSource,
|
||||
+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource,
|
||||
liftLoc)
|
||||
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState)
|
||||
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
|
||||
import qualified Data.ByteString as S
|
||||
@@ -32,7 +32,7 @@ import Data.Text.Encoding (encodeUtf8)
|
||||
@@ -31,7 +31,7 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Text.Encoding (decodeUtf8With)
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import Data.Time (getCurrentTime, addUTCTime)
|
||||
-import Language.Haskell.TH.Syntax (Loc, qLocation)
|
||||
+import Language.Haskell.TH.Syntax (qLocation)
|
||||
import qualified Network.HTTP.Types as H
|
||||
import Network.Wai
|
||||
import Network.Wai.Internal
|
||||
@@ -160,8 +160,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
#if MIN_VERSION_wai(2, 0, 0)
|
||||
@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
-> ErrorResponse
|
||||
-> YesodApp
|
||||
safeEh log' er req = do
|
||||
|
@ -684,26 +683,26 @@ index 7e84c1c..a273c29 100644
|
|||
- ]
|
||||
- return $ LetE [fun] (VarE helper)
|
||||
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
|
||||
index 5fa5c3d..1646d54 100644
|
||||
index 388dfe3..b3fce0f 100644
|
||||
--- a/Yesod/Core/Types.hs
|
||||
+++ b/Yesod/Core/Types.hs
|
||||
@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase))
|
||||
import Control.Monad.Catch (MonadCatch (..))
|
||||
@@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..))
|
||||
import Control.Monad.Catch (MonadMask (..))
|
||||
#endif
|
||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||
+import qualified Control.Monad.Logger
|
||||
import Control.Monad.Logger (LogLevel, LogSource,
|
||||
MonadLogger (..))
|
||||
import Control.Monad.Trans.Control (MonadBaseControl (..))
|
||||
@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv
|
||||
@@ -191,7 +192,7 @@ data RunHandlerEnv site = RunHandlerEnv
|
||||
, rheRoute :: !(Maybe (Route site))
|
||||
, rheSite :: !site
|
||||
, rheUpload :: !(RequestBodyLength -> FileUpload)
|
||||
- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
+ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
, rheOnError :: !(ErrorResponse -> YesodApp)
|
||||
, rheGetMaxExpires :: IO Text
|
||||
-- ^ How to respond when an error is thrown internally.
|
||||
--
|
||||
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
|
||||
index 481199e..8489fbe 100644
|
||||
--- a/Yesod/Core/Widget.hs
|
||||
|
@ -765,5 +764,5 @@ index 481199e..8489fbe 100644
|
|||
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
|
||||
=> HtmlUrlI18n message (Route (HandlerSite m))
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
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>
|
||||
Date: Fri, 3 Jul 2015 00:12:02 +0000
|
||||
Date: Thu, 16 Oct 2014 02:23:50 +0000
|
||||
Subject: [PATCH] stub out
|
||||
|
||||
---
|
||||
|
@ -8,16 +8,16 @@ Subject: [PATCH] stub out
|
|||
1 file changed, 10 deletions(-)
|
||||
|
||||
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
|
||||
index c3bc1bf..1727dba 100644
|
||||
index b116f3a..017b184 100644
|
||||
--- a/yesod-persistent.cabal
|
||||
+++ b/yesod-persistent.cabal
|
||||
@@ -15,16 +15,6 @@ extra-source-files: README.md ChangeLog.md
|
||||
@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod.
|
||||
|
||||
library
|
||||
build-depends: base >= 4 && < 5
|
||||
- , yesod-core >= 1.4.0 && < 1.5
|
||||
- , persistent >= 2.1 && < 2.2
|
||||
- , persistent-template >= 2.1 && < 2.2
|
||||
- , yesod-core >= 1.2.2 && < 1.3
|
||||
- , persistent >= 1.2 && < 2.1
|
||||
- , persistent-template >= 1.2 && < 2.1
|
||||
- , transformers >= 0.2.2
|
||||
- , blaze-builder
|
||||
- , conduit
|
||||
|
@ -29,5 +29,5 @@ index c3bc1bf..1727dba 100644
|
|||
|
||||
test-suite test
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
170
standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch
Normal file
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>
|
||||
Date: Fri, 3 Jul 2015 01:39:14 +0000
|
||||
Date: Wed, 21 May 2014 04:43:30 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
|
@ -31,7 +31,7 @@ index 08febb9..e3a6d51 100644
|
|||
-- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript.
|
||||
-- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@
|
||||
diff --git a/Yesod/Static.hs b/Yesod/Static.hs
|
||||
index a18d88e..afb1cda 100644
|
||||
index 725ebf4..33eaffd 100644
|
||||
--- a/Yesod/Static.hs
|
||||
+++ b/Yesod/Static.hs
|
||||
@@ -37,8 +37,8 @@ module Yesod.Static
|
||||
|
@ -99,7 +99,7 @@ index a18d88e..afb1cda 100644
|
|||
@@ -267,7 +270,7 @@ staticFilesList dir fs =
|
||||
-- see if their copy is up-to-date.
|
||||
publicFiles :: Prelude.FilePath -> Q [Dec]
|
||||
publicFiles dir = mkStaticFiles' dir False
|
||||
publicFiles dir = mkStaticFiles' dir "StaticRoute" False
|
||||
-
|
||||
+-}
|
||||
|
||||
|
@ -111,17 +111,17 @@ index a18d88e..afb1cda 100644
|
|||
|
||||
+{-
|
||||
mkStaticFiles :: Prelude.FilePath -> Q [Dec]
|
||||
mkStaticFiles fp = mkStaticFiles' fp True
|
||||
mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
|
||||
|
||||
@@ -354,6 +358,7 @@ mkStaticFilesList fp fs makeHash = do
|
||||
[ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) []
|
||||
@@ -357,6 +361,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
|
||||
[ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
|
||||
]
|
||||
]
|
||||
+-}
|
||||
|
||||
base64md5File :: Prelude.FilePath -> IO String
|
||||
base64md5File = fmap (base64 . encode) . hashFile
|
||||
@@ -392,7 +397,7 @@ base64 = map tr
|
||||
@@ -395,7 +400,7 @@ base64 = map tr
|
||||
-- single static file at compile time.
|
||||
|
||||
data CombineType = JS | CSS
|
||||
|
@ -130,7 +130,7 @@ index a18d88e..afb1cda 100644
|
|||
combineStatics' :: CombineType
|
||||
-> CombineSettings
|
||||
-> [Route Static] -- ^ files to combine
|
||||
@@ -426,7 +431,7 @@ combineStatics' combineType CombineSettings {..} routes = do
|
||||
@@ -429,7 +434,7 @@ combineStatics' combineType CombineSettings {..} routes = do
|
||||
case combineType of
|
||||
JS -> "js"
|
||||
CSS -> "css"
|
||||
|
@ -139,7 +139,7 @@ index a18d88e..afb1cda 100644
|
|||
-- | Data type for holding all settings for combining files.
|
||||
--
|
||||
-- This data type is a settings type. For more information, see:
|
||||
@@ -502,6 +507,7 @@ instance Default CombineSettings where
|
||||
@@ -505,6 +510,7 @@ instance Default CombineSettings where
|
||||
errorIntro :: [FilePath] -> [Char] -> [Char]
|
||||
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
|
||||
|
||||
|
@ -147,7 +147,7 @@ index a18d88e..afb1cda 100644
|
|||
liftRoutes :: [Route Static] -> Q Exp
|
||||
liftRoutes =
|
||||
fmap ListE . mapM go
|
||||
@@ -548,4 +554,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
|
||||
@@ -551,4 +557,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
|
||||
-> Q Exp
|
||||
combineScripts' development cs con routes
|
||||
| development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
|
||||
|
@ -155,18 +155,18 @@ index a18d88e..afb1cda 100644
|
|||
+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a
|
||||
+-}
|
||||
diff --git a/yesod-static.cabal b/yesod-static.cabal
|
||||
index 4ccb0d7..8758aaa 100644
|
||||
index 2582a95..5df03b3 100644
|
||||
--- a/yesod-static.cabal
|
||||
+++ b/yesod-static.cabal
|
||||
@@ -50,7 +50,6 @@ library
|
||||
, system-fileio >= 0.3
|
||||
@@ -49,7 +49,6 @@ library
|
||||
, data-default
|
||||
, shakespeare-css >= 1.0.3
|
||||
, mime-types >= 0.1
|
||||
- , hjsmin
|
||||
, filepath >= 1.3
|
||||
, resourcet >= 0.4
|
||||
, unordered-containers >= 0.2
|
||||
@@ -63,13 +62,6 @@ library
|
||||
@@ -62,13 +61,6 @@ library
|
||||
, hashable >= 1.1
|
||||
|
||||
exposed-modules: Yesod.Static
|
||||
|
@ -181,13 +181,13 @@ index 4ccb0d7..8758aaa 100644
|
|||
ghc-options: -Wall
|
||||
extensions: TemplateHaskell
|
||||
@@ -108,7 +100,6 @@ test-suite tests
|
||||
, system-fileio
|
||||
, data-default
|
||||
, shakespeare-css
|
||||
, mime-types
|
||||
- , hjsmin
|
||||
, filepath
|
||||
, resourcet
|
||||
, unordered-containers
|
||||
--
|
||||
2.1.4
|
||||
2.0.0.rc2
|
||||
|
||||
|
|
|
@ -1,13 +1,13 @@
|
|||
From 86e7cf433fcd3386893556d690748781f46d3f03 Mon Sep 17 00:00:00 2001
|
||||
From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Fri, 3 Jul 2015 01:33:03 +0000
|
||||
Date: Thu, 16 Oct 2014 02:36:37 +0000
|
||||
Subject: [PATCH] hack TH
|
||||
|
||||
---
|
||||
Yesod.hs | 19 ++++++++++++--
|
||||
Yesod/Default/Main.hs | 28 +--------------------
|
||||
Yesod/Default/Util.hs | 68 ++-------------------------------------------------
|
||||
3 files changed, 20 insertions(+), 95 deletions(-)
|
||||
Yesod/Default/Main.hs | 31 +----------------------
|
||||
Yesod/Default/Util.hs | 69 ++-------------------------------------------------
|
||||
3 files changed, 20 insertions(+), 99 deletions(-)
|
||||
|
||||
diff --git a/Yesod.hs b/Yesod.hs
|
||||
index b367144..fbe309c 100644
|
||||
|
@ -41,7 +41,7 @@ index b367144..fbe309c 100644
|
|||
+insert = undefined
|
||||
+
|
||||
diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs
|
||||
index 2694825..5a5fbb9 100644
|
||||
index 565ed35..bf46642 100644
|
||||
--- a/Yesod/Default/Main.hs
|
||||
+++ b/Yesod/Default/Main.hs
|
||||
@@ -1,10 +1,8 @@
|
||||
|
@ -64,7 +64,7 @@ index 2694825..5a5fbb9 100644
|
|||
import System.Log.FastLogger (LogStr, toLogStr)
|
||||
import Language.Haskell.TH.Syntax (qLocation)
|
||||
|
||||
@@ -56,30 +54,6 @@ defaultMain load getApp = do
|
||||
@@ -55,33 +53,6 @@ defaultMain load getApp = do
|
||||
|
||||
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
|
||||
|
||||
|
@ -79,24 +79,27 @@ index 2694825..5a5fbb9 100644
|
|||
-defaultMainLog load getApp = do
|
||||
- config <- load
|
||||
- (app, logFunc) <- getApp config
|
||||
- runSettings
|
||||
- ( setPort (appPort config)
|
||||
- $ setHost (appHost config)
|
||||
- $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc
|
||||
- runSettings defaultSettings
|
||||
- { settingsPort = appPort config
|
||||
- , settingsHost = appHost config
|
||||
- , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc
|
||||
- $(qLocation >>= liftLoc)
|
||||
- "yesod"
|
||||
- LevelError
|
||||
- (toLogStr $ "Exception from Warp: " ++ show e))
|
||||
- $ defaultSettings
|
||||
- ) app
|
||||
- (toLogStr $ "Exception from Warp: " ++ show e)
|
||||
- } app
|
||||
- where
|
||||
- shouldLog' = Warp.defaultShouldDisplayException
|
||||
-
|
||||
- shouldLog' =
|
||||
-#if MIN_VERSION_warp(2,1,3)
|
||||
- Warp.defaultShouldDisplayException
|
||||
-#else
|
||||
- const True
|
||||
-#endif
|
||||
|
||||
-- | Run your application continously, listening for SIGINT and exiting
|
||||
-- when received
|
||||
--
|
||||
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
|
||||
index 488312a..5476b54 100644
|
||||
index a10358e..0547424 100644
|
||||
--- a/Yesod/Default/Util.hs
|
||||
+++ b/Yesod/Default/Util.hs
|
||||
@@ -5,10 +5,9 @@
|
||||
|
@ -122,7 +125,7 @@ index 488312a..5476b54 100644
|
|||
import Text.Hamlet (HamletSettings, defaultHamletSettings)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Default (Default (def))
|
||||
@@ -69,68 +65,8 @@ data TemplateLanguage = TemplateLanguage
|
||||
@@ -69,68 +65,7 @@ data TemplateLanguage = TemplateLanguage
|
||||
, tlReload :: FilePath -> Q Exp
|
||||
}
|
||||
|
||||
|
@ -140,7 +143,7 @@ index 488312a..5476b54 100644
|
|||
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
|
||||
, wfsHamletSettings :: HamletSettings
|
||||
}
|
||||
|
||||
-
|
||||
-instance Default WidgetFileSettings where
|
||||
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
|
||||
-
|
||||
|
@ -159,7 +162,7 @@ index 488312a..5476b54 100644
|
|||
- , func
|
||||
- , " on "
|
||||
- , show file
|
||||
- , ", but no templates were found."
|
||||
- , ", but no template were found."
|
||||
- ]
|
||||
- exps -> return $ DoE $ map NoBindS exps
|
||||
- where
|
||||
|
@ -192,5 +195,5 @@ index 488312a..5476b54 100644
|
|||
- else return $ Just ex
|
||||
- else return Nothing
|
||||
--
|
||||
2.1.4
|
||||
2.1.1
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue