diff options
author | Joey Hess <joey@kitenet.net> | 2013-09-22 01:43:52 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-09-22 01:43:52 -0400 |
commit | aad3cb53944d2a4386314a365adcbd1bc58294d6 (patch) | |
tree | c8c00ca8a775ef0923f203df7d12c17ff2c65f69 /standalone/android/haskell-patches | |
parent | 17617d04cefcce357616144bc7c60d972e5d8ae0 (diff) |
remove unused patches (2000+ lines!)
Diffstat (limited to 'standalone/android/haskell-patches')
24 files changed, 0 insertions, 2227 deletions
diff --git a/standalone/android/haskell-patches/aeson_0.6.1.0_0001-disable-TH.patch b/standalone/android/haskell-patches/aeson_0.6.1.0_0001-disable-TH.patch deleted file mode 100644 index 787caf45c..000000000 --- a/standalone/android/haskell-patches/aeson_0.6.1.0_0001-disable-TH.patch +++ /dev/null @@ -1,24 +0,0 @@ -From b220c377941d0b1271cf525a8d06bb8e48196d2b Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:29:04 -0400 -Subject: [PATCH] disable TH - ---- - aeson.cabal | 1 - - 1 file changed, 1 deletion(-) - -diff --git a/aeson.cabal b/aeson.cabal -index 242aa67..275aa49 100644 ---- a/aeson.cabal -+++ b/aeson.cabal -@@ -99,7 +99,6 @@ library - Data.Aeson.Generic - Data.Aeson.Parser - Data.Aeson.Types -- Data.Aeson.TH - - other-modules: - Data.Aeson.Functions --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch b/standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch deleted file mode 100644 index e959941b8..000000000 --- a/standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch +++ /dev/null @@ -1,25 +0,0 @@ -From 55f424de9946c4d1d89837bb18698437aecfcfa4 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:29:16 -0400 -Subject: [PATCH] allow building with unreleased ghc - ---- - async.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/async.cabal b/async.cabal -index 8e47d9d..ff317c7 100644 ---- a/async.cabal -+++ b/async.cabal -@@ -70,7 +70,7 @@ source-repository head - - library - exposed-modules: Control.Concurrent.Async -- build-depends: base >= 4.3 && < 4.7, stm >= 2.2 && < 2.5 -+ build-depends: base >= 4.3 && < 4.8, stm >= 2.2 && < 2.5 - - test-suite test-async - type: exitcode-stdio-1.0 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/case-insensitive_0.4.0.1_0001-allow-building-with-unreleased-ghc.patch b/standalone/android/haskell-patches/case-insensitive_0.4.0.1_0001-allow-building-with-unreleased-ghc.patch deleted file mode 100644 index 2d7c45089..000000000 --- a/standalone/android/haskell-patches/case-insensitive_0.4.0.1_0001-allow-building-with-unreleased-ghc.patch +++ /dev/null @@ -1,27 +0,0 @@ -From efd0e93de82c0b5554a4f3a4517e6127f405f6da Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:29:36 -0400 -Subject: [PATCH] allow building with unreleased ghc - ---- - case-insensitive.cabal | 4 ++-- - 1 file changed, 2 insertions(+), 2 deletions(-) - -diff --git a/case-insensitive.cabal b/case-insensitive.cabal -index a73479d..18a1a51 100644 ---- a/case-insensitive.cabal -+++ b/case-insensitive.cabal -@@ -25,8 +25,8 @@ source-repository head - - Library - GHC-Options: -Wall -- build-depends: base >= 3 && < 4.6 -- , bytestring >= 0.9 && < 0.10 -+ build-depends: base >= 3 && < 4.8 -+ , bytestring >= 0.9 && < 0.15 - , text >= 0.3 && < 0.12 - , hashable >= 1.0 && < 1.2 - exposed-modules: Data.CaseInsensitive --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/certificate_1.3.7-0001-support-Android-cert-store.patch b/standalone/android/haskell-patches/certificate_1.3.7-0001-support-Android-cert-store.patch deleted file mode 100644 index 5f772bfdf..000000000 --- a/standalone/android/haskell-patches/certificate_1.3.7-0001-support-Android-cert-store.patch +++ /dev/null @@ -1,37 +0,0 @@ -From 3779c75175e895f94b21341ebd6361e9d6af54fd Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 9 May 2013 12:36:23 -0400 -Subject: [PATCH] support Android cert store - -Android puts it in a different place and has only hashed files. -See https://github.com/vincenthz/hs-certificate/issues/19 ---- - System/Certificate/X509/Unix.hs | 5 +++-- - 1 file changed, 3 insertions(+), 2 deletions(-) - -diff --git a/System/Certificate/X509/Unix.hs b/System/Certificate/X509/Unix.hs -index 8463465..74e9503 100644 ---- a/System/Certificate/X509/Unix.hs -+++ b/System/Certificate/X509/Unix.hs -@@ -35,7 +35,8 @@ import qualified Control.Exception as E - import Data.Char - - defaultSystemPath :: FilePath --defaultSystemPath = "/etc/ssl/certs/" -+defaultSystemPath = "/system/etc/security/cacerts/" -+--defaultSystemPath = "/etc/ssl/certs/" - - envPathOverride :: String - envPathOverride = "SYSTEM_CERTIFICATE_PATH" -@@ -47,7 +48,7 @@ listDirectoryCerts path = (map (path </>) . filter isCert <$> getDirectoryConten - && isDigit (s !! 9) - && (s !! 8) == '.' - && all isHexDigit (take 8 s) -- isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x) -+ isCert x = (not $ isPrefixOf "." x) - - getSystemCertificateStore :: IO CertificateStore - getSystemCertificateStore = makeCertificateStore . concat <$> (getSystemPath >>= listDirectoryCerts >>= mapM readCertificates) --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/cipher-aes_0.1.7-0001-fix-cross-build.patch b/standalone/android/haskell-patches/cipher-aes_0.1.7-0001-fix-cross-build.patch deleted file mode 100644 index fab0ae6ef..000000000 --- a/standalone/android/haskell-patches/cipher-aes_0.1.7-0001-fix-cross-build.patch +++ /dev/null @@ -1,34 +0,0 @@ -From d456247000ab839a1d32749717f4f8f92e37dbba Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 7 May 2013 17:45:45 -0400 -Subject: [PATCH] fix cross build - ---- - cipher-aes.cabal | 5 +---- - 1 file changed, 1 insertion(+), 4 deletions(-) - -diff --git a/cipher-aes.cabal b/cipher-aes.cabal -index 02ddfd0..eb916e3 100644 ---- a/cipher-aes.cabal -+++ b/cipher-aes.cabal -@@ -31,16 +31,13 @@ Extra-Source-Files: Tests/*.hs - - Library - Build-Depends: base >= 4 && < 5 -- , bytestring -+ , bytestring >= 0.10.3.0 - Exposed-modules: Crypto.Cipher.AES - ghc-options: -Wall - C-sources: cbits/aes_generic.c - cbits/aes.c - cbits/gf.c - cbits/cpu.c -- if os(linux) && (arch(i386) || arch(x86_64)) -- CC-options: -mssse3 -maes -mpclmul -DWITH_AESNI -- C-sources: cbits/aes_x86ni.c - - Test-Suite test-cipher-aes - type: exitcode-stdio-1.0 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/dns_0.3.6-0001-use-getprop-to-get-dns-server.patch b/standalone/android/haskell-patches/dns_0.3.6-0001-use-getprop-to-get-dns-server.patch deleted file mode 100644 index 069bdd20a..000000000 --- a/standalone/android/haskell-patches/dns_0.3.6-0001-use-getprop-to-get-dns-server.patch +++ /dev/null @@ -1,73 +0,0 @@ -From 8459f93270c7a6e8a2ebd415db2110a66bf1ec41 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Wed, 15 May 2013 20:31:14 -0400 -Subject: [PATCH] use getprop to get dns server - ---- - Network/DNS/Resolver.hs | 13 +++++++++++-- - dns.cabal | 4 ++++ - 2 files changed, 15 insertions(+), 2 deletions(-) - -diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs -index 70ab9ed..9b27336 100644 ---- a/Network/DNS/Resolver.hs -+++ b/Network/DNS/Resolver.hs -@@ -41,6 +41,8 @@ import Network.Socket.ByteString.Lazy - import Prelude hiding (lookup) - import System.Random - import System.Timeout -+import System.Process (readProcess) -+import System.Directory - - #if mingw32_HOST_OS == 1 - import Network.Socket (send) -@@ -73,7 +75,7 @@ data ResolvConf = ResolvConf { - -} - defaultResolvConf :: ResolvConf - defaultResolvConf = ResolvConf { -- resolvInfo = RCFilePath "/etc/resolv.conf" -+ resolvInfo = RCFilePath "/system/etc/resolv.conf" - , resolvTimeout = 3 * 1000 * 1000 - , resolvBufsize = 512 - } -@@ -111,7 +113,14 @@ makeResolvSeed conf = ResolvSeed <$> addr - where - addr = case resolvInfo conf of - RCHostName numhost -> makeAddrInfo numhost -- RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo -+ RCFilePath file -> do -+ exists <- doesFileExist file -+ if exists -+ then toAddr <$> readFile file >>= makeAddrInfo -+ else do -+ s <- readProcess "getprop" ["net.dns1"] "" -+ makeAddrInfo $ takeWhile (/= '\n') s -+ - toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs - in extract l - extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11 -diff --git a/dns.cabal b/dns.cabal -index 40671f6..2c19734 100644 ---- a/dns.cabal -+++ b/dns.cabal -@@ -34,6 +34,8 @@ library - , network >= 2.3 - , network-conduit - , random -+ , process -+ , directory - else - Build-Depends: base >= 4 && < 5 - , attoparsec -@@ -49,6 +51,8 @@ library - , network-bytestring - , network-conduit - , random -+ , process -+ , directory - Source-Repository head - Type: git - Location: git://github.com/kazu-yamamoto/dns.git --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/file-embed_0.0.4.7-0001-remove-TH-and-export-one-symbol-used-by-TH.patch b/standalone/android/haskell-patches/file-embed_0.0.4.7-0001-remove-TH-and-export-one-symbol-used-by-TH.patch deleted file mode 100644 index ff50d3947..000000000 --- a/standalone/android/haskell-patches/file-embed_0.0.4.7-0001-remove-TH-and-export-one-symbol-used-by-TH.patch +++ /dev/null @@ -1,193 +0,0 @@ -From 256ff157005f44c97fa5affe2ed9655815b3788e Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 12:38:22 -0400 -Subject: [PATCH] remove TH and export one symbol used by TH - ---- - Data/.FileEmbed.hs.swp | Bin 16384 -> 0 bytes - Data/FileEmbed.hs | 80 +++---------------------------------------------- - 2 files changed, 4 insertions(+), 76 deletions(-) - delete mode 100644 Data/.FileEmbed.hs.swp - -diff --git a/Data/.FileEmbed.hs.swp b/Data/.FileEmbed.hs.swp -deleted file mode 100644 -index 1b2ddbfaa71697e9df3869555aee8c97ca7ea0cb..0000000000000000000000000000000000000000 -GIT binary patch -literal 0 -HcmV?d00001 - -literal 16384 -zcmeHNZEPGz8J?z;l0w=5RfRyn>$8>HBX?)xk`I~qq+D`I3}?sToJzq>+`YRw-^O>l -z*WKCLCgwvzNFb1);!i<T;wykkiv)sSh>r*%6;!D~AU?_ukSIa|0TNP$5Jm93GrM~q -zjuRvP0NRxw-|fsh@60^&&O0;jTz%?+xp_KLykFqiFT`)B+;d-j<zDfRmkV*(lbf7; -zt7p{>ZzZDh-@^(gRkt_UayqggyLH(tOcke!Zz&#`JZUR?@)Xi5oLp=NyHc47r3|DD -z?1q6*wF*b~iTkJDJT;yfqgTJ`{BBC6GARQo11SS311SS311SS311SS31OG=1sNNp& -zPxNOGa0R$6!tMCX1MiLA@sU0$11SS311SS311SS311SS311SS311SS311SUlqYT(h -zA*RvxX$}D3{-0w2zq&_=9|B(oJ`TJeP{1ls23`y71@-_h+%3fOz|Vo70p9>V3^ahF -zz%+0#un)Kc_}e}qegu3C_%d)6aDW-$b-)X+5aMazbHMw6w*zCq9^f|M$M{{sb>Io$ -zDsTmu2a3QOfxq4*#4mxL0AB%~0z$wCs=#SrKk&!BLOct68+a6001g9(fV+S@fnUE& -zh$n$h0-pdb0VUu*;P-b5@f+Y7;Bnwnz!hK(r~;F~i!T-8@4!!iYruDb&jKF=LO=l} -z;0?g*f#>cJ;yXYO7zh6R5+S|?d;oYSa0ECE>;;}ffaVv#4}hnDCxOR-j{zSATEGS1 -zUf>TH+wTKwz-8bZPyu+%$AEi)y8$7HpN>=%&@2UQZ=IZNDccep(X*R1=Uo!Qv&r|F -z8Jcqy6-rc7zT>V&%DFV2<%^snec$sb!$18fCO`ckYgMW_*Oh*5hAw!aPtCB~-K3yr -zHzc*~fa+4Z)bM;i>?!<IBqOxS=%3}}X(cza!urcaWv_9wd>JSs<)EY;NTk@!fF`JX -zv>3Y3yhZ_fP_B{J(t=EaWs>r`cn*w|i$SmBsN>)V!d0{a3W`nN>yg!w?y722*IsoR -zIjW1e6I2H&$qQI17t5PU8d6Ln`|m=;if3thDtR$n3Za#w9SzTI*ou}jEt$zvX1<oW -z80A4Srn}>`)S~V9(`4Css&o76R4UEVgY_)e>q`~-uF1^iL|+^_<~`SLQkP~+I={=s -zQKTEGGGiGjn24J*LHx6xfM%%a_<^B28kDZxn<tC2t4^S@%zkGHtQDyhsGJt%GIXrK -zI+XMw-SlK|((z?OdH!Z)1LYtdxXm2dolcf}GE@ba=Q{e`fUpEnO%Tq5&Guz#GOZk~ -zit~4_h0Q@%JInQuWhu1&*kmb32M!z{>%k4fsOc5bDaxmfoNn(4&sEY@h7~A^-}^l# -z*HdSlW)ntrY@$T4n56TGuod$b)sPe1mtjh|;#q2X16deQ?%kpd`@|>?exEx_%T}C_ -zAF|EdMR<`&z3$E|k4;n?*OJNf^GB+<h1z~sSJ2iaKa`@MWMzxlnH4tIQ+6j9%o(Yq -z?0Fqb80}q_yfV8i%x0d;gNZ1#(_CZYjE#7Vj`w;MYRgVf`ZO^{RYz6$(-f{!qish< -z&9<Q5OofsAsGG5k6u`Qcw`ibkTNgz=Sn?_xJ*sm{F+lM<S~%(x&JhHMXW1Ang=pZi -zX;;#$9tJf}a-)~MsHX#eW21_dqgmt9Z92xQJ$$^`JSlrffHCs0!-1{%o~P*GLCQ{M -zF?U&^7<XDUKew>*K;<2^xw8u^N_Kl4Tger;-!<9kSkw6<`KcV7z2los87-D+PCek^ -zLl^t`BV)Id&9Qw(oi{T8dSa_%FN!%qBdTt0YlQ+WwVi<Qr`nR%J%6q3`B(tF7G?D> -z5TP<F3I+Vp7M<pK&i>1|9a6r;`r+!bsHn?+u{b<1RC87<BuQ=d%m^_3JSQu9B3qUp -zx+rSABd1fVm(z~ec&t80NH-n|s#wXg+PcZ?B$!m(0jM;DCkZ1Y8BWnfIPpy;ah4{m -zL^y*EFW6m~$uSGD2viLE2E9u6m#TqP44#6EnX*o|=lO~r4sEz%M>c7s9Hdxqiz@s( -z&mpowdKmc5BeJu}oNw~lAK)LB{f5_+n)igwzE@B9jBNhq1`no6rCl4irbtf|X4vqp -zUvI{*7Dx!zZ!yFAm#@QA$LdCS8sPUoVK>0m3)8&CbN$AgMgvyc3^2>}HcT%Rmc`3k -zP7G(yoh_bs1G^>33iaor^jn_aojaRIj`m|j9_|@V2ph5h`=_K3FLA!tDZ&YN9PDji -z1XyIT5cXS;h+xyWj!Z1PxqP(7Cwg`?yW$D>@1um>WBF*@ryYg0SS%ISYxYFEiQ)Z; -znW(&iY<q6BbSDjrXvP$bJj@ODIeEBF8L(aG4M|>b6}dsP&eOTj4jgNnKZn#VT{r8* -z&X#?XFyGG&*MNnFtZ4Pi^Il%AO25j@;8oca8J01^i@wvX4i&g{iw^N(!YVCZ_{ie5 -zIB%RNe<-~0>X+BPHsP{ryQ`tSDvM{#s#IJ$Q><;e%HA*@I!Ehm>Bnt#+{>VxS=BY= -zF&#KzxYPQmQR9=wZiq~pO$3+rCXmD$p;&ojyI7Us(3D+IYBZJ+RUdm_{YsR08vSk= -zg^`cMe#7hbcnT}0D@E69hWM^0nzj=5q~c0poT|qcPM<%1x<V%w7iqlk?%~9xXcdp> -z(gJ+`e*))O7w26*|L5^>9q0OIfiD6d0UiM^0B;5E1O9|_{L{cS;4xqcI0Wnm{(>|7 -zmw?Xzp9a=}67W3E?$?2D0$%_Kcn$C(&g|EKEnpEi415pg^Q*w;fe!&Iz!6{^xE=T% -z+WHLe7{KlB0_l@7kTQ@mkTQ@mkTQ@m@ZZS*MbFzpgaMiW!X4$}y6-5-8#zuowaEXY -zO(D^Or`kBev0xM}pL2t-)p8mRLO6q=aT5mD!ELj%<qa+cej^TP^H)R_1`f_hIkhN^ -zw5~rYVcLNII*1cD8lPwdLK)W3;Rk74Rv#L%3%*2NsCpry9Pv&&D!)xG4k{VRfmYyb -zJs1!(n|Zs1V;33}#oIYfuH*9AgetCQ@LpkJ`^|!>WS92}IBf8pMleGe4v*>U5U#dd -z8>({f!okrwx^0Nk@8+Ii=#C-#?_Dw^w;EPm;t(zeFDmK?6|dF8x(Pv&6-7o7z1H^= -zp6{&cwkmJVy<FA2MmHEb1$q6m6XD@QA8E7YE00EW0TI_bq#a>o6NW|1E4~>r)#MRJ -zMs<S%zBC7Z9QQSC1tU_;QFbbuCq3#WvdOJL2+xhDgx~}mEu$Wk^qov(%qEezmx$W1 -zARZXtyuDeML&nADtV`s|bt>2LC=hGcn)&p|kwa&PDJQgEt$EO3jZUuIaqSKi^9_lz -z9hWDvK4Heq9I<p$5b<H0AC0Nv(9@6J#<6O?9MBhJS$c?1$`2tJ({qyV`Zg=dz?jDA -zI%FLM82bu1%(xZ5BBIDW(h77&6yq6+*+fEI<Dg6&2a2*eNY0hd>f<{sAr2sLAk_D| -z`qc+J6D-CzXMwU2H^e;Cr|*ba{SoCH#C(s9#asr$L<aeZ%jg>#<yG9U%QsA@jlbq- -zVmD{{!*M8LFw8#`bk_k6DC6o_$TW{HhA_3Xr+|~_=du%-O(ufrT|dkaU2AGbJCF*) -k07GoDCUU!rsE!Us=xSj*161jGRmD&g5~lU!(k&JL0(zanmH+?% - -diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs -index 66f7004..f8c98c9 100644 ---- a/Data/FileEmbed.hs -+++ b/Data/FileEmbed.hs -@@ -1,31 +1,15 @@ --{-# LANGUAGE TemplateHaskell #-} - {-# LANGUAGE CPP #-} - module Data.FileEmbed - ( -- * Embed at compile time -- embedFile -- , embedDir -- , getDir -+ getDir - -- * Inject into an executable --#if MIN_VERSION_template_haskell(2,5,0) -- , dummySpace --#endif - , inject - , injectFile -+ -+ -- used by TH (pointlessly) -+ , stringToBs - ) where - --import Language.Haskell.TH.Syntax -- ( Exp (AppE, ListE, LitE, TupE, SigE) --#if MIN_VERSION_template_haskell(2,5,0) -- , Lit (StringL, StringPrimL, IntegerL) --#else -- , Lit (StringL, IntegerL) --#endif -- , Q -- , runIO --#if MIN_VERSION_template_haskell(2,7,0) -- , Quasi(qAddDependentFile) --#endif -- ) - import System.Directory (doesDirectoryExist, doesFileExist, - getDirectoryContents) - import Control.Monad (filterM) -@@ -37,51 +21,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 directory recusrively 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 - -@@ -123,23 +68,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 - -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/hS3_0.5.7_0001-fix-build.patch b/standalone/android/haskell-patches/hS3_0.5.7_0001-fix-build.patch deleted file mode 100644 index c0158c0f4..000000000 --- a/standalone/android/haskell-patches/hS3_0.5.7_0001-fix-build.patch +++ /dev/null @@ -1,23 +0,0 @@ -From 643b3c9fd95967c5911107f46498cd851e68f97d Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 7 May 2013 18:26:33 -0400 -Subject: [PATCH] fix build - ---- - hS3.cabal | 3 --- - 1 file changed, 3 deletions(-) - -diff --git a/hS3.cabal b/hS3.cabal -index 35f7496..e04bf65 100644 ---- a/hS3.cabal -+++ b/hS3.cabal -@@ -44,6 +44,3 @@ Library - Network.AWS.AWSConnection, - Network.AWS.Authentication, - Network.AWS.ArrowUtils -- --Executable hs3 -- main-is: hS3.hs --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/libxml-sax_0.7.3-0001-static-link-with-libxml2.patch b/standalone/android/haskell-patches/libxml-sax_0.7.3-0001-static-link-with-libxml2.patch deleted file mode 100644 index 752f601cc..000000000 --- a/standalone/android/haskell-patches/libxml-sax_0.7.3-0001-static-link-with-libxml2.patch +++ /dev/null @@ -1,27 +0,0 @@ -From 9d53e3fa4516a948a6e84987e9c1c9fd07f973bf Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Sun, 21 Apr 2013 15:44:51 -0400 -Subject: [PATCH] static link with libxml2 - -This requires libxml2.a (and no .so) be installed in the ugly hardcoded -lib dir. When built this way, the haskell library will link the -C library into executables with no further options. ---- - libxml-sax.cabal | 1 + - 1 file changed, 1 insertion(+) - -diff --git a/libxml-sax.cabal b/libxml-sax.cabal -index 5edfdb6..338bc55 100644 ---- a/libxml-sax.cabal -+++ b/libxml-sax.cabal -@@ -31,6 +31,7 @@ library - hs-source-dirs: lib - ghc-options: -Wall -O2 - cc-options: -Wall -+ LD-Options: -L /home/joey/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/sysroot/usr/lib/ - - build-depends: - base >= 4.1 && < 5.0 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/monad-control_0.3.1.4_0001-build-with-newer-ghc.patch b/standalone/android/haskell-patches/monad-control_0.3.1.4_0001-build-with-newer-ghc.patch deleted file mode 100644 index ee1c996d8..000000000 --- a/standalone/android/haskell-patches/monad-control_0.3.1.4_0001-build-with-newer-ghc.patch +++ /dev/null @@ -1,25 +0,0 @@ -From 3dde0175096903207c9774d8f6bba9b81ab6c2f9 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:31:45 -0400 -Subject: [PATCH] build with newer ghc - ---- - monad-control.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/monad-control.cabal b/monad-control.cabal -index 2e3eb46..b12ffaf 100644 ---- a/monad-control.cabal -+++ b/monad-control.cabal -@@ -56,7 +56,7 @@ Library - - Exposed-modules: Control.Monad.Trans.Control - -- Build-depends: base >= 3 && < 4.7 -+ Build-depends: base >= 3 && < 4.8 - , base-unicode-symbols >= 0.1.1 && < 0.3 - , transformers >= 0.2 && < 0.4 - , transformers-base >= 0.4.1 && < 0.5 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/monad-logger_0.2.3.2_0001-remove-TH-logging-stuff.patch b/standalone/android/haskell-patches/monad-logger_0.2.3.2_0001-remove-TH-logging-stuff.patch deleted file mode 100644 index e684c67a7..000000000 --- a/standalone/android/haskell-patches/monad-logger_0.2.3.2_0001-remove-TH-logging-stuff.patch +++ /dev/null @@ -1,124 +0,0 @@ -From ca88563e63cc31f0b96b00d3a4fe1f0c56b1e1eb Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:32:01 -0400 -Subject: [PATCH] remove TH logging stuff - ---- - Control/Monad/Logger.hs | 76 ----------------------------------------------- - monad-logger.cabal | 2 +- - 2 files changed, 1 insertion(+), 77 deletions(-) - -diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs -index fd1282b..80b8ed9 100644 ---- a/Control/Monad/Logger.hs -+++ b/Control/Monad/Logger.hs -@@ -27,18 +27,6 @@ module Control.Monad.Logger - , LoggingT (..) - , runStderrLoggingT - , runStdoutLoggingT -- -- * TH logging -- , logDebug -- , logInfo -- , logWarn -- , logError -- , logOther -- -- * TH logging with source -- , logDebugS -- , logInfoS -- , logWarnS -- , logErrorS -- , logOtherS - ) where - - import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation) -@@ -91,13 +79,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) ) - data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text - deriving (Eq, Prelude.Show, Prelude.Read, Ord) - --instance Lift LogLevel where -- lift LevelDebug = [|LevelDebug|] -- lift LevelInfo = [|LevelInfo|] -- lift LevelWarn = [|LevelWarn|] -- lift LevelError = [|LevelError|] -- lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|] -- - type LogSource = Text - - class Monad m => MonadLogger m where -@@ -128,63 +109,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF - instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF - #undef DEF - --logTH :: LogLevel -> Q Exp --logTH level = -- [|monadLoggerLog $(qLocation >>= liftLoc) $(lift level) . (id :: Text -> Text)|] -- ---- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage: ---- ---- > $(logDebug) "This is a debug log message" --logDebug :: Q Exp --logDebug = logTH LevelDebug -- ---- | See 'logDebug' --logInfo :: Q Exp --logInfo = logTH LevelInfo ---- | See 'logDebug' --logWarn :: Q Exp --logWarn = logTH LevelWarn ---- | See 'logDebug' --logError :: Q Exp --logError = logTH LevelError -- ---- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage: ---- ---- > $(logOther "My new level") "This is a log message" --logOther :: Text -> Q Exp --logOther = logTH . LevelOther -- --liftLoc :: Loc -> Q Exp --liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc -- $(lift a) -- $(lift b) -- $(lift c) -- ($(lift d1), $(lift d2)) -- ($(lift e1), $(lift e2)) -- |] -- ---- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage: ---- ---- > $logDebug "SomeSource" "This is a debug log message" --logDebugS :: Q Exp --logDebugS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|] -- ---- | See 'logDebugS' --logInfoS :: Q Exp --logInfoS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|] ---- | See 'logDebugS' --logWarnS :: Q Exp --logWarnS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|] ---- | See 'logDebugS' --logErrorS :: Q Exp --logErrorS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelError (b :: Text)|] -- ---- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage: ---- ---- > $logOther "SomeSource" "My new level" "This is a log message" --logOtherS :: Q Exp --logOtherS = [|\src level msg -> monadLoggerLogSource $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|] -- - -- | Monad transformer that adds a new logging function. - -- - -- Since 0.2.2 -diff --git a/monad-logger.cabal b/monad-logger.cabal -index ab71424..fa3d292 100644 ---- a/monad-logger.cabal -+++ b/monad-logger.cabal -@@ -24,4 +24,4 @@ library - , transformers-base - , monad-control - , mtl -- , bytestring -+ , bytestring >= 0.10.3.0 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/network-conduit_0.6.2.2_0001-NoDelay-does-not-work-on-Android.patch b/standalone/android/haskell-patches/network-conduit_0.6.2.2_0001-NoDelay-does-not-work-on-Android.patch deleted file mode 100644 index 35bafa774..000000000 --- a/standalone/android/haskell-patches/network-conduit_0.6.2.2_0001-NoDelay-does-not-work-on-Android.patch +++ /dev/null @@ -1,43 +0,0 @@ -From 3e05f3a3bf886c302fb6d6caa7ee92cf9736b6ad Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:33:45 -0400 -Subject: [PATCH] NoDelay does not work on Android - -(I think the other change is no-op) ---- - Data/Conduit/Network/Utils.hs | 6 +++--- - 1 file changed, 3 insertions(+), 3 deletions(-) - -diff --git a/Data/Conduit/Network/Utils.hs b/Data/Conduit/Network/Utils.hs -index 32a7286..01ff84e 100644 ---- a/Data/Conduit/Network/Utils.hs -+++ b/Data/Conduit/Network/Utils.hs -@@ -6,14 +6,14 @@ module Data.Conduit.Network.Utils - , getSocket - ) where - --import Network.Socket (AddrInfo, Socket, SocketType) -+import Network.Socket (Socket, SocketType) - import qualified Network.Socket as NS - import Data.String (IsString (fromString)) - import Control.Exception (bracketOnError, IOException) - import qualified Control.Exception as E - - -- | Attempt to connect to the given host/port using given @SocketType@. --getSocket :: String -> Int -> SocketType -> IO (Socket, AddrInfo) -+getSocket :: String -> Int -> SocketType -> IO (Socket, NS.AddrInfo) - getSocket host' port' sockettype = do - let hints = NS.defaultHints { - NS.addrFlags = [NS.AI_ADDRCONFIG] -@@ -93,7 +93,7 @@ bindPort p s sockettype = do - sockOpts = - case sockettype of - NS.Datagram -> [(NS.ReuseAddr,1)] -- _ -> [(NS.NoDelay,1), (NS.ReuseAddr,1)] -+ _ -> [(NS.ReuseAddr,1)] -- Android seems to not have NoDelay - - theBody addr = - bracketOnError --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/network-protocol-xmpp_0.4.4-0001-avoid-using-gnuidn.patch b/standalone/android/haskell-patches/network-protocol-xmpp_0.4.4-0001-avoid-using-gnuidn.patch deleted file mode 100644 index 26734fa70..000000000 --- a/standalone/android/haskell-patches/network-protocol-xmpp_0.4.4-0001-avoid-using-gnuidn.patch +++ /dev/null @@ -1,60 +0,0 @@ -From d15ae2193eff9cd38ebce641279996233434b50f Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Sun, 21 Apr 2013 16:05:53 -0400 -Subject: [PATCH] avoid using gnuidn - -IDN is only used to handle the domain name part of a XMPP server JID. -Which seems not worth the bloat on Android. ---- - lib/Network/Protocol/XMPP/JID.hs | 11 ++++------- - network-protocol-xmpp.cabal | 1 - - 2 files changed, 4 insertions(+), 8 deletions(-) - -diff --git a/lib/Network/Protocol/XMPP/JID.hs b/lib/Network/Protocol/XMPP/JID.hs -index 91745e0..2a50409 100644 ---- a/lib/Network/Protocol/XMPP/JID.hs -+++ b/lib/Network/Protocol/XMPP/JID.hs -@@ -29,7 +29,6 @@ module Network.Protocol.XMPP.JID - - import qualified Data.Text - import Data.Text (Text) --import qualified Data.Text.IDN.StringPrep as SP - import Data.String (IsString, fromString) - - newtype Node = Node { strNode :: Text } -@@ -85,16 +84,14 @@ parseJID str = maybeJID where - then Just Nothing - else fmap Just (f x) - maybeJID = do -- preppedNode <- nullable node (stringprepM SP.xmppNode) -- preppedDomain <- stringprepM SP.nameprep domain -- preppedResource <- nullable resource (stringprepM SP.xmppResource) -+ preppedNode <- nullable node (stringprepM id) -+ preppedDomain <- stringprepM id domain -+ preppedResource <- nullable resource (stringprepM id) - return $ JID - (fmap Node preppedNode) - (Domain preppedDomain) - (fmap Resource preppedResource) -- stringprepM p x = case SP.stringprep p SP.defaultFlags x of -- Left _ -> Nothing -- Right y -> Just y -+ stringprepM p x = Just x - - parseJID_ :: Text -> JID - parseJID_ text = case parseJID text of -diff --git a/network-protocol-xmpp.cabal b/network-protocol-xmpp.cabal -index 807cda9..3aaad67 100644 ---- a/network-protocol-xmpp.cabal -+++ b/network-protocol-xmpp.cabal -@@ -30,7 +30,6 @@ library - build-depends: - base >= 4.0 && < 5.0 - , bytestring >= 0.9 -- , gnuidn >= 0.2 && < 0.3 - , gnutls >= 0.1.4 && < 0.3 - , gsasl >= 0.3 && < 0.4 - , libxml-sax >= 0.7 && < 0.8 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/resourcet_0.4.4_0001-hack-to-build-with-hacked-up-lifted-base-which-is-cu.patch b/standalone/android/haskell-patches/resourcet_0.4.4_0001-hack-to-build-with-hacked-up-lifted-base-which-is-cu.patch deleted file mode 100644 index bcf3439fa..000000000 --- a/standalone/android/haskell-patches/resourcet_0.4.4_0001-hack-to-build-with-hacked-up-lifted-base-which-is-cu.patch +++ /dev/null @@ -1,44 +0,0 @@ -From c10ab80793a21dce0c7516725e1ca3b36a87aa25 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:35:08 -0400 -Subject: [PATCH] hack to build with hacked up lifted-base, which is currently - lacking a mask - ---- - Control/Monad/Trans/Resource.hs | 6 +++--- - 1 file changed, 3 insertions(+), 3 deletions(-) - -diff --git a/Control/Monad/Trans/Resource.hs b/Control/Monad/Trans/Resource.hs -index d209dd8..61ab349 100644 ---- a/Control/Monad/Trans/Resource.hs -+++ b/Control/Monad/Trans/Resource.hs -@@ -5,7 +5,7 @@ - {-# LANGUAGE TypeFamilies #-} - {-# LANGUAGE RankNTypes #-} - {-# LANGUAGE CPP #-} --{-# LANGUAGE DeriveDataTypeable #-} -+{-# LANGUAGE DeriveDataTypeable, ImpredicativeTypes #-} - #if __GLASGOW_HASKELL__ >= 704 - {-# LANGUAGE ConstraintKinds #-} - #endif -@@ -554,7 +554,7 @@ GOX(Monoid w, Strict.WriterT w) - -- - -- Since 0.3.0 - resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId --resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore -> -+resourceForkIO (ResourceT f) = ResourceT $ \r -> - -- We need to make sure the counter is incremented before this call - -- returns. Otherwise, the parent thread may call runResourceT before - -- the child thread increments, and all resources will be freed -@@ -565,7 +565,7 @@ resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore -> - (liftBaseDiscard forkIO $ bracket_ - (return ()) - (stateCleanup r) -- (restore $ f r)) -+ (return ())) - - -- | A @Monad@ based on some monad which allows running of some 'IO' actions, - -- via unsafe calls. This applies to 'IO' and 'ST', for instance. --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch deleted file mode 100644 index 60528db0d..000000000 --- a/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch +++ /dev/null @@ -1,162 +0,0 @@ -From b128412ecee9677b788abecbbf1fd1edd447eea2 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:35:59 -0400 -Subject: [PATCH] remove TH - ---- - Text/Shakespeare/I18N.hs | 130 +--------------------------------------------- - 1 file changed, 1 insertion(+), 129 deletions(-) - -diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs -index 1b486ed..aa5e358 100644 ---- a/Text/Shakespeare/I18N.hs -+++ b/Text/Shakespeare/I18N.hs -@@ -51,10 +51,7 @@ - -- - -- You can also adapt those instructions for use with other systems. - module Text.Shakespeare.I18N -- ( mkMessage -- , mkMessageFor -- , mkMessageVariant -- , RenderMessage (..) -+ ( RenderMessage (..) - , ToMessage (..) - , SomeMessage (..) - , Lang -@@ -115,133 +112,8 @@ type Lang = Text - -- - -- 3. create a 'RenderMessage' instance - -- --mkMessage :: String -- ^ base name to use for translation type -- -> FilePath -- ^ subdirectory which contains the translation files -- -> Lang -- ^ default translation language -- -> Q [Dec] --mkMessage dt folder lang = -- mkMessageCommon True "Msg" "Message" dt dt folder lang - - ---- | create 'RenderMessage' instance for an existing data-type --mkMessageFor :: String -- ^ master translation data type -- -> String -- ^ existing type to add translations for -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default language -- -> Q [Dec] --mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang -- ---- | create an additional set of translations for a type created by `mkMessage` --mkMessageVariant :: String -- ^ master translation data type -- -> String -- ^ existing type to add translations for -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default language -- -> Q [Dec] --mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang -- ---- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type --mkMessageCommon :: Bool -- ^ generate a new datatype from the constructors found in the .msg files -- -> String -- ^ string to append to constructor names -- -> String -- ^ string to append to datatype name -- -> String -- ^ base name of master datatype -- -> String -- ^ base name of translation datatype -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default lang -- -> Q [Dec] --mkMessageCommon genType prefix postfix master dt folder lang = do -- files <- qRunIO $ getDirectoryContents folder -- (_files', contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files --#ifdef GHC_7_4 -- mapM_ qAddDependentFile _files' --#endif -- sdef <- -- case lookup lang contents of -- Nothing -> error $ "Did not find main language file: " ++ unpack lang -- Just def -> toSDefs def -- mapM_ (checkDef sdef) $ map snd contents -- let mname = mkName $ dt ++ postfix -- c1 <- fmap concat $ mapM (toClauses prefix dt) contents -- c2 <- mapM (sToClause prefix dt) sdef -- c3 <- defClause -- return $ -- ( if genType -- then ((DataD [] mname [] (map (toCon dt) sdef) []) :) -- else id) -- [ InstanceD -- [] -- (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname) -- [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3] -- ] -- ] -- --toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause] --toClauses prefix dt (lang, defs) = -- mapM go defs -- where -- go def = do -- a <- newName "lang" -- (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def) -- guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|] -- return $ Clause -- [WildP, ConP (mkName ":") [VarP a, WildP], pat] -- (GuardedB [(guard, bod)]) -- [] -- --mkBody :: String -- ^ datatype -- -> String -- ^ constructor -- -> [String] -- ^ variable names -- -> [Content] -- -> Q (Pat, Exp) --mkBody dt cs vs ct = do -- vp <- mapM go vs -- let pat = RecP (mkName cs) (map (varName dt *** VarP) vp) -- let ct' = map (fixVars vp) ct -- pack' <- [|Data.Text.pack|] -- tomsg <- [|toMessage|] -- let ct'' = map (toH pack' tomsg) ct' -- mapp <- [|mappend|] -- let app a b = InfixE (Just a) mapp (Just b) -- e <- -- case ct'' of -- [] -> [|mempty|] -- [x] -> return x -- (x:xs) -> return $ foldl' app x xs -- return (pat, e) -- where -- toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String) -- toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d -- go x = do -- let y = mkName $ '_' : x -- return (x, y) -- fixVars vp (Var d) = Var $ fixDeref vp d -- fixVars _ (Raw s) = Raw s -- fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i -- fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b) -- fixDeref _ d = d -- fixIdent vp i = -- case lookup i vp of -- Nothing -> i -- Just y -> nameBase y -- --sToClause :: String -> String -> SDef -> Q Clause --sToClause prefix dt sdef = do -- (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef) -- return $ Clause -- [WildP, ConP (mkName "[]") [], pat] -- (NormalB bod) -- [] -- --defClause :: Q Clause --defClause = do -- a <- newName "sub" -- c <- newName "langs" -- d <- newName "msg" -- rm <- [|renderMessage|] -- return $ Clause -- [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d] -- (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) -- [] -- - toCon :: String -> SDef -> Con - toCon dt (SDef c vs _) = - RecC (mkName $ "Msg" ++ c) $ map go vs --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/split_0.2.1.2_0001-modify-to-build-with-unreleased-ghc.patch b/standalone/android/haskell-patches/split_0.2.1.2_0001-modify-to-build-with-unreleased-ghc.patch deleted file mode 100644 index 472ccd678..000000000 --- a/standalone/android/haskell-patches/split_0.2.1.2_0001-modify-to-build-with-unreleased-ghc.patch +++ /dev/null @@ -1,25 +0,0 @@ -From 2feaef797641587a3da83753ee17d20e712c79cf Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:36:30 -0400 -Subject: [PATCH] modify to build with unreleased ghc - ---- - split.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/split.cabal b/split.cabal -index 2183c3e..29b9b32 100644 ---- a/split.cabal -+++ b/split.cabal -@@ -51,7 +51,7 @@ Source-repository head - - Library - ghc-options: -Wall -- build-depends: base <4.7 -+ build-depends: base <4.8 - exposed-modules: Data.List.Split, Data.List.Split.Internals - default-language: Haskell2010 - Hs-source-dirs: src --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/syb_0.3.7_0001-hack-for-cross-compiling.patch b/standalone/android/haskell-patches/syb_0.3.7_0001-hack-for-cross-compiling.patch deleted file mode 100644 index e18d6127f..000000000 --- a/standalone/android/haskell-patches/syb_0.3.7_0001-hack-for-cross-compiling.patch +++ /dev/null @@ -1,25 +0,0 @@ -From c40fe2c484096c5de4cac8ca14a0ca5d892999f7 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:36:43 -0400 -Subject: [PATCH] hack for cross-compiling - ---- - syb.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/syb.cabal b/syb.cabal -index 0aee93d..0a645c6 100644 ---- a/syb.cabal -+++ b/syb.cabal -@@ -17,7 +17,7 @@ description: -
- category: Generics
- stability: provisional
--build-type: Custom
-+build-type: Simple
- cabal-version: >= 1.6
-
- extra-source-files: tests/*.hs,
--- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/unix-time_0.1.4_0001-hacks-for-android.patch b/standalone/android/haskell-patches/unix-time_0.1.4_0001-hacks-for-android.patch deleted file mode 100644 index cff7e76e3..000000000 --- a/standalone/android/haskell-patches/unix-time_0.1.4_0001-hacks-for-android.patch +++ /dev/null @@ -1,81 +0,0 @@ -From 4023b952871ad2bc248db887716d06932ac0dbb9 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Wed, 8 May 2013 14:00:19 -0400 -Subject: [PATCH] hacks for android - ---- - cbits/conv.c | 4 +--- - unix-time.cabal | 28 ++-------------------------- - 2 files changed, 3 insertions(+), 29 deletions(-) - -diff --git a/cbits/conv.c b/cbits/conv.c -index 3b6a129..5a68f91 100644 ---- a/cbits/conv.c -+++ b/cbits/conv.c -@@ -1,5 +1,3 @@ --#include "config.h" -- - #if IS_LINUX - /* Linux cheats AC_CHECK_FUNCS(strptime_l), sigh. */ - #define THREAD_SAFE 0 -@@ -51,7 +49,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) { - #else - strptime(src, fmt, &dst); - #endif -- return timegm(&dst); -+ return NULL; /* timegm(&dst); */ - } - - void c_format_unix_time(char *fmt, time_t src, char* dst, int siz) { -diff --git a/unix-time.cabal b/unix-time.cabal -index a905d63..f32d952 100644 ---- a/unix-time.cabal -+++ b/unix-time.cabal -@@ -8,7 +8,7 @@ Synopsis: Unix time parser/formatter and utilities - Description: Fast parser\/formatter\/utilities for Unix time - Category: Data - Cabal-Version: >= 1.10 --Build-Type: Configure -+Build-Type: Simple - Extra-Source-Files: cbits/conv.c cbits/config.h.in configure configure.ac - Extra-Tmp-Files: config.log config.status autom4te.cache cbits/config.h - -@@ -21,34 +21,10 @@ Library - Data.UnixTime.Types - Data.UnixTime.Sys - Build-Depends: base >= 4 && < 5 -- , bytestring -+ , bytestring (>= 0.10.3.0) - , old-time - C-Sources: cbits/conv.c - --Test-Suite doctests -- Type: exitcode-stdio-1.0 -- HS-Source-Dirs: test -- Ghc-Options: -threaded -Wall -- Main-Is: doctests.hs -- Build-Depends: base -- , doctest >= 0.9.3 -- --Test-Suite spec -- Type: exitcode-stdio-1.0 -- Default-Language: Haskell2010 -- Hs-Source-Dirs: test -- Ghc-Options: -Wall -- Main-Is: Spec.hs -- Other-Modules: UnixTimeSpec -- Build-Depends: base -- , bytestring -- , hspec -- , old-locale -- , old-time -- , QuickCheck -- , time -- , unix-time -- - Source-Repository head - Type: git - Location: https://github.com/kazu-yamamoto/unix-time --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/unix_2.6.0.1_0001-remove-stuff-not-available-on-Android.patch b/standalone/android/haskell-patches/unix_2.6.0.1_0001-remove-stuff-not-available-on-Android.patch deleted file mode 100644 index ff1da944c..000000000 --- a/standalone/android/haskell-patches/unix_2.6.0.1_0001-remove-stuff-not-available-on-Android.patch +++ /dev/null @@ -1,91 +0,0 @@ -From abca378462337ca0eb13a7e4d3073cb96a50d36c Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:37:23 -0400 -Subject: [PATCH] remove stuff not available on Android - ---- - System/Posix/Resource.hsc | 4 ++++ - System/Posix/Terminal/Common.hsc | 29 +++-------------------------- - 2 files changed, 7 insertions(+), 26 deletions(-) - -diff --git a/System/Posix/Resource.hsc b/System/Posix/Resource.hsc -index 6651998..2615b1e 100644 ---- a/System/Posix/Resource.hsc -+++ b/System/Posix/Resource.hsc -@@ -101,7 +101,9 @@ packResource ResourceTotalMemory = (#const RLIMIT_AS) - #endif - - unpackRLimit :: CRLim -> ResourceLimit -+#if 0 - unpackRLimit (#const RLIM_INFINITY) = ResourceLimitInfinity -+#endif - #ifdef RLIM_SAVED_MAX - unpackRLimit (#const RLIM_SAVED_MAX) = ResourceLimitUnknown - unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown -@@ -109,7 +111,9 @@ unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown - unpackRLimit other = ResourceLimit (fromIntegral other) - - packRLimit :: ResourceLimit -> Bool -> CRLim -+#if 0 - packRLimit ResourceLimitInfinity _ = (#const RLIM_INFINITY) -+#endif - #ifdef RLIM_SAVED_MAX - packRLimit ResourceLimitUnknown True = (#const RLIM_SAVED_CUR) - packRLimit ResourceLimitUnknown False = (#const RLIM_SAVED_MAX) -diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc -index 3a6254d..32a22f2 100644 ---- a/System/Posix/Terminal/Common.hsc -+++ b/System/Posix/Terminal/Common.hsc -@@ -419,11 +419,7 @@ foreign import ccall unsafe "tcsendbreak" - -- | @drainOutput fd@ calls @tcdrain@ to block until all output - -- written to @Fd@ @fd@ has been transmitted. - drainOutput :: Fd -> IO () --drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd) -- --foreign import ccall unsafe "tcdrain" -- c_tcdrain :: CInt -> IO CInt -- -+drainOutput (Fd fd) = error "drainOutput not implemented" - - data QueueSelector - = InputQueue -- TCIFLUSH -@@ -434,16 +430,7 @@ data QueueSelector - -- pending input and\/or output for @Fd@ @fd@, - -- as indicated by the @QueueSelector@ @queues@. - discardData :: Fd -> QueueSelector -> IO () --discardData (Fd fd) queue = -- throwErrnoIfMinus1_ "discardData" (c_tcflush fd (queue2Int queue)) -- where -- queue2Int :: QueueSelector -> CInt -- queue2Int InputQueue = (#const TCIFLUSH) -- queue2Int OutputQueue = (#const TCOFLUSH) -- queue2Int BothQueues = (#const TCIOFLUSH) -- --foreign import ccall unsafe "tcflush" -- c_tcflush :: CInt -> CInt -> IO CInt -+discardData (Fd fd) queue = error "discardData not implemented" - - data FlowAction - = SuspendOutput -- ^ TCOOFF -@@ -455,17 +442,7 @@ data FlowAction - -- flow of data on @Fd@ @fd@, as indicated by - -- @action@. - controlFlow :: Fd -> FlowAction -> IO () --controlFlow (Fd fd) action = -- throwErrnoIfMinus1_ "controlFlow" (c_tcflow fd (action2Int action)) -- where -- action2Int :: FlowAction -> CInt -- action2Int SuspendOutput = (#const TCOOFF) -- action2Int RestartOutput = (#const TCOON) -- action2Int TransmitStop = (#const TCIOFF) -- action2Int TransmitStart = (#const TCION) -- --foreign import ccall unsafe "tcflow" -- c_tcflow :: CInt -> CInt -> IO CInt -+controlFlow (Fd fd) action = error "controlFlow not implemented" - - -- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to - -- obtain the @ProcessGroupID@ of the foreground process group --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/wai-extra_1.3.2.1_0001-disable-CGI-module.patch b/standalone/android/haskell-patches/wai-extra_1.3.2.1_0001-disable-CGI-module.patch deleted file mode 100644 index 7d5d6e2ba..000000000 --- a/standalone/android/haskell-patches/wai-extra_1.3.2.1_0001-disable-CGI-module.patch +++ /dev/null @@ -1,26 +0,0 @@ -From dc6d0128e666dcab07ddee56a22a4177ebfc0c7b Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:38:33 -0400 -Subject: [PATCH] disable CGI module - -I don't need it and it failed to build. ---- - wai-extra.cabal | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/wai-extra.cabal b/wai-extra.cabal -index 9e9f0fc..007dd0f 100644 ---- a/wai-extra.cabal -+++ b/wai-extra.cabal -@@ -44,7 +44,7 @@ Library - , void >= 0.5 && < 0.6 - , stringsearch >= 0.3 && < 0.4 - -- Exposed-modules: Network.Wai.Handler.CGI -+ Exposed-modules: - Network.Wai.Middleware.AcceptOverride - Network.Wai.Middleware.Autohead - Network.Wai.Middleware.CleanPath --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch b/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch deleted file mode 100644 index e6bda563d..000000000 --- a/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch +++ /dev/null @@ -1,108 +0,0 @@ -From 3e988dec5ea248611d07d59914e3eb131dc6a165 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 18 Apr 2013 17:44:46 -0400 -Subject: [PATCH] remove TH code - ---- - 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..bf8ce9e 100644 ---- a/Text/Hamlet/XML.hs -+++ b/Text/Hamlet/XML.hs -@@ -1,8 +1,7 @@ - {-# LANGUAGE TemplateHaskell #-} - {-# OPTIONS_GHC -fno-warn-missing-fields #-} - module Text.Hamlet.XML -- ( xml -- , xmlFile -+ ( - ) where - - import Language.Haskell.TH.Syntax -@@ -18,81 +17,3 @@ import Data.String (fromString) - 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.2.rc3 - diff --git a/standalone/android/haskell-patches/yesod-default_1.1.3.2_0001-remove-TH.patch b/standalone/android/haskell-patches/yesod-default_1.1.3.2_0001-remove-TH.patch deleted file mode 100644 index e6048ee0a..000000000 --- a/standalone/android/haskell-patches/yesod-default_1.1.3.2_0001-remove-TH.patch +++ /dev/null @@ -1,102 +0,0 @@ -From 8ff7908799eb69d440168ff3df1fe3187879df33 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:39:57 -0400 -Subject: [PATCH] remove TH - ---- - Yesod/Default/Util.hs | 61 +------------------------------------------------ - 1 file changed, 1 insertion(+), 60 deletions(-) - -diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs -index 578b9bc..178e342 100644 ---- a/Yesod/Default/Util.hs -+++ b/Yesod/Default/Util.hs -@@ -5,8 +5,6 @@ - module Yesod.Default.Util - ( addStaticContentExternal - , globFile -- , widgetFileNoReload -- , widgetFileReload - , TemplateLanguage (..) - , defaultTemplateLanguages - , WidgetFileSettings -@@ -21,9 +19,6 @@ import Yesod.Core -- purposely using complete import so that Haddock will see ad - import Control.Monad (when, unless) - import System.Directory (doesFileExist, createDirectoryIfMissing) - import Language.Haskell.TH.Syntax --import Text.Lucius (luciusFile, luciusFileReload) --import Text.Julius (juliusFile, juliusFileReload) --import Text.Cassius (cassiusFile, cassiusFileReload) - import Text.Hamlet (HamletSettings, defaultHamletSettings) - import Data.Maybe (catMaybes) - import Data.Default (Default (def)) -@@ -72,13 +67,7 @@ data TemplateLanguage = TemplateLanguage - - defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage] - defaultTemplateLanguages hset = -- [ TemplateLanguage False "hamlet" whamletFile' whamletFile' -- , TemplateLanguage True "cassius" cassiusFile cassiusFileReload -- , TemplateLanguage True "julius" juliusFile juliusFileReload -- , TemplateLanguage True "lucius" luciusFile luciusFileReload -- ] -- where -- whamletFile' = whamletFileWithSettings hset -+ [ ] - - data WidgetFileSettings = WidgetFileSettings - { wfsLanguages :: HamletSettings -> [TemplateLanguage] -@@ -87,51 +76,3 @@ data WidgetFileSettings = WidgetFileSettings - - instance Default WidgetFileSettings where - def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings -- --widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp --widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs -- --widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp --widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs -- --combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp --combine func file isReload tls = do -- mexps <- qmexps -- case catMaybes mexps of -- [] -> error $ concat -- [ "Called " -- , func -- , " on " -- , show file -- , ", but no template were found." -- ] -- exps -> return $ DoE $ map NoBindS exps -- where -- qmexps :: Q [Maybe Exp] -- qmexps = mapM go tls -- -- go :: TemplateLanguage -> Q (Maybe Exp) -- go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl) -- --whenExists :: String -- -> Bool -- ^ requires toWidget wrap -- -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) --whenExists = warnUnlessExists False -- --warnUnlessExists :: Bool -- -> String -- -> Bool -- ^ requires toWidget wrap -- -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) --warnUnlessExists shouldWarn x wrap glob f = do -- let fn = globFile glob x -- e <- qRunIO $ doesFileExist fn -- when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn -- if e -- then do -- ex <- f fn -- if wrap -- then do -- tw <- [|toWidget|] -- return $ Just $ tw `AppE` ex -- else return $ Just ex -- else return Nothing --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch b/standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch deleted file mode 100644 index 33bcff447..000000000 --- a/standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch +++ /dev/null @@ -1,674 +0,0 @@ -From 06176b0f3dbbe559490f0971e0db205287793286 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 21:01:12 -0400 -Subject: [PATCH] remove TH and export module used by TH splices - ---- - Yesod/Routes/Overlap.hs | 74 ---------- - Yesod/Routes/Parse.hs | 115 --------------- - Yesod/Routes/TH.hs | 12 -- - Yesod/Routes/TH/Dispatch.hs | 344 -------------------------------------------- - Yesod/Routes/TH/Types.hs | 16 --- - yesod-routes.cabal | 21 --- - 6 files changed, 582 deletions(-) - delete mode 100644 Yesod/Routes/Overlap.hs - delete mode 100644 Yesod/Routes/Parse.hs - delete mode 100644 Yesod/Routes/TH.hs - delete mode 100644 Yesod/Routes/TH/Dispatch.hs - -diff --git a/Yesod/Routes/Overlap.hs b/Yesod/Routes/Overlap.hs -deleted file mode 100644 -index ae45a02..0000000 ---- a/Yesod/Routes/Overlap.hs -+++ /dev/null -@@ -1,74 +0,0 @@ ---- | Check for overlapping routes. --module Yesod.Routes.Overlap -- ( findOverlaps -- , findOverlapNames -- , Overlap (..) -- ) where -- --import Yesod.Routes.TH.Types --import Data.List (intercalate) -- --data Overlap t = Overlap -- { overlapParents :: [String] -> [String] -- ^ parent resource trees -- , overlap1 :: ResourceTree t -- , overlap2 :: ResourceTree t -- } -- --findOverlaps :: ([String] -> [String]) -> [ResourceTree t] -> [Overlap t] --findOverlaps _ [] = [] --findOverlaps front (x:xs) = concatMap (findOverlap front x) xs ++ findOverlaps front xs -- --findOverlap :: ([String] -> [String]) -> ResourceTree t -> ResourceTree t -> [Overlap t] --findOverlap front x y = -- here rest -- where -- here -- | overlaps (resourceTreePieces x) (resourceTreePieces y) (hasSuffix x) (hasSuffix y) = (Overlap front x y:) -- | otherwise = id -- rest = -- case x of -- ResourceParent name _ children -> findOverlaps (front . (name:)) children -- ResourceLeaf{} -> [] -- --hasSuffix :: ResourceTree t -> Bool --hasSuffix (ResourceLeaf r) = -- case resourceDispatch r of -- Subsite{} -> True -- Methods Just{} _ -> True -- Methods Nothing _ -> False --hasSuffix ResourceParent{} = True -- --overlaps :: [(CheckOverlap, Piece t)] -> [(CheckOverlap, Piece t)] -> Bool -> Bool -> Bool -- ---- No pieces on either side, will overlap regardless of suffix --overlaps [] [] _ _ = True -- ---- No pieces on the left, will overlap if the left side has a suffix --overlaps [] _ suffixX _ = suffixX -- ---- Ditto for the right --overlaps _ [] _ suffixY = suffixY -- ---- As soon as we ignore a single piece (via CheckOverlap == False), we say that ---- the routes don't overlap at all. In other words, disabling overlap checking ---- on a single piece disables it on the whole route. --overlaps ((False, _):_) _ _ _ = False --overlaps _ ((False, _):_) _ _ = False -- ---- Compare the actual pieces --overlaps ((True, pieceX):xs) ((True, pieceY):ys) suffixX suffixY = -- piecesOverlap pieceX pieceY && overlaps xs ys suffixX suffixY -- --piecesOverlap :: Piece t -> Piece t -> Bool ---- Statics only match if they equal. Dynamics match with anything --piecesOverlap (Static x) (Static y) = x == y --piecesOverlap _ _ = True -- --findOverlapNames :: [ResourceTree t] -> [(String, String)] --findOverlapNames = -- map go . findOverlaps id -- where -- go (Overlap front x y) = -- (go' $ resourceTreeName x, go' $ resourceTreeName y) -- where -- go' = intercalate "/" . front . return -diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs -deleted file mode 100644 -index fc16eef..0000000 ---- a/Yesod/Routes/Parse.hs -+++ /dev/null -@@ -1,115 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE DeriveDataTypeable #-} --{-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter --module Yesod.Routes.Parse -- ( parseRoutes -- , parseRoutesFile -- , parseRoutesNoCheck -- , parseRoutesFileNoCheck -- , parseType -- ) where -- --import Language.Haskell.TH.Syntax --import Data.Char (isUpper) --import Language.Haskell.TH.Quote --import qualified System.IO as SIO --import Yesod.Routes.TH --import Yesod.Routes.Overlap (findOverlapNames) -- ---- | 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 $ "Overlapping routes: " ++ unlines (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 -- 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. --resourcesFromString :: String -> [ResourceTree String] --resourcesFromString = -- fst . parse 0 . lines -- where -- parse _ [] = ([], []) -- parse indent (thisLine:otherLines) -- | length spaces < indent = ([], thisLine : otherLines) -- | otherwise = (this others, remainder) -- where -- spaces = takeWhile (== ' ') thisLine -- (others, remainder) = parse indent otherLines' -- (this, otherLines') = -- case takeWhile (/= "--") $ words thisLine of -- [pattern, constr] | last constr == ':' -> -- let (children, otherLines'') = parse (length spaces + 1) otherLines -- (pieces, Nothing) = piecesFromString $ drop1Slash pattern -- in ((ResourceParent (init constr) pieces children :), otherLines'') -- (pattern:constr:rest) -> -- let (pieces, mmulti) = piecesFromString $ drop1Slash pattern -- disp = dispatchFromString rest mmulti -- in ((ResourceLeaf (Resource constr pieces disp):), otherLines) -- [] -> (id, otherLines) -- _ -> error $ "Invalid resource line: " ++ thisLine -- --dispatchFromString :: [String] -> Maybe String -> Dispatch String --dispatchFromString rest mmulti -- | null rest = Methods mmulti [] -- | all (all isUpper) rest = Methods mmulti rest --dispatchFromString [subTyp, subFun] Nothing = -- Subsite subTyp subFun --dispatchFromString [_, _] Just{} = -- error "Subsites cannot have a multipiece" --dispatchFromString rest _ = error $ "Invalid list of methods: " ++ show rest -- --drop1Slash :: String -> String --drop1Slash ('/':x) = x --drop1Slash x = x -- --piecesFromString :: String -> ([(CheckOverlap, Piece String)], Maybe String) --piecesFromString "" = ([], Nothing) --piecesFromString x = -- case (this, rest) of -- (Left typ, ([], Nothing)) -> ([], Just typ) -- (Left _, _) -> error "Multipiece must be last piece" -- (Right piece, (pieces, mtyp)) -> (piece:pieces, mtyp) -- where -- (y, z) = break (== '/') x -- this = pieceFromString y -- rest = piecesFromString $ drop 1 z -- --parseType :: String -> Type --parseType = ConT . mkName -- FIXME handle more complicated stuff -- --pieceFromString :: String -> Either String (CheckOverlap, Piece String) --pieceFromString ('#':'!':x) = Right $ (False, Dynamic x) --pieceFromString ('#':x) = Right $ (True, Dynamic x) --pieceFromString ('*':x) = Left x --pieceFromString ('!':x) = Right $ (False, Static x) --pieceFromString x = Right $ (True, Static x) -diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs -deleted file mode 100644 -index 41045b3..0000000 ---- a/Yesod/Routes/TH.hs -+++ /dev/null -@@ -1,12 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --module Yesod.Routes.TH -- ( module Yesod.Routes.TH.Types -- -- * Functions -- , module Yesod.Routes.TH.RenderRoute -- -- ** Dispatch -- , module Yesod.Routes.TH.Dispatch -- ) where -- --import Yesod.Routes.TH.Types --import Yesod.Routes.TH.RenderRoute --import Yesod.Routes.TH.Dispatch -diff --git a/Yesod/Routes/TH/Dispatch.hs b/Yesod/Routes/TH/Dispatch.hs -deleted file mode 100644 -index a52f69a..0000000 ---- a/Yesod/Routes/TH/Dispatch.hs -+++ /dev/null -@@ -1,344 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --module Yesod.Routes.TH.Dispatch -- ( -- ** Dispatch -- mkDispatchClause -- ) where -- --import Prelude hiding (exp) --import Yesod.Routes.TH.Types --import Language.Haskell.TH.Syntax --import Data.Maybe (catMaybes) --import Control.Monad (forM, replicateM) --import Data.Text (pack) --import qualified Yesod.Routes.Dispatch as D --import qualified Data.Map as Map --import Data.Char (toLower) --import Web.PathPieces (PathPiece (..), PathMultiPiece (..)) --import Control.Applicative ((<$>)) --import Data.List (foldl') -- --data FlatResource a = FlatResource [(String, [(CheckOverlap, Piece a)])] String [(CheckOverlap, Piece a)] (Dispatch a) -- --flatten :: [ResourceTree a] -> [FlatResource a] --flatten = -- concatMap (go id) -- where -- go front (ResourceLeaf (Resource a b c)) = [FlatResource (front []) a b c] -- go front (ResourceParent name pieces children) = -- concatMap (go (front . ((name, pieces):))) children -- ---- | ---- ---- This function will generate a single clause that will address all ---- your routing needs. It takes four arguments. The fourth (a list of ---- 'Resource's) is self-explanatory. We\'ll discuss the first ---- three. But first, let\'s cover the terminology. ---- ---- Dispatching involves a master type and a sub type. When you dispatch to the ---- top level type, master and sub are the same. Each time to dispatch to ---- another subsite, the sub changes. This requires two changes: ---- ---- * Getting the new sub value. This is handled via 'subsiteFunc'. ---- ---- * Figure out a way to convert sub routes to the original master route. To ---- address this, we keep a toMaster function, and each time we dispatch to a ---- new subsite, we compose it with the constructor for that subsite. ---- ---- Dispatching acts on two different components: the request method and a list ---- of path pieces. If we cannot match the path pieces, we need to return a 404 ---- response. If the path pieces match, but the method is not supported, we need ---- to return a 405 response. ---- ---- The final result of dispatch is going to be an application type. A simple ---- example would be the WAI Application type. However, our handler functions ---- will need more input: the master/subsite, the toMaster function, and the ---- type-safe route. Therefore, we need to have another type, the handler type, ---- and a function that turns a handler into an application, i.e. ---- ---- > runHandler :: handler sub master -> master -> sub -> Route sub -> (Route sub -> Route master) -> app ---- ---- This is the first argument to our function. Note that this will almost ---- certainly need to be a method of a typeclass, since it will want to behave ---- differently based on the subsite. ---- ---- Note that the 404 response passed in is an application, while the 405 ---- response is a handler, since the former can\'t be passed the type-safe ---- route. ---- ---- In the case of a subsite, we don\'t directly deal with a handler function. ---- Instead, we redispatch to the subsite, passing on the updated sub value and ---- toMaster function, as well as any remaining, unparsed path pieces. This ---- function looks like: ---- ---- > dispatcher :: master -> sub -> (Route sub -> Route master) -> app -> handler sub master -> Text -> [Text] -> app ---- ---- Where the parameters mean master, sub, toMaster, 404 response, 405 response, ---- request method and path pieces. This is the second argument of our function. ---- ---- Finally, we need a way to decide which of the possible formats ---- should the handler send the data out. Think of each URL holding an ---- abstract object which has multiple representation (JSON, plain HTML ---- etc). Each client might have a preference on which format it wants ---- the abstract object in. For example, a javascript making a request ---- (on behalf of a browser) might prefer a JSON object over a plain ---- HTML file where as a user browsing with javascript disabled would ---- want the page in HTML. The third argument is a function that ---- converts the abstract object to the desired representation ---- depending on the preferences sent by the client. ---- ---- The typical values for the first three arguments are, ---- @'yesodRunner'@ for the first, @'yesodDispatch'@ for the second and ---- @fmap 'chooseRep'@. -- --mkDispatchClause :: Q Exp -- ^ runHandler function -- -> Q Exp -- ^ dispatcher function -- -> Q Exp -- ^ fixHandler function -- -> [ResourceTree a] -- -> Q Clause --mkDispatchClause runHandler dispatcher fixHandler ress' = do -- -- Allocate the names to be used. Start off with the names passed to the -- -- function itself (with a 0 suffix). -- -- -- -- We don't reuse names so as to avoid shadowing names (triggers warnings -- -- with -Wall). Additionally, we want to ensure that none of the code -- -- passed to toDispatch uses variables from the closure to prevent the -- -- dispatch data structure from being rebuilt on each run. -- master0 <- newName "master0" -- sub0 <- newName "sub0" -- toMaster0 <- newName "toMaster0" -- app4040 <- newName "app4040" -- handler4050 <- newName "handler4050" -- method0 <- newName "method0" -- pieces0 <- newName "pieces0" -- -- -- Name of the dispatch function -- dispatch <- newName "dispatch" -- -- -- Dispatch function applied to the pieces -- let dispatched = VarE dispatch `AppE` VarE pieces0 -- -- -- The 'D.Route's used in the dispatch function -- routes <- mapM (buildRoute runHandler dispatcher fixHandler) ress -- -- -- The dispatch function itself -- toDispatch <- [|D.toDispatch|] -- let dispatchFun = FunD dispatch [Clause [] (NormalB $ toDispatch `AppE` ListE routes) []] -- -- -- The input to the clause. -- let pats = map VarP [master0, sub0, toMaster0, app4040, handler4050, method0, pieces0] -- -- -- For each resource that dispatches based on methods, build up a map for handling the dispatching. -- methodMaps <- catMaybes <$> mapM (buildMethodMap fixHandler) ress -- -- u <- [|case $(return dispatched) of -- Just f -> f $(return $ VarE master0) -- $(return $ VarE sub0) -- $(return $ VarE toMaster0) -- $(return $ VarE app4040) -- $(return $ VarE handler4050) -- $(return $ VarE method0) -- Nothing -> $(return $ VarE app4040) -- |] -- return $ Clause pats (NormalB u) $ dispatchFun : methodMaps -- where -- ress = flatten ress' -- ---- | Determine the name of the method map for a given resource name. --methodMapName :: String -> Name --methodMapName s = mkName $ "methods" ++ s -- --buildMethodMap :: Q Exp -- ^ fixHandler -- -> FlatResource a -- -> Q (Maybe Dec) --buildMethodMap _ (FlatResource _ _ _ (Methods _ [])) = return Nothing -- single handle function --buildMethodMap fixHandler (FlatResource parents name pieces' (Methods mmulti methods)) = do -- fromList <- [|Map.fromList|] -- methods' <- mapM go methods -- let exp = fromList `AppE` ListE methods' -- let fun = FunD (methodMapName name) [Clause [] (NormalB exp) []] -- return $ Just fun -- where -- pieces = concat $ map snd parents ++ [pieces'] -- go method = do -- fh <- fixHandler -- let func = VarE $ mkName $ map toLower method ++ name -- pack' <- [|pack|] -- let isDynamic Dynamic{} = True -- isDynamic _ = False -- let argCount = length (filter (isDynamic . snd) pieces) + maybe 0 (const 1) mmulti -- xs <- replicateM argCount $ newName "arg" -- let rhs = LamE (map VarP xs) $ fh `AppE` (foldl' AppE func $ map VarE xs) -- return $ TupE [pack' `AppE` LitE (StringL method), rhs] --buildMethodMap _ (FlatResource _ _ _ Subsite{}) = return Nothing -- ---- | Build a single 'D.Route' expression. --buildRoute :: Q Exp -> Q Exp -> Q Exp -> FlatResource a -> Q Exp --buildRoute runHandler dispatcher fixHandler (FlatResource parents name resPieces resDisp) = do -- -- First two arguments to D.Route -- routePieces <- ListE <$> mapM (convertPiece . snd) allPieces -- isMulti <- -- case resDisp of -- Methods Nothing _ -> [|False|] -- _ -> [|True|] -- -- [|D.Route $(return routePieces) $(return isMulti) $(routeArg3 runHandler dispatcher fixHandler parents name (map snd allPieces) resDisp)|] -- where -- allPieces = concat $ map snd parents ++ [resPieces] -- --routeArg3 :: Q Exp -- ^ runHandler -- -> Q Exp -- ^ dispatcher -- -> Q Exp -- ^ fixHandler -- -> [(String, [(CheckOverlap, Piece a)])] -- -> String -- ^ name of resource -- -> [Piece a] -- -> Dispatch a -- -> Q Exp --routeArg3 runHandler dispatcher fixHandler parents name resPieces resDisp = do -- pieces <- newName "pieces" -- -- -- Allocate input piece variables (xs) and variables that have been -- -- converted via fromPathPiece (ys) -- xs <- forM resPieces $ \piece -> -- case piece of -- Static _ -> return Nothing -- Dynamic _ -> Just <$> newName "x" -- -- -- Note: the zipping with Ints is just a workaround for (apparently) a bug -- -- in GHC where the identifiers are considered to be overlapping. Using -- -- newName should avoid the problem, but it doesn't. -- ys <- forM (zip (catMaybes xs) [1..]) $ \(x, i) -> do -- y <- newName $ "y" ++ show (i :: Int) -- return (x, y) -- -- -- In case we have multi pieces at the end -- xrest <- newName "xrest" -- yrest <- newName "yrest" -- -- -- Determine the pattern for matching the pieces -- pat <- -- case resDisp of -- Methods Nothing _ -> return $ ListP $ map (maybe WildP VarP) xs -- _ -> do -- let cons = mkName ":" -- return $ foldr (\a b -> ConP cons [maybe WildP VarP a, b]) (VarP xrest) xs -- -- -- Convert the xs -- fromPathPiece' <- [|fromPathPiece|] -- xstmts <- forM ys $ \(x, y) -> return $ BindS (VarP y) (fromPathPiece' `AppE` VarE x) -- -- -- Convert the xrest if appropriate -- (reststmts, yrest') <- -- case resDisp of -- Methods (Just _) _ -> do -- fromPathMultiPiece' <- [|fromPathMultiPiece|] -- return ([BindS (VarP yrest) (fromPathMultiPiece' `AppE` VarE xrest)], [yrest]) -- _ -> return ([], []) -- -- -- The final expression that actually uses the values we've computed -- caller <- buildCaller runHandler dispatcher fixHandler xrest parents name resDisp $ map snd ys ++ yrest' -- -- -- Put together all the statements -- just <- [|Just|] -- let stmts = concat -- [ xstmts -- , reststmts -- , [NoBindS $ just `AppE` caller] -- ] -- -- errorMsg <- [|error "Invariant violated"|] -- let matches = -- [ Match pat (NormalB $ DoE stmts) [] -- , Match WildP (NormalB errorMsg) [] -- ] -- -- return $ LamE [VarP pieces] $ CaseE (VarE pieces) matches -- ---- | The final expression in the individual Route definitions. --buildCaller :: Q Exp -- ^ runHandler -- -> Q Exp -- ^ dispatcher -- -> Q Exp -- ^ fixHandler -- -> Name -- ^ xrest -- -> [(String, [(CheckOverlap, Piece a)])] -- -> String -- ^ name of resource -- -> Dispatch a -- -> [Name] -- ^ ys -- -> Q Exp --buildCaller runHandler dispatcher fixHandler xrest parents name resDisp ys = do -- master <- newName "master" -- sub <- newName "sub" -- toMaster <- newName "toMaster" -- app404 <- newName "_app404" -- handler405 <- newName "_handler405" -- method <- newName "_method" -- -- let pat = map VarP [master, sub, toMaster, app404, handler405, method] -- -- -- Create the route -- let route = routeFromDynamics parents name ys -- -- exp <- -- case resDisp of -- Methods _ ms -> do -- handler <- newName "handler" -- -- -- Run the whole thing -- runner <- [|$(runHandler) -- $(return $ VarE handler) -- $(return $ VarE master) -- $(return $ VarE sub) -- (Just $(return route)) -- $(return $ VarE toMaster)|] -- -- let myLet handlerExp = -- LetE [FunD handler [Clause [] (NormalB handlerExp) []]] runner -- -- if null ms -- then do -- -- Just a single handler -- fh <- fixHandler -- let he = fh `AppE` foldl' (\a b -> a `AppE` VarE b) (VarE $ mkName $ "handle" ++ name) ys -- return $ myLet he -- else do -- -- Individual methods -- mf <- [|Map.lookup $(return $ VarE method) $(return $ VarE $ methodMapName name)|] -- f <- newName "f" -- let apply = foldl' (\a b -> a `AppE` VarE b) (VarE f) ys -- let body405 = -- VarE handler405 -- `AppE` route -- return $ CaseE mf -- [ Match (ConP 'Just [VarP f]) (NormalB $ myLet apply) [] -- , Match (ConP 'Nothing []) (NormalB body405) [] -- ] -- -- Subsite _ getSub -> do -- let sub2 = foldl' (\a b -> a `AppE` VarE b) (VarE (mkName getSub) `AppE` VarE sub) ys -- [|$(dispatcher) -- $(return $ VarE master) -- $(return sub2) -- ($(return $ VarE toMaster) . $(return route)) -- $(return $ VarE app404) -- ($(return $ VarE handler405) . $(return route)) -- $(return $ VarE method) -- $(return $ VarE xrest) -- |] -- -- return $ LamE pat exp -- ---- | Convert a 'Piece' to a 'D.Piece' --convertPiece :: Piece a -> Q Exp --convertPiece (Static s) = [|D.Static (pack $(lift s))|] --convertPiece (Dynamic _) = [|D.Dynamic|] -- --routeFromDynamics :: [(String, [(CheckOverlap, Piece a)])] -- ^ parents -- -> String -- ^ constructor name -- -> [Name] -- -> Exp --routeFromDynamics [] name ys = foldl' (\a b -> a `AppE` VarE b) (ConE $ mkName name) ys --routeFromDynamics ((parent, pieces):rest) name ys = -- foldl' (\a b -> a `AppE` b) (ConE $ mkName parent) here -- where -- (here', ys') = splitAt (length $ filter (isDynamic . snd) pieces) ys -- isDynamic Dynamic{} = True -- isDynamic _ = False -- here = map VarE here' ++ [routeFromDynamics rest name ys'] -diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs -index 52cd446..18208d3 100644 ---- a/Yesod/Routes/TH/Types.hs -+++ b/Yesod/Routes/TH/Types.hs -@@ -29,10 +29,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)] -@@ -45,9 +41,6 @@ type CheckOverlap = Bool - instance Functor Resource where - fmap f (Resource a b c) = Resource a (map (second $ fmap f) b) (fmap f c) - --instance Lift t => Lift (Resource t) where -- lift (Resource a b c) = [|Resource $(lift a) $(lift b) $(lift c)|] -- - data Piece typ = Static String | Dynamic typ - deriving Show - -@@ -55,10 +48,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 -@@ -74,11 +63,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 eb367b3..dc6a12c 100644 ---- a/yesod-routes.cabal -+++ b/yesod-routes.cabal -@@ -23,31 +23,10 @@ library - , path-pieces >= 0.1 && < 0.2 - - exposed-modules: Yesod.Routes.Dispatch -- Yesod.Routes.TH - Yesod.Routes.Class -- Yesod.Routes.Parse -- Yesod.Routes.Overlap -- other-modules: Yesod.Routes.TH.Dispatch -- Yesod.Routes.TH.RenderRoute - Yesod.Routes.TH.Types - ghc-options: -Wall - --test-suite runtests -- type: exitcode-stdio-1.0 -- main-is: main.hs -- hs-source-dirs: test -- other-modules: Hierarchy -- -- build-depends: base >= 4.3 && < 5 -- , yesod-routes -- , text >= 0.5 && < 0.12 -- , HUnit >= 1.2 && < 1.3 -- , hspec >= 1.3 -- , containers -- , template-haskell -- , path-pieces -- ghc-options: -Wall -- - source-repository head - type: git - location: https://github.com/yesodweb/yesod --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/yesod-static_1.1.2-remove-TH.patch b/standalone/android/haskell-patches/yesod-static_1.1.2-remove-TH.patch deleted file mode 100644 index b0446111b..000000000 --- a/standalone/android/haskell-patches/yesod-static_1.1.2-remove-TH.patch +++ /dev/null @@ -1,174 +0,0 @@ -From 476414b04064bb66fc25ba9ca426c309fe5c156e Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 12:48:13 -0400 -Subject: [PATCH] remove TH - ---- - Yesod/Static.hs | 121 ---------------------------------------------- - dist/package.conf.inplace | 3 +- - 2 files changed, 2 insertions(+), 122 deletions(-) - -diff --git a/Yesod/Static.hs b/Yesod/Static.hs -index e8ca09f..193b1f0 100644 ---- a/Yesod/Static.hs -+++ b/Yesod/Static.hs -@@ -1,5 +1,3 @@ --{-# LANGUAGE QuasiQuotes #-} --{-# LANGUAGE TemplateHaskell #-} - {-# LANGUAGE TypeFamilies #-} - {-# LANGUAGE CPP #-} - {-# LANGUAGE FlexibleInstances #-} -@@ -34,11 +32,6 @@ module Yesod.Static - -- * Smart constructor - , static - , staticDevel -- , embed -- -- * Template Haskell helpers -- , staticFiles -- , staticFilesList -- , publicFiles - -- * Hashing - , base64md5 - #ifdef TEST_EXPORT -@@ -50,7 +43,6 @@ import Prelude hiding (FilePath) - import qualified Prelude - import System.Directory - import Control.Monad --import Data.FileEmbed (embedDir) - - import Yesod.Core hiding (lift) - -@@ -111,18 +103,6 @@ staticDevel dir = do - hashLookup <- cachedETagLookupDevel dir - return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup - ---- | Produce a 'Static' based on embedding all of the static ---- files' contents in the executable at compile time. ---- Nota Bene: if you replace the scaffolded 'static' call in Settings/StaticFiles.hs ---- you will need to change the scaffolded addStaticContent. Otherwise, some of your ---- assets will be 404'ed. This is because by default yesod will generate compile those ---- assets to @static/tmp@ which for 'static' is fine since they are served out of the ---- directory itself. With embedded static, that will not work. ---- You can easily change @addStaticContent@ to @\_ _ _ -> return Nothing@ as a workaround. ---- This will cause yesod to embed those assets into the generated HTML file itself. --embed :: Prelude.FilePath -> Q Exp --embed fp = [|Static (embeddedSettings $(embedDir fp))|] -- - instance RenderRoute Static where - -- | A route on the static subsite (see also 'staticFiles'). - -- -@@ -167,59 +147,6 @@ getFileListPieces = flip go id - dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs - return $ concat $ files' : dirs' - ---- | Template Haskell function that automatically creates routes ---- for all of your static files. ---- ---- For example, if you used ---- ---- > staticFiles "static/" ---- ---- and you had files @\"static\/style.css\"@ and ---- @\"static\/js\/script.js\"@, then the following top-level ---- definitions would be created: ---- ---- > style_css = StaticRoute ["style.css"] [] ---- > js_script_js = StaticRoute ["js/script.js"] [] ---- ---- Note that dots (@.@), dashes (@-@) and slashes (@\/@) are ---- replaced by underscores (@\_@) to create valid Haskell ---- identifiers. --staticFiles :: Prelude.FilePath -> Q [Dec] --staticFiles dir = mkStaticFiles dir -- ---- | Same as 'staticFiles', but takes an explicit list of files ---- to create identifiers for. The files path given are relative ---- to the static folder. For example, to create routes for the ---- files @\"static\/js\/jquery.js\"@ and ---- @\"static\/css\/normalize.css\"@, you would use: ---- ---- > staticFilesList \"static\" [\"js\/jquery.js\", \"css\/normalize.css\"] ---- ---- This can be useful when you have a very large number of static ---- files, but only need to refer to a few of them from Haskell. --staticFilesList :: Prelude.FilePath -> [Prelude.FilePath] -> Q [Dec] --staticFilesList dir fs = -- mkStaticFilesList dir (map split fs) "StaticRoute" True -- where -- split :: Prelude.FilePath -> [String] -- split [] = [] -- split x = -- let (a, b) = break (== '/') x -- in a : split (drop 1 b) -- ---- | Same as 'staticFiles', but doesn't append an ETag to the ---- query string. ---- ---- Using 'publicFiles' will speed up the compilation, since there ---- won't be any need for hashing files during compile-time. ---- However, since the ETag ceases to be part of the URL, the ---- 'Static' subsite won't be able to set the expire date too far ---- on the future. Browsers still will be able to cache the ---- contents, however they'll need send a request to the server to ---- see if their copy is up-to-date. --publicFiles :: Prelude.FilePath -> Q [Dec] --publicFiles dir = mkStaticFiles' dir "StaticRoute" False -- - - mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString) - mkHashMap dir = do -@@ -262,54 +189,6 @@ cachedETagLookup dir = do - etags <- mkHashMap dir - return $ (\f -> return $ M.lookup f etags) - --mkStaticFiles :: Prelude.FilePath -> Q [Dec] --mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True -- --mkStaticFiles' :: Prelude.FilePath -- ^ static directory -- -> String -- ^ route constructor "StaticRoute" -- -> Bool -- ^ append checksum query parameter -- -> Q [Dec] --mkStaticFiles' fp routeConName makeHash = do -- fs <- qRunIO $ getFileListPieces fp -- mkStaticFilesList fp fs routeConName makeHash -- --mkStaticFilesList -- :: Prelude.FilePath -- ^ static directory -- -> [[String]] -- ^ list of files to create identifiers for -- -> String -- ^ route constructor "StaticRoute" -- -> Bool -- ^ append checksum query parameter -- -> Q [Dec] --mkStaticFilesList fp fs routeConName makeHash = do -- concat `fmap` mapM mkRoute fs -- where -- replace' c -- | 'A' <= c && c <= 'Z' = c -- | 'a' <= c && c <= 'z' = c -- | '0' <= c && c <= '9' = c -- | otherwise = '_' -- mkRoute f = do -- let name' = intercalate "_" $ map (map replace') f -- routeName = mkName $ -- case () of -- () -- | null name' -> error "null-named file" -- | isDigit (head name') -> '_' : name' -- | isLower (head name') -> name' -- | otherwise -> '_' : name' -- f' <- [|map pack $(lift f)|] -- let route = mkName routeConName -- pack' <- [|pack|] -- qs <- if makeHash -- then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f -- [|[(pack "etag", pack $(lift hash))]|] -- else return $ ListE [] -- return -- [ SigD routeName $ ConT route -- , FunD routeName -- [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) [] -- ] -- ] -- - base64md5File :: Prelude.FilePath -> IO String - base64md5File = fmap (base64 . encode) . hashFile - where encode d = Data.Serialize.encode (d :: MD5) |