remove unused patches (2000+ lines!)
This commit is contained in:
Joey Hess
parent
2889211efd
commit
f10bae49d4
24 changed files with 0 additions and 2227 deletions
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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)
|
||||
Loading…
Reference in a new issue