diff options
Diffstat (limited to 'standalone/android/haskell-patches')
70 files changed, 3755 insertions, 6645 deletions
diff --git a/standalone/android/haskell-patches/DAV_0.3-0001-build-without-TH.patch b/standalone/android/haskell-patches/DAV_0.3-0001-build-without-TH.patch deleted file mode 100644 index 3fbf764c2..000000000 --- a/standalone/android/haskell-patches/DAV_0.3-0001-build-without-TH.patch +++ /dev/null @@ -1,306 +0,0 @@ -From d195f807dac2351d29aeff00d2aee3e151eb82e3 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 18 Apr 2013 19:37:28 -0400 -Subject: [PATCH] build without TH - -Used the EvilSplicer to expand the TH - -Left off CmdArgs to save time. ---- - DAV.cabal | 20 +---- - Network/Protocol/HTTP/DAV.hs | 53 ++++++++++--- - Network/Protocol/HTTP/DAV/TH.hs | 167 ++++++++++++++++++++++++++++++++++++++- - 3 files changed, 207 insertions(+), 33 deletions(-) - -diff --git a/DAV.cabal b/DAV.cabal -index 774d4e5..8b85133 100644 ---- a/DAV.cabal -+++ b/DAV.cabal -@@ -38,25 +38,7 @@ library - , transformers >= 0.3 - , xml-conduit >= 1.0 && <= 1.1 - , xml-hamlet >= 0.4 && <= 0.5 --executable hdav -- main-is: hdav.hs -- ghc-options: -Wall -- build-depends: base >= 4.5 && <= 5 -- , bytestring -- , bytestring -- , case-insensitive >= 0.4 -- , cmdargs >= 0.9 -- , containers -- , http-conduit >= 1.4 -- , http-types >= 0.7 -- , lens >= 3.0 -- , lifted-base >= 0.1 -- , mtl >= 2.1 -- , network >= 2.3 -- , resourcet >= 0.3 -- , transformers >= 0.3 -- , xml-conduit >= 1.0 && <= 1.1 -- , xml-hamlet >= 0.4 && <= 0.5 -+ , text - - source-repository head - type: git -diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs -index 02e5d15..c0be362 100644 ---- a/Network/Protocol/HTTP/DAV.hs -+++ b/Network/Protocol/HTTP/DAV.hs -@@ -52,7 +52,8 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho - - import qualified Text.XML as XML - import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName) --import Text.Hamlet.XML (xml) -+import Text.Hamlet.XML -+import qualified Data.Text - - import Data.CaseInsensitive (mk) - -@@ -246,18 +247,48 @@ makeCollection url username password = withDS url username password $ - propname :: XML.Document - propname = XML.Document (XML.Prologue [] Nothing []) root [] - where -- root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml| --<D:allprop> --|] -+ root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) $ concat -+ [[XML.NodeElement -+ (XML.Element -+ (XML.Name -+ (Data.Text.pack "D:allprop") Nothing Nothing) -+ Map.empty -+ (concat []))]] -+ - - locky :: XML.Document - locky = XML.Document (XML.Prologue [] Nothing []) root [] - where -- root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml| --<D:lockscope> -- <D:exclusive> --<D:locktype> -- <D:write> --<D:owner>Haskell DAV user --|] -+ root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) $ concat -+ [[XML.NodeElement -+ (XML.Element -+ (XML.Name -+ (Data.Text.pack "D:lockscope") Nothing Nothing) -+ Map.empty -+ (concat -+ [[XML.NodeElement -+ (XML.Element -+ (XML.Name -+ (Data.Text.pack "D:exclusive") Nothing Nothing) -+ Map.empty -+ (concat []))]]))], -+ [XML.NodeElement -+ (XML.Element -+ (XML.Name -+ (Data.Text.pack "D:locktype") Nothing Nothing) -+ Map.empty -+ (concat -+ [[XML.NodeElement -+ (XML.Element -+ (XML.Name (Data.Text.pack "D:write") Nothing Nothing) -+ Map.empty -+ (concat []))]]))], -+ [XML.NodeElement -+ (XML.Element -+ (XML.Name (Data.Text.pack "D:owner") Nothing Nothing) -+ Map.empty -+ (concat -+ [[XML.NodeContent -+ (Data.Text.pack "Haskell DAV user")]]))]] -+ - -diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs -index 036a2bc..4d3c0f4 100644 ---- a/Network/Protocol/HTTP/DAV/TH.hs -+++ b/Network/Protocol/HTTP/DAV/TH.hs -@@ -16,11 +16,13 @@ - -- You should have received a copy of the GNU General Public License - -- along with this program. If not, see <http://www.gnu.org/licenses/>. - --{-# LANGUAGE TemplateHaskell #-} -+{-# LANGUAGE RankNTypes #-} - - module Network.Protocol.HTTP.DAV.TH where - --import Control.Lens (makeLenses) -+import Control.Lens -+import qualified Control.Lens.Type -+import qualified Data.Functor - import qualified Data.ByteString as B - import Network.HTTP.Conduit (Manager, Request) - -@@ -33,4 +35,163 @@ data DAVContext a = DAVContext { - , _basicusername :: B.ByteString - , _basicpassword :: B.ByteString - } --makeLenses ''DAVContext -+allowedMethods :: -+ forall a_a4Oo. -+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString] -+allowedMethods -+ _f_a5tt -+ (DAVContext __allowedMethods'_a5tu -+ __baseRequest_a5tw -+ __complianceClasses_a5tx -+ __httpManager_a5ty -+ __lockToken_a5tz -+ __basicusername_a5tA -+ __basicpassword_a5tB) -+ = ((\ __allowedMethods_a5tv -+ -> DAVContext -+ __allowedMethods_a5tv -+ __baseRequest_a5tw -+ __complianceClasses_a5tx -+ __httpManager_a5ty -+ __lockToken_a5tz -+ __basicusername_a5tA -+ __basicpassword_a5tB) -+ Data.Functor.<$> (_f_a5tt __allowedMethods'_a5tu)) -+{-# INLINE allowedMethods #-} -+baseRequest :: -+ forall a_a4Oo a_a5tC. -+ Control.Lens.Type.Lens (DAVContext a_a4Oo) (DAVContext a_a5tC) (Request a_a4Oo) (Request a_a5tC) -+baseRequest -+ _f_a5tD -+ (DAVContext __allowedMethods_a5tE -+ __baseRequest'_a5tF -+ __complianceClasses_a5tH -+ __httpManager_a5tI -+ __lockToken_a5tJ -+ __basicusername_a5tK -+ __basicpassword_a5tL) -+ = ((\ __baseRequest_a5tG -+ -> DAVContext -+ __allowedMethods_a5tE -+ __baseRequest_a5tG -+ __complianceClasses_a5tH -+ __httpManager_a5tI -+ __lockToken_a5tJ -+ __basicusername_a5tK -+ __basicpassword_a5tL) -+ Data.Functor.<$> (_f_a5tD __baseRequest'_a5tF)) -+{-# INLINE baseRequest #-} -+basicpassword :: -+ forall a_a4Oo. -+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString -+basicpassword -+ _f_a5tM -+ (DAVContext __allowedMethods_a5tN -+ __baseRequest_a5tO -+ __complianceClasses_a5tP -+ __httpManager_a5tQ -+ __lockToken_a5tR -+ __basicusername_a5tS -+ __basicpassword'_a5tT) -+ = ((\ __basicpassword_a5tU -+ -> DAVContext -+ __allowedMethods_a5tN -+ __baseRequest_a5tO -+ __complianceClasses_a5tP -+ __httpManager_a5tQ -+ __lockToken_a5tR -+ __basicusername_a5tS -+ __basicpassword_a5tU) -+ Data.Functor.<$> (_f_a5tM __basicpassword'_a5tT)) -+{-# INLINE basicpassword #-} -+basicusername :: -+ forall a_a4Oo. -+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString -+basicusername -+ _f_a5tV -+ (DAVContext __allowedMethods_a5tW -+ __baseRequest_a5tX -+ __complianceClasses_a5tY -+ __httpManager_a5tZ -+ __lockToken_a5u0 -+ __basicusername'_a5u1 -+ __basicpassword_a5u3) -+ = ((\ __basicusername_a5u2 -+ -> DAVContext -+ __allowedMethods_a5tW -+ __baseRequest_a5tX -+ __complianceClasses_a5tY -+ __httpManager_a5tZ -+ __lockToken_a5u0 -+ __basicusername_a5u2 -+ __basicpassword_a5u3) -+ Data.Functor.<$> (_f_a5tV __basicusername'_a5u1)) -+{-# INLINE basicusername #-} -+complianceClasses :: -+ forall a_a4Oo. -+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString] -+complianceClasses -+ _f_a5u4 -+ (DAVContext __allowedMethods_a5u5 -+ __baseRequest_a5u6 -+ __complianceClasses'_a5u7 -+ __httpManager_a5u9 -+ __lockToken_a5ua -+ __basicusername_a5ub -+ __basicpassword_a5uc) -+ = ((\ __complianceClasses_a5u8 -+ -> DAVContext -+ __allowedMethods_a5u5 -+ __baseRequest_a5u6 -+ __complianceClasses_a5u8 -+ __httpManager_a5u9 -+ __lockToken_a5ua -+ __basicusername_a5ub -+ __basicpassword_a5uc) -+ Data.Functor.<$> (_f_a5u4 __complianceClasses'_a5u7)) -+{-# INLINE complianceClasses #-} -+httpManager :: -+ forall a_a4Oo. Control.Lens.Type.Lens' (DAVContext a_a4Oo) Manager -+httpManager -+ _f_a5ud -+ (DAVContext __allowedMethods_a5ue -+ __baseRequest_a5uf -+ __complianceClasses_a5ug -+ __httpManager'_a5uh -+ __lockToken_a5uj -+ __basicusername_a5uk -+ __basicpassword_a5ul) -+ = ((\ __httpManager_a5ui -+ -> DAVContext -+ __allowedMethods_a5ue -+ __baseRequest_a5uf -+ __complianceClasses_a5ug -+ __httpManager_a5ui -+ __lockToken_a5uj -+ __basicusername_a5uk -+ __basicpassword_a5ul) -+ Data.Functor.<$> (_f_a5ud __httpManager'_a5uh)) -+{-# INLINE httpManager #-} -+lockToken :: -+ forall a_a4Oo. -+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) (Maybe B.ByteString) -+lockToken -+ _f_a5um -+ (DAVContext __allowedMethods_a5un -+ __baseRequest_a5uo -+ __complianceClasses_a5up -+ __httpManager_a5uq -+ __lockToken'_a5ur -+ __basicusername_a5ut -+ __basicpassword_a5uu) -+ = ((\ __lockToken_a5us -+ -> DAVContext -+ __allowedMethods_a5un -+ __baseRequest_a5uo -+ __complianceClasses_a5up -+ __httpManager_a5uq -+ __lockToken_a5us -+ __basicusername_a5ut -+ __basicpassword_a5uu) -+ Data.Functor.<$> (_f_a5um __lockToken'_a5ur)) -+{-# INLINE lockToken #-} --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/DAV_build-without-TH.patch b/standalone/android/haskell-patches/DAV_build-without-TH.patch new file mode 100644 index 000000000..b871fa9ef --- /dev/null +++ b/standalone/android/haskell-patches/DAV_build-without-TH.patch @@ -0,0 +1,377 @@ +From 2b5fc33607720d0cccd7d8f9cb7232042ead73e6 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 00:36:56 +0000 +Subject: [PATCH] expand TH + +used the EvilSplicer ++ manual fix ups +--- + DAV.cabal | 20 +-- + Network/Protocol/HTTP/DAV.hs | 73 ++++++----- + Network/Protocol/HTTP/DAV/TH.hs | 196 +++++++++++++++++++++++++++- + dist/build/HSDAV-0.4.1.o | Bin 140080 -> 0 bytes + dist/build/Network/Protocol/HTTP/DAV.hi | Bin 34549 -> 57657 bytes + dist/build/Network/Protocol/HTTP/DAV.o | Bin 160248 -> 201932 bytes + dist/build/Network/Protocol/HTTP/DAV/TH.hi | Bin 17056 -> 18733 bytes + dist/build/Network/Protocol/HTTP/DAV/TH.o | Bin 19672 -> 28120 bytes + dist/build/autogen/Paths_DAV.hs | 18 ++- + dist/build/autogen/cabal_macros.h | 45 +++---- + dist/build/libHSDAV-0.4.1.a | Bin 200082 -> 260188 bytes + dist/package.conf.inplace | 2 - + dist/setup-config | 2 - + 13 files changed, 266 insertions(+), 90 deletions(-) + delete mode 100644 dist/build/HSDAV-0.4.1.o + delete mode 100644 dist/package.conf.inplace + delete mode 100644 dist/setup-config + +diff --git a/DAV.cabal b/DAV.cabal +index 06b3a8b..90368c6 100644 +--- a/DAV.cabal ++++ b/DAV.cabal +@@ -38,25 +38,7 @@ library + , transformers >= 0.3 + , xml-conduit >= 1.0 && <= 1.2 + , xml-hamlet >= 0.4 && <= 0.5 +-executable hdav +- main-is: hdav.hs +- ghc-options: -Wall +- build-depends: base >= 4.5 && <= 5 +- , bytestring +- , bytestring +- , case-insensitive >= 0.4 +- , containers +- , http-conduit >= 1.9.0 +- , http-types >= 0.7 +- , lens >= 3.0 +- , lifted-base >= 0.1 +- , mtl >= 2.1 +- , network >= 2.3 +- , optparse-applicative +- , resourcet >= 0.3 +- , transformers >= 0.3 +- , xml-conduit >= 1.0 && <= 1.2 +- , xml-hamlet >= 0.4 && <= 0.5 ++ , text + + source-repository head + type: git +diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs +index 8ffc270..d064a8f 100644 +--- a/Network/Protocol/HTTP/DAV.hs ++++ b/Network/Protocol/HTTP/DAV.hs +@@ -28,12 +28,12 @@ module Network.Protocol.HTTP.DAV ( + , deleteContent + , moveContent + , makeCollection +- , caldavReport + , module Network.Protocol.HTTP.DAV.TH + ) where + + import Network.Protocol.HTTP.DAV.TH + ++import qualified Data.Text + import Control.Applicative (liftA2) + import Control.Exception.Lifted (catchJust, finally, bracketOnError) + import Control.Lens ((.~), (^.)) +@@ -200,11 +200,6 @@ props2patch = XML.renderLBS XML.def . patch . props . fromDocument + , "{DAV:}supportedlock" + ] + +-caldavReportM :: MonadResourceBase m => DAVState m XML.Document +-caldavReportM = do +- let ahs = [(hContentType, "application/xml; charset=\"utf-8\"")] +- calrresp <- davRequest "REPORT" ahs (xmlBody calendarquery) +- return $ (XML.parseLBS_ def . responseBody) calrresp + + getProps :: String -> B.ByteString -> B.ByteString -> Maybe Depth -> IO XML.Document + getProps url username password md = withDS url username password md getPropsM +@@ -246,9 +241,6 @@ moveContent :: String -> B.ByteString -> B.ByteString -> B.ByteString -> IO () + moveContent url newurl username password = withDS url username password Nothing $ + moveContentM newurl + +-caldavReport :: String -> B.ByteString -> B.ByteString -> IO XML.Document +-caldavReport url username password = withDS url username password (Just Depth1) $ caldavReportM +- + -- | Creates a WebDAV collection, which is similar to a directory. + -- + -- Returns False if the collection could not be made due to an intermediate +@@ -264,28 +256,45 @@ makeCollection url username password = withDS url username password Nothing $ + propname :: XML.Document + propname = XML.Document (XML.Prologue [] Nothing []) root [] + where +- root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml| +-<D:allprop> +-|] +- ++ root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) $ concat ++ [[XML.NodeElement ++ (XML.Element ++ (XML.Name ++ (Data.Text.pack "D:allprop") Nothing Nothing) ++ Map.empty ++ (concat []))]] + locky :: XML.Document + locky = XML.Document (XML.Prologue [] Nothing []) root [] +- where +- root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml| +-<D:lockscope> +- <D:exclusive> +-<D:locktype> +- <D:write> +-<D:owner>Haskell DAV user +-|] +- +-calendarquery :: XML.Document +-calendarquery = XML.Document (XML.Prologue [] Nothing []) root [] +- where +- root = XML.Element "C:calendar-query" (Map.fromList [("xmlns:D", "DAV:"),("xmlns:C", "urn:ietf:params:xml:ns:caldav")]) [xml| +-<D:prop> +- <D:getetag> +- <C:calendar-data> +-<C:filter> +- <C:comp-filter name="VCALENDAR"> +-|] ++ where ++ root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) $ concat ++ [[XML.NodeElement ++ (XML.Element ++ (XML.Name ++ (Data.Text.pack "D:lockscope") Nothing Nothing) ++ Map.empty ++ (concat ++ [[XML.NodeElement ++ (XML.Element ++ (XML.Name ++ (Data.Text.pack "D:exclusive") Nothing Nothing) ++ Map.empty ++ (concat []))]]))], ++ [XML.NodeElement ++ (XML.Element ++ (XML.Name ++ (Data.Text.pack "D:locktype") Nothing Nothing) ++ Map.empty ++ (concat ++ [[XML.NodeElement ++ (XML.Element ++ (XML.Name (Data.Text.pack "D:write") Nothing Nothing) ++ Map.empty ++ (concat []))]]))], ++ [XML.NodeElement ++ (XML.Element ++ (XML.Name (Data.Text.pack "D:owner") Nothing Nothing) ++ Map.empty ++ (concat ++ [[XML.NodeContent ++ (Data.Text.pack "Haskell DAV user")]]))]] ++ +diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs +index 9fb3495..18b8df7 100644 +--- a/Network/Protocol/HTTP/DAV/TH.hs ++++ b/Network/Protocol/HTTP/DAV/TH.hs +@@ -20,7 +20,8 @@ + + module Network.Protocol.HTTP.DAV.TH where + +-import Control.Lens (makeLenses) ++import qualified Control.Lens.Type ++import qualified Data.Functor + import qualified Data.ByteString as B + import Network.HTTP.Conduit (Manager, Request) + +@@ -46,4 +47,195 @@ data DAVContext a = DAVContext { + , _basicpassword :: B.ByteString + , _depth :: Maybe Depth + } +-makeLenses ''DAVContext ++allowedMethods :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) [B.ByteString] ++allowedMethods ++ _f_a5GM ++ (DAVContext __allowedMethods'_a5GN ++ __baseRequest_a5GP ++ __complianceClasses_a5GQ ++ __httpManager_a5GR ++ __lockToken_a5GS ++ __basicusername_a5GT ++ __basicpassword_a5GU ++ __depth_a5GV) ++ = ((\ __allowedMethods_a5GO ++ -> DAVContext ++ __allowedMethods_a5GO ++ __baseRequest_a5GP ++ __complianceClasses_a5GQ ++ __httpManager_a5GR ++ __lockToken_a5GS ++ __basicusername_a5GT ++ __basicpassword_a5GU ++ __depth_a5GV) ++ Data.Functor.<$> (_f_a5GM __allowedMethods'_a5GN)) ++{-# INLINE allowedMethods #-} ++baseRequest :: ++ Control.Lens.Type.Lens (DAVContext a_a4I4) (DAVContext a_a5GW) (Request a_a4I4) (Request a_a5GW) ++baseRequest ++ _f_a5GX ++ (DAVContext __allowedMethods_a5GY ++ __baseRequest'_a5GZ ++ __complianceClasses_a5H1 ++ __httpManager_a5H2 ++ __lockToken_a5H3 ++ __basicusername_a5H4 ++ __basicpassword_a5H5 ++ __depth_a5H6) ++ = ((\ __baseRequest_a5H0 ++ -> DAVContext ++ __allowedMethods_a5GY ++ __baseRequest_a5H0 ++ __complianceClasses_a5H1 ++ __httpManager_a5H2 ++ __lockToken_a5H3 ++ __basicusername_a5H4 ++ __basicpassword_a5H5 ++ __depth_a5H6) ++ Data.Functor.<$> (_f_a5GX __baseRequest'_a5GZ)) ++{-# INLINE baseRequest #-} ++basicpassword :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) B.ByteString ++basicpassword ++ _f_a5H7 ++ (DAVContext __allowedMethods_a5H8 ++ __baseRequest_a5H9 ++ __complianceClasses_a5Ha ++ __httpManager_a5Hb ++ __lockToken_a5Hc ++ __basicusername_a5Hd ++ __basicpassword'_a5He ++ __depth_a5Hg) ++ = ((\ __basicpassword_a5Hf ++ -> DAVContext ++ __allowedMethods_a5H8 ++ __baseRequest_a5H9 ++ __complianceClasses_a5Ha ++ __httpManager_a5Hb ++ __lockToken_a5Hc ++ __basicusername_a5Hd ++ __basicpassword_a5Hf ++ __depth_a5Hg) ++ Data.Functor.<$> (_f_a5H7 __basicpassword'_a5He)) ++{-# INLINE basicpassword #-} ++basicusername :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) B.ByteString ++basicusername ++ _f_a5Hh ++ (DAVContext __allowedMethods_a5Hi ++ __baseRequest_a5Hj ++ __complianceClasses_a5Hk ++ __httpManager_a5Hl ++ __lockToken_a5Hm ++ __basicusername'_a5Hn ++ __basicpassword_a5Hp ++ __depth_a5Hq) ++ = ((\ __basicusername_a5Ho ++ -> DAVContext ++ __allowedMethods_a5Hi ++ __baseRequest_a5Hj ++ __complianceClasses_a5Hk ++ __httpManager_a5Hl ++ __lockToken_a5Hm ++ __basicusername_a5Ho ++ __basicpassword_a5Hp ++ __depth_a5Hq) ++ Data.Functor.<$> (_f_a5Hh __basicusername'_a5Hn)) ++{-# INLINE basicusername #-} ++complianceClasses :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) [B.ByteString] ++complianceClasses ++ _f_a5Hr ++ (DAVContext __allowedMethods_a5Hs ++ __baseRequest_a5Ht ++ __complianceClasses'_a5Hu ++ __httpManager_a5Hw ++ __lockToken_a5Hx ++ __basicusername_a5Hy ++ __basicpassword_a5Hz ++ __depth_a5HA) ++ = ((\ __complianceClasses_a5Hv ++ -> DAVContext ++ __allowedMethods_a5Hs ++ __baseRequest_a5Ht ++ __complianceClasses_a5Hv ++ __httpManager_a5Hw ++ __lockToken_a5Hx ++ __basicusername_a5Hy ++ __basicpassword_a5Hz ++ __depth_a5HA) ++ Data.Functor.<$> (_f_a5Hr __complianceClasses'_a5Hu)) ++{-# INLINE complianceClasses #-} ++depth :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) (Maybe Depth) ++depth ++ _f_a5HB ++ (DAVContext __allowedMethods_a5HC ++ __baseRequest_a5HD ++ __complianceClasses_a5HE ++ __httpManager_a5HF ++ __lockToken_a5HG ++ __basicusername_a5HH ++ __basicpassword_a5HI ++ __depth'_a5HJ) ++ = ((\ __depth_a5HK ++ -> DAVContext ++ __allowedMethods_a5HC ++ __baseRequest_a5HD ++ __complianceClasses_a5HE ++ __httpManager_a5HF ++ __lockToken_a5HG ++ __basicusername_a5HH ++ __basicpassword_a5HI ++ __depth_a5HK) ++ Data.Functor.<$> (_f_a5HB __depth'_a5HJ)) ++{-# INLINE depth #-} ++httpManager :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) Manager ++httpManager ++ _f_a5HL ++ (DAVContext __allowedMethods_a5HM ++ __baseRequest_a5HN ++ __complianceClasses_a5HO ++ __httpManager'_a5HP ++ __lockToken_a5HR ++ __basicusername_a5HS ++ __basicpassword_a5HT ++ __depth_a5HU) ++ = ((\ __httpManager_a5HQ ++ -> DAVContext ++ __allowedMethods_a5HM ++ __baseRequest_a5HN ++ __complianceClasses_a5HO ++ __httpManager_a5HQ ++ __lockToken_a5HR ++ __basicusername_a5HS ++ __basicpassword_a5HT ++ __depth_a5HU) ++ Data.Functor.<$> (_f_a5HL __httpManager'_a5HP)) ++{-# INLINE httpManager #-} ++lockToken :: ++ Control.Lens.Type.Lens' (DAVContext a_a4I4) (Maybe B.ByteString) ++lockToken ++ _f_a5HV ++ (DAVContext __allowedMethods_a5HW ++ __baseRequest_a5HX ++ __complianceClasses_a5HY ++ __httpManager_a5HZ ++ __lockToken'_a5I0 ++ __basicusername_a5I2 ++ __basicpassword_a5I3 ++ __depth_a5I4) ++ = ((\ __lockToken_a5I1 ++ -> DAVContext ++ __allowedMethods_a5HW ++ __baseRequest_a5HX ++ __complianceClasses_a5HY ++ __httpManager_a5HZ ++ __lockToken_a5I1 ++ __basicusername_a5I2 ++ __basicpassword_a5I3 ++ __depth_a5I4) ++ Data.Functor.<$> (_f_a5HV __lockToken'_a5I0)) ++{-# INLINE lockToken #-} diff --git a/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch b/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch index 3114653f2..dfcdc387f 100644 --- a/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch +++ b/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch @@ -1,31 +1,25 @@ -From 32d0741c64e6bd280e46f7c452db9462fbac05f9 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 7 May 2013 18:21:04 -0400 -Subject: [PATCH] fix build +From 5c57c4ae7dac0c1aa940005f5ea55fdcd4fcd1f5 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 22:46:42 +0000 +Subject: [PATCH] fix build with new base --- - HTTP.cabal | 4 ++-- - 1 file changed, 2 insertions(+), 2 deletions(-) + HTTP.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/HTTP.cabal b/HTTP.cabal -index 76cb5d6..edddf26 100644 +index 76cb5d6..bb38f24 100644 --- a/HTTP.cabal +++ b/HTTP.cabal -@@ -85,12 +85,12 @@ Library +@@ -85,7 +85,7 @@ Library Network.HTTP.Utils Paths_HTTP GHC-options: -fwarn-missing-signatures -Wall - Build-depends: base >= 2 && < 4.7, network < 2.5, parsec -+ Build-depends: base >= 2 && < 4.8, network < 2.5, parsec ++ Build-depends: base >= 2 && < 4.9, network < 2.5, parsec Extensions: FlexibleInstances if flag(old-base) Build-depends: base < 3 - else -- Build-depends: base >= 3, array, old-time, bytestring -+ Build-depends: base >= 3, array, old-time, bytestring (>= 0.10.3.0) - - if flag(mtl1) - Build-depends: mtl >= 1.1 && < 1.2 -- 1.7.10.4 diff --git a/standalone/android/haskell-patches/MonadCatchIO-transformers_hack-to-get-to-build-with-new-ghc.patch b/standalone/android/haskell-patches/MonadCatchIO-transformers_hack-to-get-to-build-with-new-ghc.patch new file mode 100644 index 000000000..9881d35d6 --- /dev/null +++ b/standalone/android/haskell-patches/MonadCatchIO-transformers_hack-to-get-to-build-with-new-ghc.patch @@ -0,0 +1,56 @@ +From 083c9d135ec68316db173235994c63603ad76444 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 23:01:35 +0000 +Subject: [PATCH] hack to get to build with new ghc + +Copied the old implemenations of block and unblock from old Control.Exception +since these deprecated functions have now been removed. +--- + MonadCatchIO-transformers.cabal | 2 +- + src/Control/Monad/CatchIO.hs | 13 +++++++++++-- + 2 files changed, 12 insertions(+), 3 deletions(-) + +diff --git a/MonadCatchIO-transformers.cabal b/MonadCatchIO-transformers.cabal +index fe6674d..b9f559f 100644 +--- a/MonadCatchIO-transformers.cabal ++++ b/MonadCatchIO-transformers.cabal +@@ -26,4 +26,4 @@ Library + Exposed-Modules: + Control.Monad.CatchIO + Hs-Source-Dirs: src +- Ghc-options: -Wall ++ Ghc-options: -Wall -fglasgow-exts +diff --git a/src/Control/Monad/CatchIO.hs b/src/Control/Monad/CatchIO.hs +index 62afb83..853996b 100644 +--- a/src/Control/Monad/CatchIO.hs ++++ b/src/Control/Monad/CatchIO.hs +@@ -19,6 +19,9 @@ where + import Prelude hiding ( catch ) + import Control.Applicative ((<$>)) + import qualified Control.Exception.Extensible as E ++import qualified Control.Exception.Base as E ++import GHC.Base (maskAsyncExceptions#) ++import GHC.IO (unsafeUnmask, IO(..)) + + import Control.Monad.IO.Class (MonadIO,liftIO) + +@@ -51,8 +54,14 @@ class MonadIO m => MonadCatchIO m where + + instance MonadCatchIO IO where + catch = E.catch +- block = E.block +- unblock = E.unblock ++ block = oldblock ++ unblock = oldunblock ++ ++oldblock :: IO a -> IO a ++oldblock (IO io) = IO $ maskAsyncExceptions# io ++ ++oldunblock :: IO a -> IO a ++oldunblock = unsafeUnmask + + -- | Warning: this instance is somewhat contentious. + -- +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch b/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch new file mode 100644 index 000000000..a79ca519a --- /dev/null +++ b/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch @@ -0,0 +1,36 @@ +From 010db89634eb0f64e7961581e65da3acbb2b9f3d Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 22:05:41 +0000 +Subject: [PATCH] fix build with new base + +--- + src/Control/Concurrent/MSampleVar.hs | 6 +----- + 1 file changed, 1 insertion(+), 5 deletions(-) + +diff --git a/src/Control/Concurrent/MSampleVar.hs b/src/Control/Concurrent/MSampleVar.hs +index d029c64..16ad6c5 100644 +--- a/src/Control/Concurrent/MSampleVar.hs ++++ b/src/Control/Concurrent/MSampleVar.hs +@@ -30,7 +30,7 @@ module Control.Concurrent.MSampleVar + import Control.Monad(void,join) + import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar) + import Control.Exception(mask_) +-import Data.Typeable(Typeable1(typeOf1),mkTyCon,mkTyConApp) ++import Data.Typeable(mkTyConApp) + + -- | + -- Sample variables are slightly different from a normal 'MVar': +@@ -62,10 +62,6 @@ data MSampleVar a = MSampleVar { readQueue :: MVar () + , lockedStore :: MVar (MVar a) } + deriving (Eq) + +-instance Typeable1 MSampleVar where +- typeOf1 _ = mkTyConApp tc [] +- where tc = mkTyCon "MSampleVar" +- + + -- | 'newEmptySV' allocates a new MSampleVar in an empty state. No futher + -- allocation is done when using the 'MSampleVar'. +-- +1.7.10.4 + 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_fix-build-with-new-ghc.patch index e959941b8..727720ad4 100644 --- a/standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch +++ b/standalone/android/haskell-patches/async_fix-build-with-new-ghc.patch @@ -1,14 +1,14 @@ -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 +From 0035f0366e426af213244b2eb25ffb63cb9e74d0 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 06:14:50 +0000 +Subject: [PATCH] fix build with new ghc --- async.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/async.cabal b/async.cabal -index 8e47d9d..ff317c7 100644 +index 8e47d9d..98e6312 100644 --- a/async.cabal +++ b/async.cabal @@ -70,7 +70,7 @@ source-repository head @@ -16,7 +16,7 @@ index 8e47d9d..ff317c7 100644 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 ++ build-depends: base >= 4.3 && < 4.9, stm >= 2.2 && < 2.5 test-suite test-async type: exitcode-stdio-1.0 diff --git a/standalone/android/haskell-patches/bloomfilter_fix-build-with-newer-base.patch b/standalone/android/haskell-patches/bloomfilter_fix-build-with-newer-base.patch new file mode 100644 index 000000000..d2f783a7f --- /dev/null +++ b/standalone/android/haskell-patches/bloomfilter_fix-build-with-newer-base.patch @@ -0,0 +1,26 @@ +From 09bcaf4f203c39c967a6951d56fd015347bb5dae Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 21:57:21 +0000 +Subject: [PATCH] fix build with newer base + +--- + Data/BloomFilter/Array.hs | 3 ++- + 1 file changed, 2 insertions(+), 1 deletion(-) + +diff --git a/Data/BloomFilter/Array.hs b/Data/BloomFilter/Array.hs +index e085bbe..d94757a 100644 +--- a/Data/BloomFilter/Array.hs ++++ b/Data/BloomFilter/Array.hs +@@ -3,7 +3,8 @@ + + module Data.BloomFilter.Array (newArray) where + +-import Control.Monad.ST (ST, unsafeIOToST) ++import Control.Monad.ST (ST) ++import Control.Monad.ST.Unsafe (unsafeIOToST) + import Data.Array.Base (MArray, STUArray(..), unsafeNewArray_) + #if __GLASGOW_HASKELL__ >= 704 + import Foreign.C.Types (CInt(..), CSize(..)) +-- +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/comonad_cross-build.patch b/standalone/android/haskell-patches/comonad_cross-build.patch new file mode 100644 index 000000000..e0317926f --- /dev/null +++ b/standalone/android/haskell-patches/comonad_cross-build.patch @@ -0,0 +1,25 @@ +From 2cb43c46d345341d1aa77c4b2a88514c056d3122 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 22:25:18 +0000 +Subject: [PATCH] cross build + +--- + comonad.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/comonad.cabal b/comonad.cabal +index e01f1a7..e807e05 100644 +--- a/comonad.cabal ++++ b/comonad.cabal +@@ -13,7 +13,7 @@ copyright: Copyright (C) 2008-2013 Edward A. Kmett, + Copyright (C) 2004-2008 Dave Menendez + synopsis: Haskell 98 compatible comonads + description: Haskell 98 compatible comonads +-build-type: Custom ++build-type: Simple + extra-source-files: + .gitignore + .travis.yml +-- +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/entropy_cross-build.patch b/standalone/android/haskell-patches/entropy_cross-build.patch new file mode 100644 index 000000000..d09cd13ec --- /dev/null +++ b/standalone/android/haskell-patches/entropy_cross-build.patch @@ -0,0 +1,25 @@ +From 35c6718205e9d7f5e5fc44578ea6a9971beac151 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 23:32:18 +0000 +Subject: [PATCH] cross build + +--- + entropy.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/entropy.cabal b/entropy.cabal +index 45e4705..17553d8 100644 +--- a/entropy.cabal ++++ b/entropy.cabal +@@ -14,7 +14,7 @@ category: Data, Cryptography + homepage: https://github.com/TomMD/entropy + bug-reports: https://github.com/TomMD/entropy/issues + stability: stable +-build-type: Custom ++build-type: Simple + cabal-version: >= 1.6 + tested-with: GHC == 6.12.1 + data-files: +-- +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/file-embed_export-TH-symbols.patch b/standalone/android/haskell-patches/file-embed_export-TH-symbols.patch new file mode 100644 index 000000000..865cbe3cc --- /dev/null +++ b/standalone/android/haskell-patches/file-embed_export-TH-symbols.patch @@ -0,0 +1,25 @@ +From fdbd29ce6e8ff11f721f9e74cac1f4ca14e6773d Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 07:06:33 +0000 +Subject: [PATCH] export TH symbols + +--- + Data/FileEmbed.hs | 2 ++ + 1 file changed, 2 insertions(+) + +diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs +index c17f082..6654f60 100644 +--- a/Data/FileEmbed.hs ++++ b/Data/FileEmbed.hs +@@ -26,6 +26,8 @@ module Data.FileEmbed + #endif + , inject + , injectFile ++ -- used by TH (pointlessly) ++ , stringToBs + ) where + + import Language.Haskell.TH.Syntax +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch b/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch new file mode 100644 index 000000000..ff9d8f245 --- /dev/null +++ b/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch @@ -0,0 +1,50 @@ +From afdec6c9e66211a0ac8419fffe191b059d1fd00c Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 17:24:33 +0000 +Subject: [PATCH] fix build with new base + +--- + Data/Text/IDN/IDNA.chs | 1 + + Data/Text/IDN/Punycode.chs | 1 + + Data/Text/IDN/StringPrep.chs | 1 + + 3 files changed, 3 insertions(+) + +diff --git a/Data/Text/IDN/IDNA.chs b/Data/Text/IDN/IDNA.chs +index ed29ee4..dbb4ba5 100644 +--- a/Data/Text/IDN/IDNA.chs ++++ b/Data/Text/IDN/IDNA.chs +@@ -31,6 +31,7 @@ import Foreign + import Foreign.C + + import Data.Text.IDN.Internal ++import System.IO.Unsafe + + #include <idna.h> + #include <idn-free.h> +diff --git a/Data/Text/IDN/Punycode.chs b/Data/Text/IDN/Punycode.chs +index 24b5fa6..4e62555 100644 +--- a/Data/Text/IDN/Punycode.chs ++++ b/Data/Text/IDN/Punycode.chs +@@ -32,6 +32,7 @@ import Data.List (unfoldr) + import qualified Data.ByteString as B + import qualified Data.Text as T + ++import System.IO.Unsafe + import Foreign + import Foreign.C + +diff --git a/Data/Text/IDN/StringPrep.chs b/Data/Text/IDN/StringPrep.chs +index 752dc9e..5e9fd84 100644 +--- a/Data/Text/IDN/StringPrep.chs ++++ b/Data/Text/IDN/StringPrep.chs +@@ -39,6 +39,7 @@ import qualified Data.ByteString as B + import qualified Data.Text as T + import qualified Data.Text.Encoding as TE + ++import System.IO.Unsafe + import Foreign + import Foreign.C + +-- +1.7.10.4 + 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/hamlet_1.1.6.1_0001-remove-TH.patch b/standalone/android/haskell-patches/hamlet_1.1.6.1_0001-remove-TH.patch deleted file mode 100644 index 1c511a132..000000000 --- a/standalone/android/haskell-patches/hamlet_1.1.6.1_0001-remove-TH.patch +++ /dev/null @@ -1,294 +0,0 @@ -From b2c677ed39f1aca3a1111691ba51b26f7fd414a4 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Wed, 8 May 2013 01:50:58 -0400 -Subject: [PATCH] remove TH - ---- - Text/Hamlet.hs | 219 ++------------------------------------------------------ - hamlet.cabal | 2 +- - 2 files changed, 7 insertions(+), 214 deletions(-) - -diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs -index 4ac870a..63b8555 100644 ---- a/Text/Hamlet.hs -+++ b/Text/Hamlet.hs -@@ -11,35 +11,26 @@ - module Text.Hamlet - ( -- * Plain HTML - Html -- , shamlet -- , shamletFile -- , xshamlet -- , xshamletFile - -- * Hamlet - , HtmlUrl -- , hamlet -- , hamletFile -- , xhamlet -- , xhamletFile - -- * I18N Hamlet - , HtmlUrlI18n -- , ihamlet -- , ihamletFile - -- * Type classes - , ToAttributes (..) - -- * Internal, for making more - , HamletSettings (..) - , NewlineStyle (..) -- , hamletWithSettings -- , hamletFileWithSettings - , defaultHamletSettings - , xhtmlHamletSettings - , Env (..) - , HamletRules (..) -- , hamletRules -- , ihamletRules -- , htmlRules - , CloseStyle (..) -+ , condH -+ , maybeH -+ -+ -- referred to in TH splices -+ , attrsToHtml -+ , asHtmlUrl - ) where - - import Text.Shakespeare.Base -@@ -90,14 +81,6 @@ type HtmlUrl url = Render url -> Html - -- | A function generating an 'Html' given a message translator and a URL rendering function. - type HtmlUrlI18n msg url = Translate msg -> Render url -> Html - --docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp --docsToExp env hr scope docs = do -- exps <- mapM (docToExp env hr scope) docs -- case exps of -- [] -> [|return ()|] -- [x] -> return x -- _ -> return $ DoE $ map NoBindS exps -- - unIdent :: Ident -> String - unIdent (Ident s) = s - -@@ -159,169 +142,9 @@ recordToFieldNames conStr = do - [fields] <- return [fields | RecC name fields <- cons, name == conName] - return [fieldName | (fieldName, _, _) <- fields] - --docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp --docToExp env hr scope (DocForall list idents inside) = do -- let list' = derefToExp scope list -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- mh <- [|F.mapM_|] -- inside' <- docsToExp env hr scope' inside -- let lam = LamE [pat] inside' -- return $ mh `AppE` lam `AppE` list' --docToExp env hr scope (DocWith [] inside) = do -- inside' <- docsToExp env hr scope inside -- return $ inside' --docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do -- let deref' = derefToExp scope deref -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- inside' <- docToExp env hr scope' (DocWith dis inside) -- let lam = LamE [pat] inside' -- return $ lam `AppE` deref' --docToExp env hr scope (DocMaybe val idents inside mno) = do -- let val' = derefToExp scope val -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- inside' <- docsToExp env hr scope' inside -- let inside'' = LamE [pat] inside' -- ninside' <- case mno of -- Nothing -> [|Nothing|] -- Just no -> do -- no' <- docsToExp env hr scope no -- j <- [|Just|] -- return $ j `AppE` no' -- mh <- [|maybeH|] -- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside' --docToExp env hr scope (DocCond conds final) = do -- conds' <- mapM go conds -- final' <- case final of -- Nothing -> [|Nothing|] -- Just f -> do -- f' <- docsToExp env hr scope f -- j <- [|Just|] -- return $ j `AppE` f' -- ch <- [|condH|] -- return $ ch `AppE` ListE conds' `AppE` final' -- where -- go :: (Deref, [Doc]) -> Q Exp -- go (d, docs) = do -- let d' = derefToExp scope d -- docs' <- docsToExp env hr scope docs -- return $ TupE [d', docs'] --docToExp env hr scope (DocCase deref cases) = do -- let exp_ = derefToExp scope deref -- matches <- mapM toMatch cases -- return $ CaseE exp_ matches -- where -- readMay s = -- case reads s of -- (x, ""):_ -> Just x -- _ -> Nothing -- toMatch (idents, inside) = do -- let pat = case map unIdent idents of -- ["_"] -> WildP -- [str] -- | Just i <- readMay str -> LitP $ IntegerL i -- strs -> let (constr:fields) = map mkName strs -- in ConP constr (map VarP fields) -- insideExp <- docsToExp env hr scope inside -- return $ Match pat (NormalB insideExp) [] --docToExp env hr v (DocContent c) = contentToExp env hr v c -- --contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp --contentToExp _ hr _ (ContentRaw s) = do -- os <- [|preEscapedText . pack|] -- let s' = LitE $ StringL s -- return $ hrFromHtml hr `AppE` (os `AppE` s') --contentToExp _ hr scope (ContentVar d) = do -- str <- [|toHtml|] -- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d) --contentToExp env hr scope (ContentUrl hasParams d) = -- case urlRender env of -- Nothing -> error "URL interpolation used, but no URL renderer provided" -- Just wrender -> wrender $ \render -> do -- let render' = return render -- ou <- if hasParams -- then [|\(u, p) -> $(render') u p|] -- else [|\u -> $(render') u []|] -- let d' = derefToExp scope d -- pet <- [|toHtml|] -- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d')) --contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d --contentToExp env hr scope (ContentMsg d) = -- case msgRender env of -- Nothing -> error "Message interpolation used, but no message renderer provided" -- Just wrender -> wrender $ \render -> -- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d) --contentToExp _ hr scope (ContentAttrs d) = do -- html <- [|attrsToHtml . toAttributes|] -- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d) -- --shamlet :: QuasiQuoter --shamlet = hamletWithSettings htmlRules defaultHamletSettings -- --xshamlet :: QuasiQuoter --xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings -- --htmlRules :: Q HamletRules --htmlRules = do -- i <- [|id|] -- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b) -- --hamlet :: QuasiQuoter --hamlet = hamletWithSettings hamletRules defaultHamletSettings -- --xhamlet :: QuasiQuoter --xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings -- - asHtmlUrl :: HtmlUrl url -> HtmlUrl url - asHtmlUrl = id - --hamletRules :: Q HamletRules --hamletRules = do -- i <- [|id|] -- let ur f = do -- r <- newName "_render" -- let env = Env -- { urlRender = Just ($ (VarE r)) -- , msgRender = Nothing -- } -- h <- f env -- return $ LamE [VarP r] h -- return $ HamletRules i ur em -- where -- em (Env (Just urender) Nothing) e = do -- asHtmlUrl' <- [|asHtmlUrl|] -- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur') -- em _ _ = error "bad Env" -- --ihamlet :: QuasiQuoter --ihamlet = hamletWithSettings ihamletRules defaultHamletSettings -- --ihamletRules :: Q HamletRules --ihamletRules = do -- i <- [|id|] -- let ur f = do -- u <- newName "_urender" -- m <- newName "_mrender" -- let env = Env -- { urlRender = Just ($ (VarE u)) -- , msgRender = Just ($ (VarE m)) -- } -- h <- f env -- return $ LamE [VarP m, VarP u] h -- return $ HamletRules i ur em -- where -- em (Env (Just urender) (Just mrender)) e = -- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur') -- em _ _ = error "bad Env" -- --hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter --hamletWithSettings hr set = -- QuasiQuoter -- { quoteExp = hamletFromString hr set -- } -- - data HamletRules = HamletRules - { hrFromHtml :: Exp - , hrWithEnv :: (Env -> Q Exp) -> Q Exp -@@ -333,36 +156,6 @@ data Env = Env - , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp) - } - --hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp --hamletFromString qhr set s = do -- hr <- qhr -- case parseDoc set s of -- Error s' -> error s' -- Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d -- --hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp --hamletFileWithSettings qhr set fp = do --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp -- hamletFromString qhr set contents -- --hamletFile :: FilePath -> Q Exp --hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings -- --xhamletFile :: FilePath -> Q Exp --xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings -- --shamletFile :: FilePath -> Q Exp --shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings -- --xshamletFile :: FilePath -> Q Exp --xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings -- --ihamletFile :: FilePath -> Q Exp --ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings -- - varName :: Scope -> String -> Exp - varName _ "" = error "Illegal empty varName" - varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope -diff --git a/hamlet.cabal b/hamlet.cabal -index 73fa6a8..4348508 100644 ---- a/hamlet.cabal -+++ b/hamlet.cabal -@@ -50,7 +50,7 @@ library - , text >= 0.7 && < 0.12 - , containers >= 0.2 - , blaze-builder >= 0.2 && < 0.4 -- , process >= 1.0 && < 1.2 -+ , process >= 1.0 && < 1.3 - , blaze-html >= 0.5 && < 0.6 - , blaze-markup >= 0.5.1 && < 0.6 - --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/hamlet_export-TH-splice-stuff.patch b/standalone/android/haskell-patches/hamlet_export-TH-splice-stuff.patch new file mode 100644 index 000000000..a446fa18f --- /dev/null +++ b/standalone/android/haskell-patches/hamlet_export-TH-splice-stuff.patch @@ -0,0 +1,28 @@ +From 9819f4b387679c889f1259f9fd969513aa2efcf2 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 03:51:06 +0000 +Subject: [PATCH] export TH splice stuff + +--- + Text/Hamlet.hs | 5 +++++ + 1 file changed, 5 insertions(+) + +diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs +index 6568d6c..687dec4 100644 +--- a/Text/Hamlet.hs ++++ b/Text/Hamlet.hs +@@ -40,6 +40,11 @@ module Text.Hamlet + , ihamletRules + , htmlRules + , CloseStyle (..) ++ -- referred to by TH splices ++ , asHtmlUrl ++ , maybeH ++ , condH ++ , attrsToHtml + ) where + + import Text.Shakespeare.Base +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/lens_3.8.5-0001-build-without-TH.patch b/standalone/android/haskell-patches/lens_various-hacking-to-cross-build.patch index 62efccc32..734da8708 100644 --- a/standalone/android/haskell-patches/lens_3.8.5-0001-build-without-TH.patch +++ b/standalone/android/haskell-patches/lens_various-hacking-to-cross-build.patch @@ -1,27 +1,30 @@ -From bbb49942123f06a36b170966e445692297f71d26 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 18 Apr 2013 19:14:30 -0400 -Subject: [PATCH] build without TH +From 3141355f14d6acb9382bebcf8723c411be5aa62f Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 00:31:39 +0000 +Subject: [PATCH] various hacking to cross build --- - lens.cabal | 13 +------------ - src/Control/Exception/Lens.hs | 2 +- - src/Control/Lens.hs | 6 +++--- - src/Control/Lens/Equality.hs | 4 ++-- - src/Control/Lens/Fold.hs | 6 +++--- - src/Control/Lens/Internal.hs | 2 +- - src/Control/Lens/Internal/Zipper.hs | 2 +- - src/Control/Lens/Iso.hs | 2 -- - src/Control/Lens/Lens.hs | 2 +- - src/Control/Lens/Operators.hs | 2 +- - src/Control/Lens/Plated.hs | 2 +- - src/Control/Lens/Setter.hs | 2 -- - src/Control/Lens/TH.hs | 2 +- - src/Data/Data/Lens.hs | 6 +++--- - 14 files changed, 19 insertions(+), 34 deletions(-) + lens.cabal | 12 +----------- + src/Control/Exception/Lens.hs | 2 +- + src/Control/Lens.hs | 6 +++--- + src/Control/Lens/Equality.hs | 4 ++-- + src/Control/Lens/Fold.hs | 6 +++--- + src/Control/Lens/Internal.hs | 2 +- + src/Control/Lens/Internal/Exception.hs | 26 +------------------------- + src/Control/Lens/Internal/Instances.hs | 14 -------------- + src/Control/Lens/Internal/Zipper.hs | 2 +- + src/Control/Lens/Iso.hs | 2 -- + src/Control/Lens/Lens.hs | 2 +- + src/Control/Lens/Operators.hs | 2 +- + src/Control/Lens/Plated.hs | 2 +- + src/Control/Lens/Prism.hs | 2 -- + src/Control/Lens/Setter.hs | 2 -- + src/Control/Lens/TH.hs | 2 +- + src/Data/Data/Lens.hs | 6 +++--- + 17 files changed, 20 insertions(+), 74 deletions(-) diff --git a/lens.cabal b/lens.cabal -index a06b3ce..a654b3d 100644 +index 2a94e1e..1f9a4b7 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional @@ -33,15 +36,7 @@ index a06b3ce..a654b3d 100644 tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1, GHC == 7.7.20121213, GHC == 7.7.20130117 synopsis: Lenses, Folds and Traversals description: -@@ -171,7 +171,6 @@ library - containers >= 0.4.0 && < 0.6, - distributive >= 0.3 && < 1, - filepath >= 1.2.0.0 && < 1.4, -- generic-deriving == 1.4.*, - ghc-prim, - hashable >= 1.1.2.3 && < 1.3, - MonadCatchIO-transformers >= 0.3 && < 0.4, -@@ -233,14 +232,12 @@ library +@@ -238,14 +238,12 @@ library Control.Lens.Review Control.Lens.Setter Control.Lens.Simple @@ -56,7 +51,7 @@ index a06b3ce..a654b3d 100644 Control.Parallel.Strategies.Lens Control.Seq.Lens Data.Array.Lens -@@ -264,12 +261,8 @@ library +@@ -269,12 +267,8 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens @@ -69,7 +64,7 @@ index a06b3ce..a654b3d 100644 Numeric.Lens if flag(safe) -@@ -368,7 +361,6 @@ test-suite doctests +@@ -373,7 +367,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, @@ -77,7 +72,7 @@ index a06b3ce..a654b3d 100644 mtl, nats, parallel, -@@ -394,7 +386,6 @@ benchmark plated +@@ -399,7 +392,6 @@ benchmark plated comonad, criterion, deepseq, @@ -85,7 +80,7 @@ index a06b3ce..a654b3d 100644 lens, transformers -@@ -429,7 +420,6 @@ benchmark unsafe +@@ -434,7 +426,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, @@ -93,7 +88,7 @@ index a06b3ce..a654b3d 100644 lens, transformers -@@ -446,6 +436,5 @@ benchmark zipper +@@ -451,6 +442,5 @@ benchmark zipper comonads-fd, criterion, deepseq, @@ -101,7 +96,7 @@ index a06b3ce..a654b3d 100644 lens, transformers diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs -index 5c26d4e..9909132 100644 +index 4bc3926..28f55be 100644 --- a/src/Control/Exception/Lens.hs +++ b/src/Control/Exception/Lens.hs @@ -112,7 +112,7 @@ import Prelude @@ -114,7 +109,7 @@ index 5c26d4e..9909132 100644 -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs -index 8481e44..74700ae 100644 +index 242c3c1..2ab9cdb 100644 --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs @@ -59,7 +59,7 @@ module Control.Lens @@ -157,10 +152,10 @@ index 982c2d7..3a3fe1a 100644 -- $setup -- >>> import Control.Lens diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs -index ae5100d..467eb37 100644 +index 32a4073..cc7da1e 100644 --- a/src/Control/Lens/Fold.hs +++ b/src/Control/Lens/Fold.hs -@@ -161,9 +161,9 @@ import Data.Traversable +@@ -163,9 +163,9 @@ import Data.Traversable -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force @@ -183,6 +178,90 @@ index 295662e..539642d 100644 -{-# ANN module "HLint: ignore Use import/export shortcut" #-} + +diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs +index 387203e..8bea89b 100644 +--- a/src/Control/Lens/Internal/Exception.hs ++++ b/src/Control/Lens/Internal/Exception.hs +@@ -36,6 +36,7 @@ import Data.Monoid + import Data.Proxy + import Data.Reflection + import Data.Typeable ++import Data.Typeable + import System.IO.Unsafe + + ------------------------------------------------------------------------------ +@@ -128,18 +129,6 @@ class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where + handler_ l = handler l . const + {-# INLINE handler_ #-} + +-instance Handleable SomeException IO Exception.Handler where +- handler = handlerIO +- +-instance Handleable SomeException m (CatchIO.Handler m) where +- handler = handlerCatchIO +- +-handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r +-handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a) +- +-handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r +-handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a) +- + ------------------------------------------------------------------------------ + -- Helpers + ------------------------------------------------------------------------------ +@@ -159,21 +148,8 @@ supply = unsafePerformIO $ newIORef 0 + -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does. + newtype Handling a s (m :: * -> *) = Handling a + +--- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap. +--- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep. +-instance Typeable (Handling a s m) where +- typeOf _ = unsafePerformIO $ do +- i <- atomicModifyIORef supply $ \a -> let a' = a + 1 in a' `seq` (a', a) +- return $ mkTyConApp (mkTyCon3 "lens" "Control.Lens.Internal.Exception" ("Handling" ++ show i)) [] +- {-# INLINE typeOf #-} +- + -- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here. + instance Show (Handling a s m) where + showsPrec d _ = showParen (d > 10) $ showString "Handling ..." + {-# INLINE showsPrec #-} + +-instance Reifies s (SomeException -> Maybe a) => Exception (Handling a s m) where +- toException _ = SomeException HandlingException +- {-# INLINE toException #-} +- fromException = fmap Handling . reflect (Proxy :: Proxy s) +- {-# INLINE fromException #-} +diff --git a/src/Control/Lens/Internal/Instances.hs b/src/Control/Lens/Internal/Instances.hs +index 6783f33..17715ce 100644 +--- a/src/Control/Lens/Internal/Instances.hs ++++ b/src/Control/Lens/Internal/Instances.hs +@@ -24,26 +24,12 @@ import Data.Traversable + -- Orphan Instances + ------------------------------------------------------------------------------- + +-instance Foldable ((,) b) where +- foldMap f (_, a) = f a +- + instance Foldable1 ((,) b) where + foldMap1 f (_, a) = f a + +-instance Traversable ((,) b) where +- traverse f (b, a) = (,) b <$> f a +- + instance Traversable1 ((,) b) where + traverse1 f (b, a) = (,) b <$> f a + +-instance Foldable (Either a) where +- foldMap _ (Left _) = mempty +- foldMap f (Right a) = f a +- +-instance Traversable (Either a) where +- traverse _ (Left b) = pure (Left b) +- traverse f (Right a) = Right <$> f a +- + instance Foldable (Const m) where + foldMap _ _ = mempty + diff --git a/src/Control/Lens/Internal/Zipper.hs b/src/Control/Lens/Internal/Zipper.hs index 95875b7..76060be 100644 --- a/src/Control/Lens/Internal/Zipper.hs @@ -197,12 +276,12 @@ index 95875b7..76060be 100644 ------------------------------------------------------------------------------ -- * Jacket diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs -index 62d40ef..235511a 100644 +index 1152af4..80c3175 100644 --- a/src/Control/Lens/Iso.hs +++ b/src/Control/Lens/Iso.hs -@@ -70,8 +70,6 @@ import Data.Profunctor.Unsafe - import Unsafe.Coerce - #endif +@@ -82,8 +82,6 @@ import Data.Maybe + import Data.Profunctor + import Data.Profunctor.Unsafe -{-# ANN module "HLint: ignore Use on" #-} - @@ -210,12 +289,12 @@ index 62d40ef..235511a 100644 -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs -index ff2a45f..5401ec4 100644 +index b26cc06..6f84943 100644 --- a/src/Control/Lens/Lens.hs +++ b/src/Control/Lens/Lens.hs -@@ -120,7 +120,7 @@ import Data.Profunctor - import Data.Profunctor.Rep +@@ -126,7 +126,7 @@ import Data.Profunctor.Rep import Data.Profunctor.Unsafe + import Data.Void -{-# ANN module "HLint: ignore Use ***" #-} + @@ -223,17 +302,17 @@ index ff2a45f..5401ec4 100644 -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs -index d88cb49..fa7b37e 100644 +index 11868e0..475c945 100644 --- a/src/Control/Lens/Operators.hs +++ b/src/Control/Lens/Operators.hs -@@ -107,4 +107,4 @@ import Control.Lens.Review +@@ -108,4 +108,4 @@ import Control.Lens.Review import Control.Lens.Setter import Control.Lens.Zipper -{-# ANN module "HLint: ignore Use import/export shortcut" #-} + diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs -index 07d9212..27070c0 100644 +index a8c4d20..cef574e 100644 --- a/src/Control/Lens/Plated.hs +++ b/src/Control/Lens/Plated.hs @@ -95,7 +95,7 @@ import Data.Data.Lens @@ -245,6 +324,19 @@ index 07d9212..27070c0 100644 -- | A 'Plated' type is one where we know how to extract its immediate self-similar children. -- +diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs +index 45b5cfe..88c7ff9 100644 +--- a/src/Control/Lens/Prism.hs ++++ b/src/Control/Lens/Prism.hs +@@ -53,8 +53,6 @@ import Unsafe.Coerce + import Data.Profunctor.Unsafe + #endif + +-{-# ANN module "HLint: ignore Use camelCase" #-} +- + -- $setup + -- >>> :set -XNoOverloadedStrings + -- >>> import Control.Lens diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs index 2acbfa6..4a12c6b 100644 --- a/src/Control/Lens/Setter.hs @@ -259,7 +351,7 @@ index 2acbfa6..4a12c6b 100644 -- >>> import Control.Lens -- >>> import Control.Monad.State diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs -index fbf4adb..ee723d7 100644 +index a05eb07..49218b5 100644 --- a/src/Control/Lens/TH.hs +++ b/src/Control/Lens/TH.hs @@ -87,7 +87,7 @@ import Language.Haskell.TH @@ -289,5 +381,5 @@ index cf1e7c9..b39dacf 100644 -- $setup -- >>> :set -XNoOverloadedStrings -- -1.8.2.rc3 +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/lifted-base_0.2.0.2_0001-hacked-for-newer-ghc.patch b/standalone/android/haskell-patches/lifted-base_0.2.0.2_0001-hacked-for-newer-ghc.patch deleted file mode 100644 index b61dc17ba..000000000 --- a/standalone/android/haskell-patches/lifted-base_0.2.0.2_0001-hacked-for-newer-ghc.patch +++ /dev/null @@ -1,163 +0,0 @@ -From 4bb0de1e6213ec925820c8b9cc3ff5f3c3c72d7a Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:31:27 -0400 -Subject: [PATCH] hacked for newer ghc - ---- - Control/Concurrent/Lifted.hs | 2 +- - Control/Exception/Lifted.hs | 11 ++-------- - Setup.hs | 46 ++---------------------------------------- - lifted-base.cabal | 9 ++++----- - 4 files changed, 9 insertions(+), 59 deletions(-) - -diff --git a/Control/Concurrent/Lifted.hs b/Control/Concurrent/Lifted.hs -index 4bc58a8..e4445e6 100644 ---- a/Control/Concurrent/Lifted.hs -+++ b/Control/Concurrent/Lifted.hs -@@ -124,7 +124,7 @@ import Control.Concurrent.SampleVar.Lifted - #endif - import Control.Exception.Lifted ( throwTo - #if MIN_VERSION_base(4,6,0) -- , SomeException, try, mask -+ , SomeException, try - #endif - ) - #include "inlinable.h" -diff --git a/Control/Exception/Lifted.hs b/Control/Exception/Lifted.hs -index 871cda7..0b9d8b7 100644 ---- a/Control/Exception/Lifted.hs -+++ b/Control/Exception/Lifted.hs -@@ -50,8 +50,8 @@ module Control.Exception.Lifted - -- |The following functions allow a thread to control delivery of - -- asynchronous exceptions during a critical region. - #if MIN_VERSION_base(4,3,0) -- , mask, mask_ -- , uninterruptibleMask, uninterruptibleMask_ -+ , mask_ -+ , uninterruptibleMask_ - , getMaskingState - #if MIN_VERSION_base(4,4,0) - , allowInterrupt -@@ -266,10 +266,6 @@ evaluate = liftBase ∘ E.evaluate - -------------------------------------------------------------------------------- - - #if MIN_VERSION_base(4,3,0) ---- |Generalized version of 'E.mask'. --mask ∷ MonadBaseControl IO m ⇒ ((∀ a. m a → m a) → m b) → m b --mask = liftBaseOp E.mask ∘ liftRestore --{-# INLINABLE mask #-} - - liftRestore ∷ MonadBaseControl IO m - ⇒ ((∀ a. m a → m a) → b) -@@ -283,9 +279,6 @@ mask_ = liftBaseOp_ E.mask_ - {-# INLINABLE mask_ #-} - - -- |Generalized version of 'E.uninterruptibleMask'. --uninterruptibleMask ∷ MonadBaseControl IO m ⇒ ((∀ a. m a → m a) → m b) → m b --uninterruptibleMask = liftBaseOp E.uninterruptibleMask ∘ liftRestore --{-# INLINABLE uninterruptibleMask #-} - - -- |Generalized version of 'E.uninterruptibleMask_'. - uninterruptibleMask_ ∷ MonadBaseControl IO m ⇒ m a → m a -diff --git a/Setup.hs b/Setup.hs -index 33956e1..9a994af 100644 ---- a/Setup.hs -+++ b/Setup.hs -@@ -1,44 +1,2 @@ --#! /usr/bin/env runhaskell -- --{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-} -- --module Main (main) where -- -- --------------------------------------------------------------------------------- ---- Imports --------------------------------------------------------------------------------- -- ---- from base --import System.IO ( IO ) -- ---- from cabal --import Distribution.Simple ( defaultMainWithHooks -- , simpleUserHooks -- , UserHooks(haddockHook) -- ) -- --import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) ) --import Distribution.Simple.Program ( userSpecifyArgs ) --import Distribution.Simple.Setup ( HaddockFlags ) --import Distribution.PackageDescription ( PackageDescription(..) ) -- -- --------------------------------------------------------------------------------- ---- Cabal setup program which sets the CPP define '__HADDOCK __' when haddock is run. --------------------------------------------------------------------------------- -- --main ∷ IO () --main = defaultMainWithHooks hooks -- where -- hooks = simpleUserHooks { haddockHook = haddockHook' } -- ---- Define __HADDOCK__ for CPP when running haddock. --haddockHook' ∷ PackageDescription → LocalBuildInfo → UserHooks → HaddockFlags → IO () --haddockHook' pkg lbi = -- haddockHook simpleUserHooks pkg (lbi { withPrograms = p }) -- where -- p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi) -- -- ---- The End --------------------------------------------------------------------- -+import Distribution.Simple -+main = defaultMain -diff --git a/lifted-base.cabal b/lifted-base.cabal -index 54ef418..8da5086 100644 ---- a/lifted-base.cabal -+++ b/lifted-base.cabal -@@ -9,7 +9,7 @@ Copyright: (c) 2011-2012 Bas van Dijk, Anders Kaseorg - Homepage: https://github.com/basvandijk/lifted-base - Bug-reports: https://github.com/basvandijk/lifted-base/issues - Category: Control --Build-type: Custom -+Build-type: Simple - Cabal-version: >= 1.9.2 - Description: @lifted-base@ exports IO operations from the base library lifted to - any instance of 'MonadBase' or 'MonadBaseControl'. -@@ -37,7 +37,6 @@ Library - Exposed-modules: Control.Exception.Lifted - Control.Concurrent.MVar.Lifted - Control.Concurrent.Chan.Lifted -- Control.Concurrent.Lifted - Data.IORef.Lifted - System.Timeout.Lifted - if impl(ghc < 7.6) -@@ -46,7 +45,7 @@ Library - Control.Concurrent.QSemN.Lifted - Control.Concurrent.SampleVar.Lifted - -- Build-depends: base >= 3 && < 4.7 -+ Build-depends: base >= 3 && < 4.8 - , base-unicode-symbols >= 0.1.1 && < 0.3 - , transformers-base >= 0.4 && < 0.5 - , monad-control >= 0.3 && < 0.4 -@@ -64,7 +63,7 @@ test-suite test-lifted-base - hs-source-dirs: test - - build-depends: lifted-base -- , base >= 3 && < 4.7 -+ , base >= 3 && < 4.8 - , transformers >= 0.2 && < 0.4 - , transformers-base >= 0.4 && < 0.5 - , monad-control >= 0.3 && < 0.4 -@@ -87,7 +86,7 @@ benchmark bench-lifted-base - ghc-options: -O2 - - build-depends: lifted-base -- , base >= 3 && < 4.7 -+ , base >= 3 && < 4.8 - , transformers >= 0.2 && < 0.4 - , criterion >= 0.5 && < 0.7 - , monad-control >= 0.3 && < 0.4 --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/lifted-base_crossbuild.patch b/standalone/android/haskell-patches/lifted-base_crossbuild.patch new file mode 100644 index 000000000..945aee491 --- /dev/null +++ b/standalone/android/haskell-patches/lifted-base_crossbuild.patch @@ -0,0 +1,25 @@ +From 8a98fa29048b508c64d5bb1e03ef89bfad8adc01 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 21:34:17 +0000 +Subject: [PATCH] crossbuild + +--- + lifted-base.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/lifted-base.cabal b/lifted-base.cabal +index 24f2860..3bef225 100644 +--- a/lifted-base.cabal ++++ b/lifted-base.cabal +@@ -9,7 +9,7 @@ Copyright: (c) 2011-2012 Bas van Dijk, Anders Kaseorg + Homepage: https://github.com/basvandijk/lifted-base + Bug-reports: https://github.com/basvandijk/lifted-base/issues + Category: Control +-Build-type: Custom ++Build-type: Simple + Cabal-version: >= 1.8 + Description: @lifted-base@ exports IO operations from the base library lifted to + any instance of 'MonadBase' or 'MonadBaseControl'. +-- +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/persistent-template_stub-out.patch b/standalone/android/haskell-patches/persistent-template_stub-out.patch new file mode 100644 index 000000000..6b7b62bd4 --- /dev/null +++ b/standalone/android/haskell-patches/persistent-template_stub-out.patch @@ -0,0 +1,25 @@ +From 0b9df0de3aa45918a2a9226a2da6be4680276419 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 03:31:55 +0000 +Subject: [PATCH] stub out + +--- + persistent-template.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/persistent-template.cabal b/persistent-template.cabal +index 8216ce7..f23234b 100644 +--- a/persistent-template.cabal ++++ b/persistent-template.cabal +@@ -23,7 +23,7 @@ library + , containers + , aeson + , monad-logger +- exposed-modules: Database.Persist.TH ++ exposed-modules: + ghc-options: -Wall + if impl(ghc >= 7.4) + cpp-options: -DGHC_7_4 +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch b/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch index 38cecc5c7..300975b83 100644 --- a/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch +++ b/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch @@ -1,71 +1,32 @@ -From 8fddef803ee9191ca15363283b7e4d5af4c70f3a Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:34:10 -0400 +From 760fa2c5044ae38bee8114ff84c625ac59f35c6f Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 00:03:55 +0000 Subject: [PATCH] disable TH --- - Database/Persist/GenericSql/Internal.hs | 6 +----- - Database/Persist/GenericSql/Raw.hs | 5 ++--- - 2 files changed, 3 insertions(+), 8 deletions(-) + Database/Persist/Sql/Raw.hs | 2 -- + 1 file changed, 2 deletions(-) -diff --git a/Database/Persist/GenericSql/Internal.hs b/Database/Persist/GenericSql/Internal.hs -index f109887..5273398 100644 ---- a/Database/Persist/GenericSql/Internal.hs -+++ b/Database/Persist/GenericSql/Internal.hs -@@ -14,7 +14,6 @@ module Database.Persist.GenericSql.Internal - , createSqlPool - , mkColumns - , Column (..) -- , logSQL - , InsertSqlResult (..) - ) where - -@@ -33,7 +32,7 @@ import Data.Monoid (Monoid, mappend, mconcat) - import Database.Persist.EntityDef - import qualified Data.Conduit as C - import Language.Haskell.TH.Syntax (Q, Exp) --import Control.Monad.Logger (logDebugS) -+ - import Data.Maybe (mapMaybe, listToMaybe) - import Data.Int (Int64) - -@@ -197,6 +196,3 @@ tableColumn t s = go $ entityColumns t - | x == s = ColumnDef x y z - | otherwise = go rest - -} -- --logSQL :: Q Exp --logSQL = [|\sql_foo params_foo -> $logDebugS (T.pack "SQL") $ T.pack $ show (sql_foo :: Text) ++ " " ++ show (params_foo :: [PersistValue])|] -diff --git a/Database/Persist/GenericSql/Raw.hs b/Database/Persist/GenericSql/Raw.hs -index e4bf9f4..3da8fa0 100644 ---- a/Database/Persist/GenericSql/Raw.hs -+++ b/Database/Persist/GenericSql/Raw.hs -@@ -26,7 +26,6 @@ import Database.Persist.GenericSql.Internal hiding (execute, withStmt) - import Database.Persist.Store (PersistValue) - import Data.IORef - import Control.Monad.IO.Class --import Control.Monad.Logger (logDebugS) - import Control.Monad.Trans.Reader - import qualified Data.Map as Map - import Control.Applicative (Applicative) -@@ -134,7 +133,7 @@ withStmt :: (MonadSqlPersist m, MonadResource m) +diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs +index 73189dd..6efebea 100644 +--- a/Database/Persist/Sql/Raw.hs ++++ b/Database/Persist/Sql/Raw.hs +@@ -22,7 +22,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m) -> [PersistValue] -> Source m [PersistValue] - withStmt sql vals = do + rawQuery sql vals = do - lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals -+ -- lift $ pack $ show sql ++ " " ++ show vals conn <- lift askSqlConn bracketP - (getStmt' conn sql) -@@ -146,7 +145,7 @@ execute x y = liftM (const ()) $ executeCount x y + (getStmtConn conn sql) +@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y - executeCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64 - executeCount sql vals = do + rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64 + rawExecuteCount sql vals = do - $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals -+ -- pack $ show sql ++ " " ++ show vals stmt <- getStmt sql - res <- liftIO $ I.execute stmt vals - liftIO $ reset stmt + res <- liftIO $ stmtExecute stmt vals + liftIO $ stmtReset stmt -- 1.7.10.4 diff --git a/standalone/android/haskell-patches/primitive_fix-build-with-new-ghc.patch b/standalone/android/haskell-patches/primitive_fix-build-with-new-ghc.patch new file mode 100644 index 000000000..3f12965c1 --- /dev/null +++ b/standalone/android/haskell-patches/primitive_fix-build-with-new-ghc.patch @@ -0,0 +1,96 @@ +From 2b1ee45058b0d6db90f77e4859d01d1e8434906c Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 23:11:51 +0000 +Subject: [PATCH] fix build with new ghc + +--- + Data/Primitive/Array.hs | 2 +- + Data/Primitive/ByteArray.hs | 2 +- + Data/Primitive/MutVar.hs | 4 ++-- + Data/Primitive/Types.hs | 13 +++++++------ + 4 files changed, 11 insertions(+), 10 deletions(-) + +diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs +index b82dcac..b28abea 100644 +--- a/Data/Primitive/Array.hs ++++ b/Data/Primitive/Array.hs +@@ -106,7 +106,7 @@ unsafeThawArray (Array arr#) + sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool + {-# INLINE sameMutableArray #-} + sameMutableArray (MutableArray arr#) (MutableArray brr#) +- = sameMutableArray# arr# brr# ++ = tagToEnum# (sameMutableArray# arr# brr#) + + -- | Copy a slice of an immutable array to a mutable array. + copyArray :: PrimMonad m +diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs +index 2a47254..3a1ed6e 100644 +--- a/Data/Primitive/ByteArray.hs ++++ b/Data/Primitive/ByteArray.hs +@@ -99,7 +99,7 @@ mutableByteArrayContents (MutableByteArray arr#) + sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool + {-# INLINE sameMutableByteArray #-} + sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#) +- = sameMutableByteArray# arr# brr# ++ = tagToEnum# (sameMutableByteArray# arr# brr#) + + -- | Convert a mutable byte array to an immutable one without copying. The + -- array should not be modified after the conversion. +diff --git a/Data/Primitive/MutVar.hs b/Data/Primitive/MutVar.hs +index 9745ec7..eb654c9 100644 +--- a/Data/Primitive/MutVar.hs ++++ b/Data/Primitive/MutVar.hs +@@ -23,7 +23,7 @@ module Data.Primitive.MutVar ( + ) where + + import Control.Monad.Primitive ( PrimMonad(..), primitive_ ) +-import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, ++import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, tagToEnum#, + readMutVar#, writeMutVar#, atomicModifyMutVar# ) + import Data.Typeable ( Typeable ) + +@@ -33,7 +33,7 @@ data MutVar s a = MutVar (MutVar# s a) + deriving ( Typeable ) + + instance Eq (MutVar s a) where +- MutVar mva# == MutVar mvb# = sameMutVar# mva# mvb# ++ MutVar mva# == MutVar mvb# = tagToEnum# (sameMutVar# mva# mvb#) + + -- | Create a new 'MutVar' with the specified initial value + newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) +diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs +index 7568f0c..d961e97 100644 +--- a/Data/Primitive/Types.hs ++++ b/Data/Primitive/Types.hs +@@ -20,6 +20,7 @@ module Data.Primitive.Types ( + import Control.Monad.Primitive + import Data.Primitive.MachDeps + import Data.Primitive.Internal.Operations ++import GHC.Prim (tagToEnum#) + + import GHC.Base ( + unsafeCoerce#, +@@ -48,14 +49,14 @@ import Data.Primitive.Internal.Compat ( mkNoRepType ) + data Addr = Addr Addr# deriving ( Typeable ) + + instance Eq Addr where +- Addr a# == Addr b# = eqAddr# a# b# +- Addr a# /= Addr b# = neAddr# a# b# ++ Addr a# == Addr b# = tagToEnum# (eqAddr# a# b#) ++ Addr a# /= Addr b# = tagToEnum# (neAddr# a# b#) + + instance Ord Addr where +- Addr a# > Addr b# = gtAddr# a# b# +- Addr a# >= Addr b# = geAddr# a# b# +- Addr a# < Addr b# = ltAddr# a# b# +- Addr a# <= Addr b# = leAddr# a# b# ++ Addr a# > Addr b# = tagToEnum# (gtAddr# a# b#) ++ Addr a# >= Addr b# = tagToEnum# (geAddr# a# b#) ++ Addr a# < Addr b# = tagToEnum# (ltAddr# a# b#) ++ Addr a# <= Addr b# = tagToEnum# (leAddr# a# b#) + + instance Data Addr where + toConstr _ = error "toConstr" +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/process_fix-build-with-new-ghc.patch b/standalone/android/haskell-patches/process_fix-build-with-new-ghc.patch new file mode 100644 index 000000000..a790a316d --- /dev/null +++ b/standalone/android/haskell-patches/process_fix-build-with-new-ghc.patch @@ -0,0 +1,24 @@ +From 0b0d4250cfce44b1a03b50458b4122370ab349ce Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 21:50:51 +0000 +Subject: [PATCH] fix build with new ghc + +--- + System/Process/Internals.hs | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs +index a73c6fc..6676a72 100644 +--- a/System/Process/Internals.hs ++++ b/System/Process/Internals.hs +@@ -61,6 +61,7 @@ import Control.Concurrent + import Control.Exception + import Foreign.C + import Foreign ++import System.IO.Unsafe + + # ifdef __GLASGOW_HASKELL__ + +-- +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-css_1.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch index f868197a8..1c82eaead 100644 --- a/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch +++ b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch @@ -1,15 +1,13 @@ -From 8f058e84892a8c4202275f524f74bd6a7097ad40 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Wed, 8 May 2013 02:07:15 -0400 +From 05d0b6e6d2f84cd8ff53b8ee3e42021fa02fe8e4 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 23:21:52 +0000 Subject: [PATCH] remove TH --- - Text/Cassius.hs | 23 -------------- - Text/Css.hs | 84 ------------------------------------------------- - Text/CssCommon.hs | 4 --- - Text/Lucius.hs | 30 +----------------- - shakespeare-css.cabal | 2 +- - 5 files changed, 2 insertions(+), 141 deletions(-) + Text/Cassius.hs | 23 ----------------------- + Text/CssCommon.hs | 4 ---- + Text/Lucius.hs | 30 +----------------------------- + 3 files changed, 1 insertion(+), 56 deletions(-) diff --git a/Text/Cassius.hs b/Text/Cassius.hs index ce05374..ae56b0a 100644 @@ -64,117 +62,6 @@ index ce05374..ae56b0a 100644 -- | Determine which identifiers are used by the given template, useful for -- creating systems like yesod devel. cassiusUsedIdentifiers :: String -> [(Deref, VarType)] -diff --git a/Text/Css.hs b/Text/Css.hs -index 8e6fc09..401a166 100644 ---- a/Text/Css.hs -+++ b/Text/Css.hs -@@ -108,19 +108,6 @@ cssUsedIdentifiers toi2b parseBlocks s' = - (scope, rest') = go rest - go' (k, v) = k ++ v - --cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion -- -> Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp --cssFileDebug toi2b parseBlocks' parseBlocks fp = do -- s <- fmap TL.unpack $ qRunIO $ readUtf8File fp --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- let vs = cssUsedIdentifiers toi2b parseBlocks s -- c <- mapM vtToExp vs -- cr <- [|cssRuntime toi2b|] -- parseBlocks'' <- parseBlocks' -- return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c -- - combineSelectors :: Selector -> Selector -> Selector - combineSelectors a b = do - a' <- a -@@ -202,17 +189,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do - - addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd - --vtToExp :: (Deref, VarType) -> Q Exp --vtToExp (d, vt) = do -- d' <- lift d -- c' <- c vt -- return $ TupE [d', c' `AppE` derefToExp [] d] -- where -- c :: VarType -> Q Exp -- c VTPlain = [|CDPlain . toCss|] -- c VTUrl = [|CDUrl|] -- c VTUrlParam = [|CDUrlParam|] -- - getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)] - getVars _ ContentRaw{} = return [] - getVars scope (ContentVar d) = -@@ -268,68 +244,8 @@ compressBlock (Block x y blocks) = - cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c - cc (a:b) = a : cc b - --blockToCss :: Name -> Scope -> Block -> Q Exp --blockToCss r scope (Block sel props subblocks) = -- [|(:) (Css' $(selectorToBuilder r scope sel) $(listE $ map go props)) -- . foldr (.) id $(listE $ map subGo subblocks) -- |] -- where -- go (x, y) = tupE [contentsToBuilder r scope x, contentsToBuilder r scope y] -- subGo (Block sel' b c) = -- blockToCss r scope $ Block sel'' b c -- where -- sel'' = combineSelectors sel sel' -- --selectorToBuilder :: Name -> Scope -> Selector -> Q Exp --selectorToBuilder r scope sels = -- contentsToBuilder r scope $ intercalate [ContentRaw ","] sels -- --contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp --contentsToBuilder r scope contents = -- appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents -- --contentToBuilder :: Name -> Scope -> Content -> Q Exp --contentToBuilder _ _ (ContentRaw x) = -- [|fromText . pack|] `appE` litE (StringL x) --contentToBuilder _ scope (ContentVar d) = -- case d of -- DerefIdent (Ident s) -- | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val) -- _ -> [|toCss|] `appE` return (derefToExp [] d) --contentToBuilder r _ (ContentUrl u) = -- [|fromText|] `appE` -- (varE r `appE` return (derefToExp [] u) `appE` listE []) --contentToBuilder r _ (ContentUrlParam u) = -- [|fromText|] `appE` -- ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u)) -- - type Scope = [(String, String)] - --topLevelsToCassius :: [TopLevel] -> Q Exp --topLevelsToCassius a = do -- r <- newName "_render" -- lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a -- where -- go _ _ [] = return [] -- go r scope (TopBlock b:rest) = do -- e <- [|(++) $ map Css ($(blockToCss r scope b) [])|] -- es <- go r scope rest -- return $ e : es -- go r scope (TopAtBlock name s b:rest) = do -- let s' = contentsToBuilder r scope s -- e <- [|(:) $ AtBlock $(lift name) $(s') $(blocksToCassius r scope b)|] -- es <- go r scope rest -- return $ e : es -- go r scope (TopAtDecl dec cs:rest) = do -- e <- [|(:) $ AtDecl $(lift dec) $(contentsToBuilder r scope cs)|] -- es <- go r scope rest -- return $ e : es -- go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest -- --blocksToCassius :: Name -> Scope -> [Block] -> Q Exp --blocksToCassius r scope a = do -- appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a -- - renderCss :: Css -> TL.Text - renderCss css = - toLazyText $ mconcat $ map go tops-- FIXME use a foldr diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs index 719e0a8..8c40e8c 100644 --- a/Text/CssCommon.hs @@ -192,10 +79,10 @@ index 719e0a8..8c40e8c 100644 -mkSizeType "ExSize" "ex" -mkSizeType "PixelSize" "px" diff --git a/Text/Lucius.hs b/Text/Lucius.hs -index b71614e..a902e1c 100644 +index 89328bd..0a1cf5e 100644 --- a/Text/Lucius.hs +++ b/Text/Lucius.hs -@@ -6,12 +6,8 @@ +@@ -8,12 +8,8 @@ {-# OPTIONS_GHC -fno-warn-missing-fields #-} module Text.Lucius ( -- * Parsing @@ -203,13 +90,13 @@ index b71614e..a902e1c 100644 - , luciusFile - , luciusFileDebug - , luciusFileReload + -- ** Mixins +- , luciusMixin ++ luciusMixin + , Mixin -- ** Runtime -- , luciusRT -+ luciusRT - , luciusRT' - , -- * Datatypes - Css -@@ -31,11 +27,8 @@ module Text.Lucius + , luciusRT +@@ -40,11 +36,8 @@ module Text.Lucius , AbsoluteUnit (..) , AbsoluteSize (..) , absoluteSize @@ -221,9 +108,9 @@ index b71614e..a902e1c 100644 -- * Internal , parseTopLevels , luciusUsedIdentifiers -@@ -57,18 +50,6 @@ import Data.Either (partitionEithers) - import Data.Monoid (mconcat) +@@ -66,18 +59,6 @@ import Data.Monoid (mconcat) import Data.List (isSuffixOf) + import Control.Arrow (second) --- | --- @@ -240,7 +127,7 @@ index b71614e..a902e1c 100644 whiteSpace :: Parser () whiteSpace = many whiteSpace1 >> return () -@@ -179,15 +160,6 @@ parseComment = do +@@ -217,15 +198,6 @@ parseComment = do _ <- manyTill anyChar $ try $ string "*/" return $ ContentRaw "" @@ -253,22 +140,9 @@ index b71614e..a902e1c 100644 -luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels -luciusFileReload = luciusFileDebug - - parseTopLevels :: Parser [TopLevel] + parseTopLevels :: Parser [TopLevel Unresolved] parseTopLevels = go id -diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal -index de2497b..874a3b5 100644 ---- a/shakespeare-css.cabal -+++ b/shakespeare-css.cabal -@@ -33,7 +33,7 @@ library - , shakespeare >= 1.0 && < 1.1 - , template-haskell - , text >= 0.11.1.1 && < 0.12 -- , process >= 1.0 && < 1.2 -+ , process >= 1.0 && < 1.3 - , parsec >= 2 && < 4 - , transformers - -- 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/shakespeare-js_1.1.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch deleted file mode 100644 index 98a16ae07..000000000 --- a/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch +++ /dev/null @@ -1,308 +0,0 @@ -From 332c71b3f6bc4786b914e675020a23c492beee5a Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 7 May 2013 19:28:06 -0400 -Subject: [PATCH] remove TH - ---- - Text/Coffee.hs | 54 ------------------------------------------------- - Text/Julius.hs | 56 ++++----------------------------------------------- - Text/Roy.hs | 54 ------------------------------------------------- - Text/TypeScript.hs | 57 +--------------------------------------------------- - 4 files changed, 5 insertions(+), 216 deletions(-) - -diff --git a/Text/Coffee.hs b/Text/Coffee.hs -index 2481936..3f7f9c3 100644 ---- a/Text/Coffee.hs -+++ b/Text/Coffee.hs -@@ -51,14 +51,6 @@ module Text.Coffee - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- coffee -- , coffeeFile -- , coffeeFileReload -- , coffeeFileDebug -- --#ifdef TEST_EXPORT -- , coffeeSettings --#endif - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) -@@ -66,49 +58,3 @@ import Language.Haskell.TH.Syntax - import Text.Shakespeare - import Text.Julius - --coffeeSettings :: Q ShakespeareSettings --coffeeSettings = do -- jsettings <- javascriptSettings -- return $ jsettings { varChar = '%' -- , preConversion = Just PreConvert { -- preConvert = ReadProcess "coffee" ["-spb"] -- , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks. -- , preEscapeIgnoreLine = "#" -- ignore commented lines -- , wrapInsertion = Just WrapInsertion { -- wrapInsertionIndent = Just " " -- , wrapInsertionStartBegin = "((" -- , wrapInsertionSeparator = ", " -- , wrapInsertionStartClose = ") =>" -- , wrapInsertionEnd = ")" -- , wrapInsertionApplyBegin = "(" -- , wrapInsertionApplyClose = ")\n" -- } -- } -- } -- ---- | Read inline, quasiquoted CoffeeScript. --coffee :: QuasiQuoter --coffee = QuasiQuoter { quoteExp = \s -> do -- rs <- coffeeSettings -- quoteExp (shakespeare rs) s -- } -- ---- | Read in a CoffeeScript template file. This function reads the file once, at ---- compile time. --coffeeFile :: FilePath -> Q Exp --coffeeFile fp = do -- rs <- coffeeSettings -- shakespeareFile rs fp -- ---- | Read in a CoffeeScript template file. This impure function uses ---- unsafePerformIO to re-read the file on every call, allowing for rapid ---- iteration. --coffeeFileReload :: FilePath -> Q Exp --coffeeFileReload fp = do -- rs <- coffeeSettings -- shakespeareFileReload rs fp -- ---- | Deprecated synonym for 'coffeeFileReload' --coffeeFileDebug :: FilePath -> Q Exp --coffeeFileDebug = coffeeFileReload --{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-} -diff --git a/Text/Julius.hs b/Text/Julius.hs -index 230eac3..1a0376f 100644 ---- a/Text/Julius.hs -+++ b/Text/Julius.hs -@@ -14,17 +14,8 @@ module Text.Julius - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- js -- , julius -- , juliusFile -- , jsFile -- , juliusFileDebug -- , jsFileDebug -- , juliusFileReload -- , jsFileReload -- - -- * Datatypes -- , JavascriptUrl -+ JavascriptUrl - , Javascript (..) - , RawJavascript (..) - -@@ -37,9 +28,11 @@ module Text.Julius - , renderJavascriptUrl - - -- ** internal, used by 'Text.Coffee' -- , javascriptSettings - -- ** internal - , juliusUsedIdentifiers -+ -+ -- used by TH splices -+ , asJavascriptUrl - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) -@@ -101,47 +94,6 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText - instance RawJS Builder where rawJS = RawJavascript - instance RawJS Bool where rawJS = RawJavascript . toJavascript - --javascriptSettings :: Q ShakespeareSettings --javascriptSettings = do -- toJExp <- [|toJavascript|] -- wrapExp <- [|Javascript|] -- unWrapExp <- [|unJavascript|] -- asJavascriptUrl' <- [|asJavascriptUrl|] -- return $ defaultShakespeareSettings { toBuilder = toJExp -- , wrap = wrapExp -- , unwrap = unWrapExp -- , modifyFinalValue = Just asJavascriptUrl' -- } -- --js, julius :: QuasiQuoter --js = QuasiQuoter { quoteExp = \s -> do -- rs <- javascriptSettings -- quoteExp (shakespeare rs) s -- } -- --julius = js -- --jsFile, juliusFile :: FilePath -> Q Exp --jsFile fp = do -- rs <- javascriptSettings -- shakespeareFile rs fp -- --juliusFile = jsFile -- -- --jsFileReload, juliusFileReload :: FilePath -> Q Exp --jsFileReload fp = do -- rs <- javascriptSettings -- shakespeareFileReload rs fp -- --juliusFileReload = jsFileReload -- --jsFileDebug, juliusFileDebug :: FilePath -> Q Exp --juliusFileDebug = jsFileReload --{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-} --jsFileDebug = jsFileReload --{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-} -- - -- | Determine which identifiers are used by the given template, useful for - -- creating systems like yesod devel. - juliusUsedIdentifiers :: String -> [(Deref, VarType)] -diff --git a/Text/Roy.hs b/Text/Roy.hs -index cf09cec..870c9f6 100644 ---- a/Text/Roy.hs -+++ b/Text/Roy.hs -@@ -23,13 +23,6 @@ module Text.Roy - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- roy -- , royFile -- , royFileReload -- --#ifdef TEST_EXPORT -- , roySettings --#endif - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) -@@ -37,50 +30,3 @@ import Language.Haskell.TH.Syntax - import Text.Shakespeare - import Text.Julius - ---- | The Roy language compiles down to Javascript. ---- We do this compilation once at compile time to avoid needing to do it during the request. ---- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. --roySettings :: Q ShakespeareSettings --roySettings = do -- jsettings <- javascriptSettings -- return $ jsettings { varChar = '#' -- , preConversion = Just PreConvert { -- preConvert = ReadProcess "roy" ["--stdio"] -- , preEscapeIgnoreBalanced = "'\"" -- , preEscapeIgnoreLine = "//" -- , wrapInsertion = Nothing -- {- -- Just WrapInsertion { -- wrapInsertionIndent = Just " " -- , wrapInsertionStartBegin = "(\\" -- , wrapInsertionSeparator = " " -- , wrapInsertionStartClose = " ->\n" -- , wrapInsertionEnd = ")" -- , wrapInsertionApplyBegin = " " -- , wrapInsertionApplyClose = ")\n" -- } -- -} -- } -- } -- ---- | Read inline, quasiquoted Roy. --roy :: QuasiQuoter --roy = QuasiQuoter { quoteExp = \s -> do -- rs <- roySettings -- quoteExp (shakespeare rs) s -- } -- ---- | Read in a Roy template file. This function reads the file once, at ---- compile time. --royFile :: FilePath -> Q Exp --royFile fp = do -- rs <- roySettings -- shakespeareFile rs fp -- ---- | Read in a Roy template file. This impure function uses ---- unsafePerformIO to re-read the file on every call, allowing for rapid ---- iteration. --royFileReload :: FilePath -> Q Exp --royFileReload fp = do -- rs <- roySettings -- shakespeareFileReload rs fp -diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs -index 34bf4bf..30c5388 100644 ---- a/Text/TypeScript.hs -+++ b/Text/TypeScript.hs -@@ -53,65 +53,10 @@ - -- - -- 2. TypeScript: <http://typescript.codeplex.com/> - module Text.TypeScript -- ( -- * Functions -- -- ** Template-Reading Functions -- -- | These QuasiQuoter and Template Haskell methods return values of -- -- type @'JavascriptUrl' url@. See the Yesod book for details. -- tsc -- , typeScriptFile -- , typeScriptFileReload -- --#ifdef TEST_EXPORT -- , typeScriptSettings --#endif -+ ( - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) - import Language.Haskell.TH.Syntax - import Text.Shakespeare - import Text.Julius -- ---- | The TypeScript language compiles down to Javascript. ---- We do this compilation once at compile time to avoid needing to do it during the request. ---- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. --typeScriptSettings :: Q ShakespeareSettings --typeScriptSettings = do -- jsettings <- javascriptSettings -- return $ jsettings { varChar = '#' -- , preConversion = Just PreConvert { -- preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"] -- , preEscapeIgnoreBalanced = "'\"" -- , preEscapeIgnoreLine = "//" -- , wrapInsertion = Just WrapInsertion { -- wrapInsertionIndent = Nothing -- , wrapInsertionStartBegin = ";(function(" -- , wrapInsertionSeparator = ", " -- , wrapInsertionStartClose = "){" -- , wrapInsertionEnd = "})" -- , wrapInsertionApplyBegin = "(" -- , wrapInsertionApplyClose = ");\n" -- } -- } -- } -- ---- | Read inline, quasiquoted TypeScript --tsc :: QuasiQuoter --tsc = QuasiQuoter { quoteExp = \s -> do -- rs <- typeScriptSettings -- quoteExp (shakespeare rs) s -- } -- ---- | Read in a Roy template file. This function reads the file once, at ---- compile time. --typeScriptFile :: FilePath -> Q Exp --typeScriptFile fp = do -- rs <- typeScriptSettings -- shakespeareFile rs fp -- ---- | Read in a Roy template file. This impure function uses ---- unsafePerformIO to re-read the file on every call, allowing for rapid ---- iteration. --typeScriptFileReload :: FilePath -> Q Exp --typeScriptFileReload fp = do -- rs <- typeScriptSettings -- shakespeareFileReload rs fp --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/shakespeare-js_TH-exports.patch b/standalone/android/haskell-patches/shakespeare-js_TH-exports.patch new file mode 100644 index 000000000..3ddbadaf1 --- /dev/null +++ b/standalone/android/haskell-patches/shakespeare-js_TH-exports.patch @@ -0,0 +1,25 @@ +From 40182bfb77ba16beab0da95b664d2c052d5fcad6 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 04:53:30 +0000 +Subject: [PATCH] TH exports + +--- + Text/Julius.hs | 2 ++ + 1 file changed, 2 insertions(+) + +diff --git a/Text/Julius.hs b/Text/Julius.hs +index 3a9f83e..2b98f30 100644 +--- a/Text/Julius.hs ++++ b/Text/Julius.hs +@@ -40,6 +40,8 @@ module Text.Julius + , javascriptSettings + -- ** internal + , juliusUsedIdentifiers ++ -- used by TH ++ , asJavascriptUrl + ) where + + import Language.Haskell.TH.Quote (QuasiQuoter (..)) +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch b/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch index aa30b255a..51443b5d4 100644 --- a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch +++ b/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch @@ -1,139 +1,26 @@ -From 3cb1056782c29b0b68bdcff8fa49d3ea92126956 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 16:46:15 -0400 -Subject: [PATCH] export symbol used by TH splices +From 4a75a2f0d77168aa3115b991284a5120484e18f0 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 04:59:21 +0000 +Subject: [PATCH] TH exports --- - Text/.Shakespeare.hs.swp | Bin 24576 -> 0 bytes - Text/Shakespeare.hs | 2 ++ - 2 files changed, 2 insertions(+) - delete mode 100644 Text/.Shakespeare.hs.swp - -diff --git a/Text/.Shakespeare.hs.swp b/Text/.Shakespeare.hs.swp -deleted file mode 100644 -index 4d6cd6a0295fdfb59f32a66b4af556c0630dd5b0..0000000000000000000000000000000000000000 -GIT binary patch -literal 0 -HcmV?d00001 - -literal 24576 -zcmeI4e~et$RmWd`KnqD)L_(BS5xTW4?M$;fu@g0M7u$*LtdmXsW9?l#wDxBEJo9Gf -z#WU|s-h1QO^^dk7RGJp46wwy`NCj0Y(S!!1AgEe}NKk}8ErJRNG@z(KqJ@T13Q|#9 -zR6ghact2*x>kWSanvuTVnRm}U_uO;OJ@?*o&-2-xr{<5SdmDFqe16RHu3haOfAZ_E -z_a3<Dd5^`xx;(zxXEhpJjYOBfM;P9j_4;?F9sgXA_5(i&W_C4pHtxQ2DOk(yTr3_p -zI_Z{pPKYKNm}p=N8W?2lncX*eci**Z=k{%HQ8)ki$t_fxkW4f%(ZECl6Aer>Fwww7 -z0}~BQG%(S?|0fM({p-CS(4lL=qu?5g>-pOOzWx0}{5=c)#QwgHzc+z9s33JFpNR%0 -z8klHcqJfD9CK{M%V4{JE1|}MqXkem&i3TPb_}{AmzvX$m5$_9fi0A%aVgN6{(es`I -zzX&dZcYzu3y*GH??}AT&_ks{CfP2BM;5zUML4hxWFM!X2XTa0o<KXAP`#=U#umonn -zH*WO2=fM+T70iL#!MASkynh0}2c7~Kz&pX+;8ySx;0HhIc`t#lfM>xI;GN(`@b5q3 -zdEW+q1)c*R0v`lD@F2Ja+zkHk^`6%R`@wf#=Xt*dj)L33^FQo)>);_U2fj-n<a6LW -zI1H`<&k-!?f&<__@MVG{?*jitQ04pJW$--sD0mzk0{4Uaz?;FV=w9^yS?~$)BrqSv -zXIc#tzds+PL6U`Ww3zuxb|5I1l)qQ0R>Mfm&Z@;M38Pg{=v0;4eAEh}Oh1S2h`)X| -zaMUe7^VK8erq$k&-{go$)yw+d5jmw@!>_`_lJ=8eE^Ye#V16}<li+X|1ybSk!H%CS -zkEc1{cm1dtv_|MIDtH}?qw}aoiWc0j6lHn36ZxZz9uz+?z8R^!L6D)JD!<jDsVr8Z -z7Em?gUJp&Bsy6I|&5lB`2jg}-2-0Q}_A_-h5M2+$tfPE2wSB5C%$sG3Vc6}ej^FQx -z-F3$`>jZGhf}|gJeHq<!TKQ2+o%NgNvaoqBRl|7DZK)`h7F3o5euh}cN4tKXK@~x= -zj-SyMeAcqYm`>%I3sW^nO}B(&sBOwLMuVwp$B8=cC!v3~8z{d^Yb`{L(y$e%RNGLh -zAjzeZ#-zQ6{PbKv@6P+(K>$gF-lS_ukPf=ptg3Cl=wH?vSz7N0i$-HjKN78?4mw5; -zOwXx?8hL_1s6wHyZrIeiQE^+iN`qM^PJ>+3lor~9s3{7pl~RjV=*x;<zo;6GhT8C4 -zo?4-7n<7!a>o-N7V6;={*;lR=J&F23q6JsMS|4#z5o|G5(pQD1n;kz|g;l(<X`y^z -zAahc;gbmIxd|0s9tn|JeCTXU6aVu=EGZ5We7&ByIC`JuIuc4MY(i*a3A+4B+q^;16 -zW2(+Y@em_1L&6+d9r&w(wv#2g*-v6dyC;G~BDQorZ$(sI9o$(FFABs6RVQZXuo*-V -zX()&zY+IMo9QvV9bG8F*hml#Vo1bq>OBq%sbz3nkM^ph9XCf`ziHH63zL|5=(x`Mn -zie|KtTKTh}$2ewz>J3mMYOzdOnp9L#a8WHY5CQ66$6_DHg3T-nGbNrt&#s}ru6lkb -z-IGZY_?REM327$~zo2`jJM~D%8MJ5<9Wdo_Co1*Z*bC;I#D23gt@Z4;&imBGN+6XP -zsb?pa)=zw_xf#q#7j=VczBC0NJ;&&fxCMG<hDzqNIDv{wGOokv4>wcpwjF=k?Vx@c -z^g<ZTs%&+3UJrw$)S$LeE#Tn*zu1%tuwxA4G%MM&bOEP(K8yz`>SLsbekfjS5M^Ok -zH?374L@iuErXM8y2=x3&wR$SnL?fnCh0-rodOocRH)Fg?Oa~L?Y~R(#Rc*AYhUbaj -zJH#lS%-XwEyU(K0?)iPSbht5y`r?;%U?+Y{iiHf4Y86%?dA{JY7|iTb^T*thiY9vT -zdF>O*sg4J*ru&L!kDE3hKQV}?YT7D^lecwTmb-F8$G6r_-%qe!=~gm`7UW05uhYw( -zDS)YZFmMG~d`_MAcP%rnbY(FfB+cNc-wWi|X$qI+%N)xdOf;{#Bw>R1GU}J40Wk>E -zhFu)7@r2bxrYAG#wAq_1dl@T(;gHBGEmfMfKLwFyx_@g7Jtk+&o?vku7t?DjBylrH -zS-)lI><_&p$@IeQU{lTmv$Hi-B`LKrI#RCi@qynB+aZSh06V3IrakOmz+b1B$|h8r -zV9^m+@#c>;PDbJ*RBfRDE*S4Qf2{5(bu&leC=OedM|sPQ1B0;3yiqm#Wm>h9xF_Xx -zZ#z>eY`cnw-7;Xkdt>RL#^O4@Xst0X`;o}+rr!3jt=@8E{^-i7xf6@?$BwQzzq-;f -z3x4gc>D|*ia{;f+bdzRP4WBr-DUaiW7-Oj&ANXmgzth7;qn_8%3NRMKFo!)=Gb<-s -z<t&)Cwls!1IT-iOhLNAeN!qX$*9lv)EZ1a5I&BQia!7IxdLU${s%l}nzuWKlM+d!W -zoZlkeA*hla4q1U}dXGoGGe%uEd*-?tGGzicEbOA$=wpV=XVfpMZv}0&G`G04GWXL9 -z$4)GnYEBlrMScJlZTtO{pNQMDzfNcmdNS$S-=*!(Nw$FVvh5e^O;Sz3#Cogh#>1H| -z>!7QH1U~z>(gauxvJCZ@I>=JqYwIzwtyQ-C<$}BhN?`~!c}<OJ!4xx&101X#;1ZE> -zE{B-7?AFeS8}V5SGZd#He3NYVwAbM~&%z7LQMb8*_TfP{9Hb5J;>>n+Y+(t*UR-(b -zp@V9s9mO+4KZ$0-NEVnbm1p|Cu#Hl+edh8eHF{y1qL>*p+HDoYhxZ?S@Z|mn=hTUy -z87Hkrn4SmyWE{c4g@wF{yw;&^uokjAn`f6KXP+^Q@zg<rBchK-gP}N4Y$7}_HtZzM -z*)7>^k=xM;ft>&Uh%@+2oZaR8&sXp3ob|s5J`T=;IZy}Jf|sECb?^k}fd_!py%9`4 -z6Aer>Fwww70}~BQG%(S?L<18IOf)djz(fQ8M>L>HpA`x01v;3wgBy%^s9NfdJJhyW -zx$X#>62P5160U{OHhqY9H6NCUd(D)nUR{{<h?Yt?cPb}rO8C4R$L9upxHemy;C0z* -ztZE149xKXVty*=pH?JcNY(*wQ9)xoIUR5lq?P6g%q^bo{1J(DW$bGEzjt8+gf--gK -zh381NAbVc@f7*en?1fNjpcOi{BgAiCn}|lea{hl4=J_SLbLRXnIsbpdIsdo8hruei -z54;`h2CoDE%31$a@D1?K;Pc>9;KN`YoCT5>um`*e{2M`qFM*!{_kdf#8^BHACGPou -z1AGkp97w=%@HTKOxCPt{zQ$euv*118GB^YFfZM@$xa)rryZ}B0o&uM^Nw5TN0sqN8 -z|I6S>@KMkK?*O-gf8gH#x4_dN0Y|_bxB<LO4!|eD$G{Qbfp3uq@B;WCcmmuHzDXXy -zzkpZ4?|}D%E_esH9lSzbz_XwO_JZrdSFb~N;Aepk-VDA;KEOYM-v<{!1m?l_7@t1_ -zGEQHVu^Rhv7Ql6d1TeYLC6+#jy83&A8>~K08cP4p&4sIOn+8zRrWWd)0Op?18#c8w -zQbi`SDO7v*X(n~$Lc(LX9p%<V;!t}>iA>~EWHsD^mWxa&Bf&6~)(g3Ij7?e?hPu%W -zJjS+Lv?=YnPo3y<t3~8ARlQ*-7s_1O$<;&4geD!G`Fo<cIglHup4`;?$!aQkDcvem -z%DgHI`8D4%6|zARDODoi;!odquU7?nx7<FxTh+AZF}D<%^Oyy9Beo10BwU!Q)g&JD -zO{BJ<(mmwjM{Yau!HN7XNl*}0zY)NefN^P{P}evWRjaAdksmEC|E}pC;QkRUs|Ju| -zY>17Q8zeZZYNm_RrW;~1!6FNlzJW^d@|vON+Tb$7Tv6&MeJ+{YH%2H#kA|~m6?9V* -zNmqo6S<z_y{#q$`?S^56HAz%atPsxnv`ti)YDx4U!p-zk-}kfl@xTQB$A-c$lBiI~ -zySGHmU0o?G?xOQzUgla&z7^Mx<_badVN}fx#uQ3J6j^ak_(Nq)4a;8NrD_q$1jo3d -z!${<|V_FT8uKB`!hJ0BrMnrSu>PQ#{<~p#%*M5~n-8SLqaRHiDA)Cn8G$OH(sv5V# -zOUWRR;k9gv_0<z%_Zg{lh%2m-TB_waV)CH${fqmp<$>{d`Ae+J@{4=}qZ2iCU$MW@ -z%$UUEnb}@YUQvepwwkt5j*(C^-E(Q589^;?{!42=|0UyNB+}B@M#q|qwlA~Os?c89 -zx)#JoCT=_s*N9rKoibj=jvCh7%$RyrqOG=Jyp&dq+|7_#l-e$FrMot}F6ObOX2thb -z3)ihO#i&M#cDN3R>DSg|dkddgb>Rxl*an4qZMO7def9#)kFRuk8Nuw{Y=Z!FKJNrG -z)qRIkG4vZM?HK3fRPH@xDyJ$*>nc^L*EC8$#5J(>2&`}n&6t7}wQZY`bz`L~k5b`h -zPFwMpJ+JJBb9YcPhY88ViidT@C3cyN7B*%PG{t{4Nf?#f0H+<1F>gxo;b>tlylUe8 -zr`6o!g<Fzx@(?V&_@Cm+RF_rCnNL`@-@6*orsXn^O(QMIptMaRwf!dMW3*;FR`THD -zO`yy#Z}o3<VDIydBC4f(IiyetqT>THn6&(I>#27oON%-$p>8UU5}?SMrNGBpQikuc -zCzsLY4*d}K<K0t|*N0qoZPUfoHLP0p7)vH<z#$cxja1hjSy#4BpJ!8#ij&Hh7I|{N -zaa-0G%9HI=-j(m7At-4uUjr|0R%N_Bn>9#!uau<f1b)Q+wLR$Cb8ru*L$VfE$Ckom -zSdoS0vMR|XvDt&#WVvjX%qkAd;;$sPk3^<U(Cy<H&yk%*=Bs1%sM=3@ryr%T=$Sk@ -zo%+Zzn>xa!EhACl)lf%Bv|=O3jF)t>(74Dk14nO7ChpvtIqvFA1I*D~isu9iZex;Z -zxu(_Fk%as}9J?%mK{O;uSaOjH_8XsMu}e;=5IRHPp)6RoRSa5w3D5lLMYlNSPxbT~ -zH}qo-g7Z>kv#s3c5*zZ7JYhXlG7a-gA-A8()0MQO##BZUpZAlox_+=L3986%XSy^t -zj_!a?8{U*|j#I{_1f;nn*%lgH3|M+4*+rH3$@!lny7#o4DLMb2<<DPo#$N-sfxn>e -z&%v|cBj8bR8~6@q_s@Y}1-}B;z%rNyH-OJ@X8#57UJ!s5m<BI#UjGXCG<X8+15@A) -z;3jYlc$xG1AAny5LvRSpft}!1@O{qguYk{h$3O`7fWPOw{&zs~`9BHX4^D&K;9hVo -z_+!rRAFyZnDgM65+5NA<=fN}JLm&e^&;|E^w}BhMw>iiEDR>HGK=S|PeE(MPM(`qM -z`ric4fEDm|@HNi#zXU!4?ganAS^jUq3*ZCbeV_^M0Y3?@1z%+>WIR4CW0HTwgxqH< -zfv|-x`Kn_hNxDR_LtxP;PJdenY{}A=$FxepI$6?SN1mijH{<ZddZKeBO#=|iWH!4I -zY1gf2<*klAgzd<WuzbU_P<IELH+@JM*~oaJkW}r_dHnVSB^#W~coP0fnViifPtxXd -zdTH_BOp;@ng=8~Qi9}B#kv3FGUq;gKkf9Zit15G|V3@Bz^ikS$NuZ}|dQUK|&>?<O -z7WTT%oh;RrhrAh6FdNC#QmIY9LOS%pA^(V|Cy=!^C9JbiN3OzVOs_1z@m(@nW$7i! -ztiCKMSWOfw>0m0=DV8ZAAy&2ZAdN}1mOL_@WPFL;5c`0h1d!~z6GieF@e{jxo?X|g -z+-i89<G4GAvoA;kS%6s;t0zPm_)9hdt=RbG|DUMVtS80g52PpE=1%rY(_^<jBl|`e -zn0k6(^m0>-9%C?PCXzE{&yB=r44bw%#GYEx;c`?rN|#F}bITFChvVt>G%S&hp>mVe -zQE6dIbapZ_cQ0O+W(&EhGj+_^o8^)Q#1^P~YRPEg65o&;t?9pJFD*ZG&pnsyD2aDR -zkIf%FJb!eKvtjexl+INflWw|})pky+UAv~$U3CtQLb=y@7W-SwSHGGfc4{}VRa2=( -zGisZJGvoxwdCR=$!*}!UPfDh#vn5v0G|)%ug3wZx?kY5uK8{PMO)~#ZgsUCiKH9T~ -z{=$JWE41AJRU1Hu($TS1DYI1vSBX4~t<Ip?>gP>Vr`j^bQ{t&>jNO<7?7G{}<h2x1 -z>L}L^GBEY)W==6B601}3#WEPUQX5)|f}sSMOQePggeLaXEY>HZdNVpwNi`+JfKOKT -zW0~=A+nMAHOJ816)<n$=MVcit*-DARs&)pI=wlOwv+}*J_U)5|aoa)Bm<dnH3R4(G -zh5g~6o#|qwM^IOVx)4UBHGPo?jYJkVynr_H%)P&r_orY{QpZRots<g98!KtU99yF8 -zZfuFRi*kv)45Mv?Z2fBAa&?(`ad4JbROAIR=F@5WXt^TP3ZvbW?Y=Fo6xzxgEax?{ -z(yz+}EiJKYr))hY-jcU$`%q)xrWwp)s5x*U3JzT7mgn?JZ&Yd-ZxA)it9iDq`snz& -zvDE4)lvrqlCfz*QCHtOE%zHp;hi=MF0UaUN$02Kt#j#D9Se{Ia4K=DUb#v3QB9oxP -zwzU1w@6WNRu*bx!Fm!?M5q`vZteUtpl5-)+%;rs24mL%JOcA9&qh!VLrXZ-fOO729 -zKPK3rQ|qhji{p;jMqasN`rfA);}JIIeOp|cZr)uN8TD0FD!Q+0X5s+sdf+Oou)><h -z@^6Kg)7(m_yy$C1XT{;NAb4%c(0;9`ypg*;l3D_HPgH9qao@bzRy$*&a%wMunV*_c -zmoB*%A5@d;G*^Q@+GSJ180JQ6>pIJ;jMG|PctyQ!GSmbiv3Qr)u&ouEmum^pkkc@$ -zw#m&VrMmx{u&J%gPF<Xum0rTGOo$t96J~@>TffSIcHAo>@*W5;6-uS6@+S&5%ay{F -cT45AdikYcun%oMsfwvWjb+Ig{u-NAPH%ay)TmS$7 + Text/Shakespeare.hs | 3 +++ + 1 file changed, 3 insertions(+) diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index d300951..fabbf66 100644 +index 9eb06a2..1290ab1 100644 --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs -@@ -22,6 +22,8 @@ module Text.Shakespeare +@@ -23,6 +23,9 @@ module Text.Shakespeare + , Deref + , Parser + ++ -- used by TH ++ , pack' ++ #ifdef TEST_EXPORT , preFilter #endif -+ -- used by TH splices -+ , pack' - ) where - - import Data.List (intersperse) -- -1.8.2.rc3 +1.7.10.4 diff --git a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare_1.0.3_0001-remove-TH.patch deleted file mode 100644 index 5a5b8eeb8..000000000 --- a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-remove-TH.patch +++ /dev/null @@ -1,208 +0,0 @@ -From 10484c5f68431349b249f07517c392c4a90bdb05 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Wed, 8 May 2013 01:47:19 -0400 -Subject: [PATCH] remove TH - ---- - Text/Shakespeare.hs | 109 ---------------------------------------------- - Text/Shakespeare/Base.hs | 28 ------------ - shakespeare.cabal | 2 +- - 3 files changed, 1 insertion(+), 138 deletions(-) - -diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index 7750135..fabbf66 100644 ---- a/Text/Shakespeare.hs -+++ b/Text/Shakespeare.hs -@@ -12,11 +12,7 @@ module Text.Shakespeare - , WrapInsertion (..) - , PreConversion (..) - , defaultShakespeareSettings -- , shakespeare -- , shakespeareFile -- , shakespeareFileReload - -- * low-level -- , shakespeareFromString - , shakespeareUsedIdentifiers - , RenderUrl - , VarType -@@ -135,39 +131,6 @@ defaultShakespeareSettings = ShakespeareSettings { - , modifyFinalValue = Nothing - } - --instance Lift PreConvert where -- lift (PreConvert convert ignore comment wrapInsertion) = -- [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|] -- --instance Lift WrapInsertion where -- lift (WrapInsertion indent sb sep sc e ab ac) = -- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift ab) $(lift ac)|] -- --instance Lift PreConversion where -- lift (ReadProcess command args) = -- [|ReadProcess $(lift command) $(lift args)|] -- lift Id = [|Id|] -- --instance Lift ShakespeareSettings where -- lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) = -- [|ShakespeareSettings -- $(lift x1) $(lift x2) $(lift x3) -- $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|] -- where -- liftExp (VarE n) = [|VarE $(liftName n)|] -- liftExp (ConE n) = [|ConE $(liftName n)|] -- liftExp _ = error "liftExp only supports VarE and ConE" -- liftMExp Nothing = [|Nothing|] -- liftMExp (Just e) = [|Just|] `appE` liftExp e -- liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|] -- liftFlavour NameS = [|NameS|] -- liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|] -- liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|] -- liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|] -- liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|] -- liftNS VarName = [|VarName|] -- liftNS DataName = [|DataName|] -- - type QueryParameters = [(TS.Text, TS.Text)] - type RenderUrl url = (url -> QueryParameters -> TS.Text) - type Shakespeare url = RenderUrl url -> Builder -@@ -302,54 +265,6 @@ pack' = TS.pack - {-# NOINLINE pack' #-} - #endif - --contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp --contentsToShakespeare rs a = do -- r <- newName "_render" -- c <- mapM (contentToBuilder r) a -- compiledTemplate <- case c of -- -- Make sure we convert this mempty using toBuilder to pin down the -- -- type appropriately -- [] -> fmap (AppE $ wrap rs) [|mempty|] -- [x] -> return x -- _ -> do -- mc <- [|mconcat|] -- return $ mc `AppE` ListE c -- fmap (maybe id AppE $ modifyFinalValue rs) $ -- if justVarInterpolation rs -- then return compiledTemplate -- else return $ LamE [VarP r] compiledTemplate -- where -- contentToBuilder :: Name -> Content -> Q Exp -- contentToBuilder _ (ContentRaw s') = do -- ts <- [|fromText . pack'|] -- return $ wrap rs `AppE` (ts `AppE` LitE (StringL s')) -- contentToBuilder _ (ContentVar d) = -- return $ wrap rs `AppE` (toBuilder rs `AppE` derefToExp [] d) -- contentToBuilder r (ContentUrl d) = do -- ts <- [|fromText|] -- return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE [])) -- contentToBuilder r (ContentUrlParam d) = do -- ts <- [|fromText|] -- up <- [|\r' (u, p) -> r' u p|] -- return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d)) -- contentToBuilder r (ContentMix d) = -- return $ derefToExp [] d `AppE` VarE r -- --shakespeare :: ShakespeareSettings -> QuasiQuoter --shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r } -- --shakespeareFromString :: ShakespeareSettings -> String -> Q Exp --shakespeareFromString r str = do -- s <- qRunIO $ preFilter r str -- contentsToShakespeare r $ contentFromString r s -- --shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp --shakespeareFile r fp = do --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- readFileQ fp >>= shakespeareFromString r -- - data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin - - getVars :: Content -> [(Deref, VarType)] -@@ -369,30 +284,6 @@ data VarExp url = EPlain Builder - shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)] - shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings - --shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp --shakespeareFileReload rs fp = do -- str <- readFileQ fp -- s <- qRunIO $ preFilter rs str -- let b = shakespeareUsedIdentifiers rs s -- c <- mapM vtToExp b -- rt <- [|shakespeareRuntime|] -- wrap' <- [|\x -> $(return $ wrap rs) . x|] -- r' <- lift rs -- return $ wrap' `AppE` (rt `AppE` r' `AppE` (LitE $ StringL fp) `AppE` ListE c) -- where -- vtToExp :: (Deref, VarType) -> Q Exp -- vtToExp (d, vt) = do -- d' <- lift d -- c' <- c vt -- return $ TupE [d', c' `AppE` derefToExp [] d] -- where -- c :: VarType -> Q Exp -- c VTPlain = [|EPlain . $(return $ toBuilder rs)|] -- c VTUrl = [|EUrl|] -- c VTUrlParam = [|EUrlParam|] -- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap rs) $ x r|] -- -- - shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url - shakespeareRuntime rs fp cd render' = unsafePerformIO $ do - str <- readFileUtf8 fp -diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs -index 7c96898..ef769b1 100644 ---- a/Text/Shakespeare/Base.hs -+++ b/Text/Shakespeare/Base.hs -@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident - | DerefTuple [Deref] - deriving (Show, Eq, Read, Data, Typeable, Ord) - --instance Lift Ident where -- lift (Ident s) = [|Ident|] `appE` lift s --instance Lift Deref where -- lift (DerefModulesIdent v s) = do -- dl <- [|DerefModulesIdent|] -- v' <- lift v -- s' <- lift s -- return $ dl `AppE` v' `AppE` s' -- lift (DerefIdent s) = do -- dl <- [|DerefIdent|] -- s' <- lift s -- return $ dl `AppE` s' -- lift (DerefBranch x y) = do -- x' <- lift x -- y' <- lift y -- db <- [|DerefBranch|] -- return $ db `AppE` x' `AppE` y' -- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i -- lift (DerefRational r) = do -- n <- lift $ numerator r -- d <- lift $ denominator r -- per <- [|(%) :: Int -> Int -> Ratio Int|] -- dr <- [|DerefRational|] -- return $ dr `AppE` InfixE (Just n) per (Just d) -- lift (DerefString s) = [|DerefString|] `appE` lift s -- lift (DerefList x) = [|DerefList $(lift x)|] -- lift (DerefTuple x) = [|DerefTuple $(lift x)|] -- - derefParens, derefCurlyBrackets :: UserParser a Deref - derefParens = between (char '(') (char ')') parseDeref - derefCurlyBrackets = between (char '{') (char '}') parseDeref -diff --git a/shakespeare.cabal b/shakespeare.cabal -index 01c8d5d..0fff966 100644 ---- a/shakespeare.cabal -+++ b/shakespeare.cabal -@@ -27,7 +27,7 @@ library - , template-haskell - , parsec >= 2 && < 4 - , text >= 0.7 && < 0.12 -- , process >= 1.0 && < 1.2 -+ , process >= 1.0 && < 1.3 - - exposed-modules: - Text.Shakespeare --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/skein_hardcode_little-endian.patch b/standalone/android/haskell-patches/skein_hardcode_little-endian.patch new file mode 100644 index 000000000..788d8e521 --- /dev/null +++ b/standalone/android/haskell-patches/skein_hardcode_little-endian.patch @@ -0,0 +1,24 @@ +From 3a04b41ffce4e4e87b0fedd3a1e3434a3f06cc76 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 00:18:12 +0000 +Subject: [PATCH] hardcode little endian + +--- + c_impl/optimized/skein_port.h | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/c_impl/optimized/skein_port.h b/c_impl/optimized/skein_port.h +index a2d0fc2..6929bb0 100644 +--- a/c_impl/optimized/skein_port.h ++++ b/c_impl/optimized/skein_port.h +@@ -45,6 +45,7 @@ typedef uint64_t u64b_t; /* 64-bit unsigned integer */ + * platform-specific code instead (e.g., for big-endian CPUs).
+ *
+ */
++#define SKEIN_NEED_SWAP (0)
+ #ifndef SKEIN_NEED_SWAP /* compile-time "override" for endianness? */
+
+ #include "brg_endian.h" /* get endianness selection */
+-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch b/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch index 5a343d875..fc9569573 100644 --- a/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch +++ b/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch @@ -1,43 +1,29 @@ -From abab0f8202998a3e88c5dc5f67a8245da6c174b3 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:36:20 -0400 +From 28e6a6599ee91e15aa7b2f9d25433490f192f22e Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 23:17:29 +0000 Subject: [PATCH] remove IPv6 stuff --- - Network/Socks5.hs | 1 - - Network/Socks5/Command.hs | 16 ++-------------- - Network/Socks5/Types.hs | 3 +-- - Network/Socks5/Wire.hs | 2 -- - 4 files changed, 3 insertions(+), 19 deletions(-) + Network/Socks5/Command.hs | 8 +------- + Network/Socks5/Conf.hs | 1 - + Network/Socks5/Lowlevel.hs | 1 - + Network/Socks5/Types.hs | 18 +----------------- + Network/Socks5/Wire.hs | 2 -- + 5 files changed, 2 insertions(+), 28 deletions(-) -diff --git a/Network/Socks5.hs b/Network/Socks5.hs -index 67b0060..80efb9c 100644 ---- a/Network/Socks5.hs -+++ b/Network/Socks5.hs -@@ -54,7 +54,6 @@ socksConnectAddr :: Socket -> SockAddr -> SockAddr -> IO () - socksConnectAddr sock sockserver destaddr = withSocks sock sockserver $ do - case destaddr of - SockAddrInet p h -> socks5ConnectIPV4 sock h p >> return () -- SockAddrInet6 p _ h _ -> socks5ConnectIPV6 sock h p >> return () - _ -> error "unsupported unix sockaddr type" - - -- | connect a new socket to the socks server, and connect the stream to a FQDN diff --git a/Network/Socks5/Command.hs b/Network/Socks5/Command.hs -index 2952706..db994c9 100644 +index 8ce06ec..222d954 100644 --- a/Network/Socks5/Command.hs +++ b/Network/Socks5/Command.hs -@@ -9,9 +9,8 @@ - -- - module Network.Socks5.Command - ( socks5Establish -- , socks5ConnectIPV4 -- , socks5ConnectIPV6 - , socks5ConnectDomainName -+ , socks5ConnectIPV4 - -- * lowlevel interface - , socks5Rpc - ) where -@@ -23,7 +22,7 @@ import qualified Data.ByteString as B +@@ -12,7 +12,6 @@ module Network.Socks5.Command + , Connect(..) + , Command(..) + , connectIPV4 +- , connectIPV6 + , connectDomainName + -- * lowlevel interface + , rpc +@@ -28,7 +27,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Serialize @@ -46,50 +32,92 @@ index 2952706..db994c9 100644 import Network.Socket.ByteString import Network.Socks5.Types -@@ -46,17 +45,6 @@ socks5ConnectIPV4 socket hostaddr port = onReply <$> socks5Rpc socket request - onReply (SocksAddrIPV4 h, p) = (h, p) - onReply _ = error "ipv4 requested, got something different" +@@ -64,11 +63,6 @@ connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddre + where onReply (SocksAddrIPV4 h, p) = (h, p) + onReply _ = error "ipv4 requested, got something different" --socks5ConnectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber) --socks5ConnectIPV6 socket hostaddr6 port = onReply <$> socks5Rpc socket request -- where -- request = SocksRequest -- { requestCommand = SocksCommandConnect -- , requestDstAddr = SocksAddrIPV6 hostaddr6 -- , requestDstPort = fromIntegral port -- } -- onReply (SocksAddrIPV6 h, p) = (h, p) -- onReply _ = error "ipv6 requested, got something different" +-connectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber) +-connectIPV6 socket hostaddr6 port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV6 hostaddr6) port) +- where onReply (SocksAddrIPV6 h, p) = (h, p) +- onReply _ = error "ipv6 requested, got something different" - -- TODO: FQDN should only be ascii, maybe putting a "fqdn" data type -- in front to make sure and make the BC.pack safe. - socks5ConnectDomainName :: Socket -> String -> PortNumber -> IO (SocksAddr, PortNumber) + connectDomainName :: Socket -> String -> PortNumber -> IO (SocksHostAddress, PortNumber) +diff --git a/Network/Socks5/Conf.hs b/Network/Socks5/Conf.hs +index c29ff7b..007d382 100644 +--- a/Network/Socks5/Conf.hs ++++ b/Network/Socks5/Conf.hs +@@ -47,5 +47,4 @@ defaultSocksConfFromSockAddr sockaddr = SocksConf server SocksVer5 + where server = SocksAddress haddr port + (haddr,port) = case sockaddr of + SockAddrInet p h -> (SocksAddrIPV4 h, p) +- SockAddrInet6 p _ h _ -> (SocksAddrIPV6 h, p) + _ -> error "unsupported unix sockaddr type" +diff --git a/Network/Socks5/Lowlevel.hs b/Network/Socks5/Lowlevel.hs +index c10d9b9..2c3d59c 100644 +--- a/Network/Socks5/Lowlevel.hs ++++ b/Network/Socks5/Lowlevel.hs +@@ -17,7 +17,6 @@ resolveToSockAddr :: SocksAddress -> IO SockAddr + resolveToSockAddr (SocksAddress sockHostAddr port) = + case sockHostAddr of + SocksAddrIPV4 ha -> return $ SockAddrInet port ha +- SocksAddrIPV6 ha6 -> return $ SockAddrInet6 port 0 ha6 0 + SocksAddrDomainName bs -> do he <- getHostByName (BC.unpack bs) + return $ SockAddrInet port (hostAddress he) + diff --git a/Network/Socks5/Types.hs b/Network/Socks5/Types.hs -index 5dc7d5e..12dea99 100644 +index 7fbec25..17c7c83 100644 --- a/Network/Socks5/Types.hs +++ b/Network/Socks5/Types.hs -@@ -17,7 +17,7 @@ module Network.Socks5.Types +@@ -19,7 +19,7 @@ module Network.Socks5.Types import Data.ByteString (ByteString) import Data.Word import Data.Data --import Network.Socket (HostAddress, HostAddress6) -+import Network.Socket (HostAddress) +-import Network.Socket (HostAddress, HostAddress6, PortNumber) ++import Network.Socket (HostAddress, PortNumber) import Control.Exception + import qualified Data.ByteString.Char8 as BC + import Numeric (showHex) +@@ -53,12 +53,10 @@ data SocksMethod = + data SocksHostAddress = + SocksAddrIPV4 !HostAddress + | SocksAddrDomainName !ByteString +- | SocksAddrIPV6 !HostAddress6 + deriving (Eq,Ord) - data SocksCommand = -@@ -38,7 +38,6 @@ data SocksMethod = - data SocksAddr = - SocksAddrIPV4 HostAddress - | SocksAddrDomainName ByteString -- | SocksAddrIPV6 HostAddress6 - deriving (Show,Eq) + instance Show SocksHostAddress where + show (SocksAddrIPV4 ha) = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")" +- show (SocksAddrIPV6 ha6) = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")" + show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ BC.unpack dn ++ ")" - data SocksReply = + -- | Converts a HostAddress to a String in dot-decimal notation +@@ -69,20 +67,6 @@ showHostAddress num = concat [show q1, ".", show q2, ".", show q3, ".", show q4] + (num''',q3) = num'' `quotRem` 256 + (_,q4) = num''' `quotRem` 256 + +--- | Converts a IPv6 HostAddress6 to standard hex notation +-showHostAddress6 :: HostAddress6 -> String +-showHostAddress6 (a,b,c,d) = +- (concat . intersperse ":" . map (flip showHex "")) +- [p1,p2,p3,p4,p5,p6,p7,p8] +- where (a',p2) = a `quotRem` 65536 +- (_,p1) = a' `quotRem` 65536 +- (b',p4) = b `quotRem` 65536 +- (_,p3) = b' `quotRem` 65536 +- (c',p6) = c `quotRem` 65536 +- (_,p5) = c' `quotRem` 65536 +- (d',p8) = d `quotRem` 65536 +- (_,p7) = d' `quotRem` 65536 +- + -- | Describe a Socket address on the SOCKS protocol + data SocksAddress = SocksAddress !SocksHostAddress !PortNumber + deriving (Show,Eq,Ord) diff --git a/Network/Socks5/Wire.hs b/Network/Socks5/Wire.hs -index 2cfed52..d3bd9c5 100644 +index 3ab95a8..2881988 100644 --- a/Network/Socks5/Wire.hs +++ b/Network/Socks5/Wire.hs -@@ -41,12 +41,10 @@ data SocksResponse = SocksResponse +@@ -46,12 +46,10 @@ data SocksResponse = SocksResponse getAddr 1 = SocksAddrIPV4 <$> getWord32be getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral) @@ -101,7 +129,7 @@ index 2cfed52..d3bd9c5 100644 -putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d] getSocksRequest 5 = do - cmd <- toEnum . fromIntegral <$> getWord8 + cmd <- toEnum . fromIntegral <$> getWord8 -- 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-time_hack-for-Bionic.patch b/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch new file mode 100644 index 000000000..80b509f5f --- /dev/null +++ b/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch @@ -0,0 +1,25 @@ +From eff7034f0c9f80fd30c9d8952b3fd0a343adccc8 Mon Sep 17 00:00:00 2001 +From: foo <bar> +Date: Mon, 23 Sep 2013 00:12:35 +0000 +Subject: [PATCH] hack for Bionic + +--- + cbits/conv.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/cbits/conv.c b/cbits/conv.c +index 7ff7b87..2e4c870 100644 +--- a/cbits/conv.c ++++ b/cbits/conv.c +@@ -55,7 +55,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); (not in Bionic) */ + } + + size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) { +-- +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/unordered-containers_fix-build-with-new-ghc.patch b/standalone/android/haskell-patches/unordered-containers_fix-build-with-new-ghc.patch new file mode 100644 index 000000000..7c0774e67 --- /dev/null +++ b/standalone/android/haskell-patches/unordered-containers_fix-build-with-new-ghc.patch @@ -0,0 +1,32 @@ +From 2d1f0027ae1ca56bbf4449887cf3bc61dc1c8e84 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 22:32:01 +0000 +Subject: [PATCH] fix build with new ghc + +--- + Data/HashMap/Base.hs | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs +index 6a77df4..93a384d 100644 +--- a/Data/HashMap/Base.hs ++++ b/Data/HashMap/Base.hs +@@ -86,7 +86,7 @@ import qualified Data.List as L + import Data.Monoid (Monoid(mempty, mappend)) + import Data.Traversable (Traversable(..)) + import Data.Word (Word) +-import GHC.Exts ((==#), build, reallyUnsafePtrEquality#) ++import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, tagToEnum#) + import Prelude hiding (filter, foldr, lookup, map, null, pred) + + import qualified Data.HashMap.Array as A +@@ -1072,5 +1072,5 @@ fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren) + -- | Check if two the two arguments are the same value. N.B. This + -- function might give false negatives (due to GC moving objects.) + ptrEq :: a -> a -> Bool +-ptrEq x y = reallyUnsafePtrEquality# x y ==# 1# ++ptrEq x y = tagToEnum# (reallyUnsafePtrEquality# x y ==# 1#) + {-# INLINE ptrEq #-} +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/vector_0.10.0.1_0001-disable-optimisation-that-breaks-when-cross-compilin.patch b/standalone/android/haskell-patches/vector_0.10.0.1_0001-disable-optimisation-that-breaks-when-cross-compilin.patch deleted file mode 100644 index aa50d9c93..000000000 --- a/standalone/android/haskell-patches/vector_0.10.0.1_0001-disable-optimisation-that-breaks-when-cross-compilin.patch +++ /dev/null @@ -1,25 +0,0 @@ -From 3a4ee8091ba9da44f9f4a04522a5ff45fabe70d9 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:37:56 -0400 -Subject: [PATCH] disable optimisation that breaks when cross-compiling - -This needs TH to work actually. ---- - Data/Vector/Fusion/Stream/Monadic.hs | 1 - - 1 file changed, 1 deletion(-) - -diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs -index 51fec75..b089b3d 100644 ---- a/Data/Vector/Fusion/Stream/Monadic.hs -+++ b/Data/Vector/Fusion/Stream/Monadic.hs -@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) ) - - data SPEC = SPEC | SPEC2 - #if __GLASGOW_HASKELL__ >= 700 --{-# ANN type SPEC ForceSpecConstr #-} - #endif - - emptyStream :: String --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch b/standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch new file mode 100644 index 000000000..4c08be4f9 --- /dev/null +++ b/standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch @@ -0,0 +1,130 @@ +From af259b521574b734a7a0b1b3e9e6868df33ebdb9 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sat, 21 Sep 2013 23:47:47 +0000 +Subject: [PATCH] hack to build with new ghc + +--- + Data/Vector.hs | 1 - + Data/Vector/Fusion/Stream/Monadic.hs | 1 - + Data/Vector/Generic.hs | 10 ++-------- + Data/Vector/Primitive.hs | 1 - + Data/Vector/Storable.hs | 1 - + Data/Vector/Unboxed/Base.hs | 15 +-------------- + 6 files changed, 3 insertions(+), 26 deletions(-) + +diff --git a/Data/Vector.hs b/Data/Vector.hs +index 138b2db..92c4387 100644 +--- a/Data/Vector.hs ++++ b/Data/Vector.hs +@@ -215,7 +215,6 @@ instance Data a => Data (Vector a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Vector" +- dataCast1 = G.dataCast + + type instance G.Mutable Vector = MVector + +diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs +index 51fec75..b089b3d 100644 +--- a/Data/Vector/Fusion/Stream/Monadic.hs ++++ b/Data/Vector/Fusion/Stream/Monadic.hs +@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) ) + + data SPEC = SPEC | SPEC2 + #if __GLASGOW_HASKELL__ >= 700 +-{-# ANN type SPEC ForceSpecConstr #-} + #endif + + emptyStream :: String +diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs +index 78f7260..f4ea80a 100644 +--- a/Data/Vector/Generic.hs ++++ b/Data/Vector/Generic.hs +@@ -157,7 +157,7 @@ module Data.Vector.Generic ( + showsPrec, readPrec, + + -- ** @Data@ and @Typeable@ +- gfoldl, dataCast, mkType ++ gfoldl, mkType + ) where + + import Data.Vector.Generic.Base +@@ -194,7 +194,7 @@ import Prelude hiding ( length, null, + showsPrec ) + + import qualified Text.Read as Read +-import Data.Typeable ( Typeable1, gcast1 ) ++import Data.Typeable ( gcast1 ) + + #include "vector.h" + +@@ -2019,9 +2019,3 @@ gfoldl f z v = z fromList `f` toList v + mkType :: String -> DataType + {-# INLINE mkType #-} + mkType = mkNoRepType +- +-dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) +- => (forall d. Data d => c (t d)) -> Maybe (c (v a)) +-{-# INLINE dataCast #-} +-dataCast f = gcast1 f +- +diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs +index 5f59bae..06e84c3 100644 +--- a/Data/Vector/Primitive.hs ++++ b/Data/Vector/Primitive.hs +@@ -188,7 +188,6 @@ instance (Data a, Prim a) => Data (Vector a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector" +- dataCast1 = G.dataCast + + + type instance G.Mutable Vector = MVector +diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs +index f9928e4..a17e3d6 100644 +--- a/Data/Vector/Storable.hs ++++ b/Data/Vector/Storable.hs +@@ -194,7 +194,6 @@ instance (Data a, Storable a) => Data (Vector a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector" +- dataCast1 = G.dataCast + + type instance G.Mutable Vector = MVector + +diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs +index 00350cb..c13ea20 100644 +--- a/Data/Vector/Unboxed/Base.hs ++++ b/Data/Vector/Unboxed/Base.hs +@@ -31,7 +31,7 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 ) + import Data.Int ( Int8, Int16, Int32, Int64 ) + import Data.Complex + +-import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, ++import Data.Typeable ( mkTyConApp, + #if MIN_VERSION_base(4,4,0) + mkTyCon3 + #else +@@ -65,19 +65,6 @@ vectorTyCon = mkTyCon3 "vector" + vectorTyCon m s = mkTyCon $ m ++ "." ++ s + #endif + +-instance Typeable1 Vector where +- typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] +- +-instance Typeable2 MVector where +- typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] +- +-instance (Data a, Unbox a) => Data (Vector a) where +- gfoldl = G.gfoldl +- toConstr _ = error "toConstr" +- gunfold _ _ = error "gunfold" +- dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector" +- dataCast1 = G.dataCast +- + -- ---- + -- Unit + -- ---- +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/wai-app-static_1.3.1-remove-TH.patch b/standalone/android/haskell-patches/wai-app-static_deal-with-TH.patch index 30bf5256a..d9860f922 100644 --- a/standalone/android/haskell-patches/wai-app-static_1.3.1-remove-TH.patch +++ b/standalone/android/haskell-patches/wai-app-static_deal-with-TH.patch @@ -1,16 +1,19 @@ -From c18ae75852b1340ca502528138bf421659f61a3d Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 12:44:15 -0400 -Subject: [PATCH] remove TH +From 432a8fc47bb11cf8fd0a832e033cfb94a6332dbe Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 07:29:39 +0000 +Subject: [PATCH] deal with TH + +Export modules referenced by it. Should not need these icons in git-annex, so not worth using the Evil Splicer. --- - Network/Wai/Application/Static.hs | 4 ---- - 1 file changed, 4 deletions(-) + Network/Wai/Application/Static.hs | 4 ---- + wai-app-static.cabal | 2 +- + 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs -index 3195fbb..b48aa01 100644 +index 3f07391..75709b7 100644 --- a/Network/Wai/Application/Static.hs +++ b/Network/Wai/Application/Static.hs @@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO) @@ -31,6 +34,21 @@ index 3195fbb..b48aa01 100644 staticAppPieces ss rawPieces req = liftIO $ do case toPieces rawPieces of Just pieces -> checkPieces ss pieces req >>= response +diff --git a/wai-app-static.cabal b/wai-app-static.cabal +index ec22813..e944caa 100644 +--- a/wai-app-static.cabal ++++ b/wai-app-static.cabal +@@ -56,9 +56,9 @@ library + WaiAppStatic.Storage.Embedded + WaiAppStatic.Listing + WaiAppStatic.Types +- other-modules: Util + WaiAppStatic.Storage.Embedded.Runtime + WaiAppStatic.Storage.Embedded.TH ++ other-modules: Util + ghc-options: -Wall + extensions: CPP + -- -1.8.2.rc3 +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-auth_don-t-really-build.patch b/standalone/android/haskell-patches/yesod-auth_don-t-really-build.patch new file mode 100644 index 000000000..7016e001c --- /dev/null +++ b/standalone/android/haskell-patches/yesod-auth_don-t-really-build.patch @@ -0,0 +1,34 @@ +From 3eb7b0a42099721dc19363ac41319efeed4ac5f9 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 05:19:53 +0000 +Subject: [PATCH] don't really build + +--- + yesod-auth.cabal | 11 +---------- + 1 file changed, 1 insertion(+), 10 deletions(-) + +diff --git a/yesod-auth.cabal b/yesod-auth.cabal +index 591ced5..11217be 100644 +--- a/yesod-auth.cabal ++++ b/yesod-auth.cabal +@@ -52,16 +52,7 @@ library + , safe + , time + +- exposed-modules: Yesod.Auth +- Yesod.Auth.BrowserId +- Yesod.Auth.Dummy +- Yesod.Auth.Email +- Yesod.Auth.OpenId +- Yesod.Auth.Rpxnow +- Yesod.Auth.HashDB +- Yesod.Auth.Message +- Yesod.Auth.GoogleEmail +- other-modules: Yesod.Auth.Routes ++ exposed-modules: + ghc-options: -Wall + + source-repository head +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/yesod-core_1.1.8_0001-remove-TH.patch b/standalone/android/haskell-patches/yesod-core_1.1.8_0001-remove-TH.patch deleted file mode 100644 index fd641a1aa..000000000 --- a/standalone/android/haskell-patches/yesod-core_1.1.8_0001-remove-TH.patch +++ /dev/null @@ -1,476 +0,0 @@ -From 801f6dea3be43113400e41aabb443456fffcd227 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:39:40 -0400 -Subject: [PATCH 1/2] remove TH - ---- - Yesod/Core.hs | 10 ---- - Yesod/Dispatch.hs | 119 +---------------------------------------------- - Yesod/Handler.hs | 27 +---------- - Yesod/Internal/Cache.hs | 5 -- - Yesod/Internal/Core.hs | 119 +++++------------------------------------------ - Yesod/Widget.hs | 29 ------------ - 6 files changed, 13 insertions(+), 296 deletions(-) - -diff --git a/Yesod/Core.hs b/Yesod/Core.hs -index 7268d6c..ce04b7d 100644 ---- a/Yesod/Core.hs -+++ b/Yesod/Core.hs -@@ -21,16 +21,6 @@ module Yesod.Core - , unauthorizedI - -- * Logging - , LogLevel (..) -- , logDebug -- , logInfo -- , logWarn -- , logError -- , logOther -- , logDebugS -- , logInfoS -- , logWarnS -- , logErrorS -- , logOtherS - -- * Sessions - , SessionBackend (..) - , defaultClientSessionBackend -diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs -index 1e19388..dd37475 100644 ---- a/Yesod/Dispatch.hs -+++ b/Yesod/Dispatch.hs -@@ -6,20 +6,9 @@ - {-# LANGUAGE MultiParamTypeClasses #-} - module Yesod.Dispatch - ( -- * Quasi-quoted routing -- parseRoutes -- , parseRoutesNoCheck -- , parseRoutesFile -- , parseRoutesFileNoCheck -- , mkYesod -- , mkYesodSub - -- ** More fine-grained -- , mkYesodData -- , mkYesodSubData -- , mkYesodDispatch -- , mkYesodSubDispatch -- , mkDispatchInstance - -- ** Path pieces -- , PathPiece (..) -+ PathPiece (..) - , PathMultiPiece (..) - , Texts - -- * Convert to WAI -@@ -52,117 +41,11 @@ import Data.Monoid (mappend) - import qualified Data.ByteString as S - import qualified Blaze.ByteString.Builder - import Network.HTTP.Types (status301) --import Yesod.Routes.TH - import Yesod.Content (chooseRep) --import Yesod.Routes.Parse - import System.Log.FastLogger (Logger) - - type Texts = [Text] - ---- | Generates URL datatype and site function for the given 'Resource's. This ---- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter. ---- Use 'parseRoutes' to create the 'Resource's. --mkYesod :: String -- ^ name of the argument datatype -- -> [ResourceTree String] -- -> Q [Dec] --mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False -- ---- | Generates URL datatype and site function for the given 'Resource's. This ---- is used for creating subsites, /not/ sites. See 'mkYesod' for the latter. ---- Use 'parseRoutes' to create the 'Resource's. In general, a subsite is not ---- executable by itself, but instead provides functionality to ---- be embedded in other sites. --mkYesodSub :: String -- ^ name of the argument datatype -- -> Cxt -- -> [ResourceTree String] -- -> Q [Dec] --mkYesodSub name clazzes = -- fmap (uncurry (++)) . mkYesodGeneral name' rest clazzes True -- where -- (name':rest) = words name -- ---- | Sometimes, you will want to declare your routes in one file and define ---- your handlers elsewhere. For example, this is the only way to break up a ---- monolithic file into smaller parts. Use this function, paired with ---- 'mkYesodDispatch', to do just that. --mkYesodData :: String -> [ResourceTree String] -> Q [Dec] --mkYesodData name res = mkYesodDataGeneral name [] False res -- --mkYesodSubData :: String -> Cxt -> [ResourceTree String] -> Q [Dec] --mkYesodSubData name clazzes res = mkYesodDataGeneral name clazzes True res -- --mkYesodDataGeneral :: String -> Cxt -> Bool -> [ResourceTree String] -> Q [Dec] --mkYesodDataGeneral name clazzes isSub res = do -- let (name':rest) = words name -- (x, _) <- mkYesodGeneral name' rest clazzes isSub res -- let rname = mkName $ "resources" ++ name -- eres <- lift res -- let y = [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String) -- , FunD rname [Clause [] (NormalB eres) []] -- ] -- return $ x ++ y -- ---- | See 'mkYesodData'. --mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec] --mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False -- --mkYesodSubDispatch :: String -> Cxt -> [ResourceTree String] -> Q [Dec] --mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True -- where (name':rest) = words name -- --mkYesodGeneral :: String -- ^ foundation type -- -> [String] -- ^ arguments for the type -- -> Cxt -- ^ the type constraints -- -> Bool -- ^ it this a subsite -- -> [ResourceTree String] -- -> Q([Dec],[Dec]) --mkYesodGeneral name args clazzes isSub resS = do -- subsite <- sub -- masterTypeSyns <- if isSub then return [] -- else sequence [handler, widget] -- renderRouteDec <- mkRenderRouteInstance subsite res -- dispatchDec <- mkDispatchInstance context sub master res -- return (renderRouteDec ++ masterTypeSyns, dispatchDec) -- where sub = foldl appT subCons subArgs -- master = if isSub then (varT $ mkName "master") else sub -- context = if isSub then cxt $ yesod : map return clazzes -- else return [] -- yesod = classP ''Yesod [master] -- handler = tySynD (mkName "Handler") [] [t| GHandler $master $master |] -- widget = tySynD (mkName "Widget") [] [t| GWidget $master $master () |] -- res = map (fmap parseType) resS -- subCons = conT $ mkName name -- subArgs = map (varT. mkName) args -- ---- | If the generation of @'YesodDispatch'@ instance require finer ---- control of the types, contexts etc. using this combinator. You will ---- hardly need this generality. However, in certain situations, like ---- when writing library/plugin for yesod, this combinator becomes ---- handy. --mkDispatchInstance :: CxtQ -- ^ The context -- -> TypeQ -- ^ The subsite type -- -> TypeQ -- ^ The master site type -- -> [ResourceTree a] -- ^ The resource -- -> DecsQ --mkDispatchInstance context sub master res = do -- logger <- newName "logger" -- let loggerE = varE logger -- loggerP = VarP logger -- yDispatch = conT ''YesodDispatch `appT` sub `appT` master -- thisDispatch = do -- Clause pat body decs <- mkDispatchClause -- [|yesodRunner $loggerE |] -- [|yesodDispatch $loggerE |] -- [|fmap chooseRep|] -- res -- return $ FunD 'yesodDispatch -- [ Clause (loggerP:pat) -- body -- decs -- ] -- in sequence [instanceD context yDispatch [thisDispatch]] -- -- - -- | Convert the given argument into a WAI application, executable with any WAI - -- handler. This is the same as 'toWaiAppPlain', except it includes two - -- middlewares: GZIP compression and autohead. This is the -diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs -index 1997bdb..98c915c 100644 ---- a/Yesod/Handler.hs -+++ b/Yesod/Handler.hs -@@ -42,7 +42,6 @@ module Yesod.Handler - , RedirectUrl (..) - , redirect - , redirectWith -- , redirectToPost - -- ** Errors - , notFound - , badMethod -@@ -100,7 +99,6 @@ module Yesod.Handler - , getMessageRender - -- * Per-request caching - , CacheKey -- , mkCacheKey - , cacheLookup - , cacheInsert - , cacheDelete -@@ -172,7 +170,7 @@ import System.Log.FastLogger - import Control.Monad.Logger - - import qualified Yesod.Internal.Cache as Cache --import Yesod.Internal.Cache (mkCacheKey, CacheKey) -+import Yesod.Internal.Cache (CacheKey) - import qualified Data.IORef as I - import Control.Exception.Lifted (catch) - import Control.Monad.Trans.Control -@@ -937,29 +935,6 @@ newIdent = do - put x { ghsIdent = i' } - return $ T.pack $ 'h' : show i' - ---- | Redirect to a POST resource. ---- ---- This is not technically a redirect; instead, it returns an HTML page with a ---- POST form, and some Javascript to automatically submit the form. This can be ---- useful when you need to post a plain link somewhere that needs to cause ---- changes on the server. --redirectToPost :: RedirectUrl master url => url -> GHandler sub master a --redirectToPost url = do -- urlText <- toTextUrl url -- hamletToRepHtml [hamlet| --$newline never --$doctype 5 -- --<html> -- <head> -- <title>Redirecting... -- <body onload="document.getElementById('form').submit()"> -- <form id="form" method="post" action=#{urlText}> -- <noscript> -- <p>Javascript has been disabled; please click on the button below to be redirected. -- <input type="submit" value="Continue"> --|] >>= sendResponse -- - -- | Converts the given Hamlet template into 'Content', which can be used in a - -- Yesod 'Response'. - hamletToContent :: HtmlUrl (Route master) -> GHandler sub master Content -diff --git a/Yesod/Internal/Cache.hs b/Yesod/Internal/Cache.hs -index 4aec0d2..fdef9d7 100644 ---- a/Yesod/Internal/Cache.hs -+++ b/Yesod/Internal/Cache.hs -@@ -3,7 +3,6 @@ - module Yesod.Internal.Cache - ( Cache - , CacheKey -- , mkCacheKey - , lookup - , insert - , delete -@@ -24,10 +23,6 @@ newtype Cache = Cache (Map.IntMap Any) - - newtype CacheKey a = CacheKey Int - ---- | Generate a new 'CacheKey'. Be sure to give a full type signature. --mkCacheKey :: Q Exp --mkCacheKey = [|CacheKey|] `appE` (LitE . IntegerL . fromIntegral . hashUnique <$> runIO newUnique) -- - lookup :: CacheKey a -> Cache -> Maybe a - lookup (CacheKey i) (Cache m) = unsafeCoerce <$> Map.lookup i m - -diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs -index c4a9796..90c05fc 100644 ---- a/Yesod/Internal/Core.hs -+++ b/Yesod/Internal/Core.hs -@@ -44,7 +44,6 @@ module Yesod.Internal.Core - - import Yesod.Content - import Yesod.Handler hiding (lift, getExpires) --import Control.Monad.Logger (logErrorS) - - import Yesod.Routes.Class - import Data.Time (UTCTime, addUTCTime, getCurrentTime) -@@ -165,22 +164,7 @@ class RenderRoute a => Yesod a where - - -- | Applies some form of layout to the contents of a page. - defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml -- defaultLayout w = do -- p <- widgetToPageContent w -- mmsg <- getMessage -- hamletToRepHtml [hamlet| --$newline never --$doctype 5 -- --<html> -- <head> -- <title>#{pageTitle p} -- ^{pageHead p} -- <body> -- $maybe msg <- mmsg -- <p .message>#{msg} -- ^{pageBody p} --|] -+ defaultLayout w = error "defaultLayout not implemented" - - -- | Override the rendering function for a particular URL. One use case for - -- this is to offload static hosting to a different domain name to avoid -@@ -521,46 +505,11 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do - - -- | The default error handler for 'errorHandler'. - defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep --defaultErrorHandler NotFound = do -- r <- waiRequest -- let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r -- applyLayout' "Not Found" -- [hamlet| --$newline never --<h1>Not Found --<p>#{path'} --|] --defaultErrorHandler (PermissionDenied msg) = -- applyLayout' "Permission Denied" -- [hamlet| --$newline never --<h1>Permission denied --<p>#{msg} --|] --defaultErrorHandler (InvalidArgs ia) = -- applyLayout' "Invalid Arguments" -- [hamlet| --$newline never --<h1>Invalid Arguments --<ul> -- $forall msg <- ia -- <li>#{msg} --|] --defaultErrorHandler (InternalError e) = do -- $logErrorS "yesod-core" e -- applyLayout' "Internal Server Error" -- [hamlet| --$newline never --<h1>Internal Server Error --<pre>#{e} --|] --defaultErrorHandler (BadMethod m) = -- applyLayout' "Bad Method" -- [hamlet| --$newline never --<h1>Method Not Supported --<p>Method <code>#{S8.unpack m}</code> not supported --|] -+defaultErrorHandler NotFound = error "Not Found" -+defaultErrorHandler (PermissionDenied msg) = error "Permission Denied" -+defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments" -+defaultErrorHandler (InternalError e) = error "Internal Server Error" -+defaultErrorHandler (BadMethod m) = error "Bad Method" - - -- | Return the same URL if the user is authorized to see it. - -- -@@ -616,45 +565,10 @@ widgetToPageContent w = do - -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing - -- the asynchronous loader means your page doesn't have to wait for all the js to load - let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc -- regularScriptLoad = [hamlet| --$newline never --$forall s <- scripts -- ^{mkScriptTag s} --$maybe j <- jscript -- $maybe s <- jsLoc -- <script src="#{s}"> -- $nothing -- <script>^{jelper j} --|] -- -- headAll = [hamlet| --$newline never --\^{head'} --$forall s <- stylesheets -- ^{mkLinkTag s} --$forall s <- css -- $maybe t <- right $ snd s -- $maybe media <- fst s -- <link rel=stylesheet media=#{media} href=#{t}> -- $nothing -- <link rel=stylesheet href=#{t}> -- $maybe content <- left $ snd s -- $maybe media <- fst s -- <style media=#{media}>#{content} -- $nothing -- <style>#{content} --$case jsLoader master -- $of BottomOfBody -- $of BottomOfHeadAsync asyncJsLoader -- ^{asyncJsLoader asyncScripts mcomplete} -- $of BottomOfHeadBlocking -- ^{regularScriptLoad} --|] -- let bodyScript = [hamlet| --$newline never --^{body} --^{regularScriptLoad} --|] -+ regularScriptLoad = error "TODO" -+ -+ headAll = error "TODO" -+ let bodyScript = error "TODO" - - return $ PageContent title headAll (case jsLoader master of - BottomOfBody -> bodyScript -@@ -696,18 +610,7 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String - - -- | For use with setting 'jsLoader' to 'BottomOfHeadAsync' - loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master)) --loadJsYepnope eyn scripts mcomplete = -- [hamlet| --$newline never -- $maybe yn <- left eyn -- <script src=#{yn}> -- $maybe yn <- right eyn -- <script src=@{yn}> -- $maybe complete <- mcomplete -- <script>yepnope({load:#{jsonArray scripts},complete:function(){^{complete}}}); -- $nothing -- <script>yepnope({load:#{jsonArray scripts}}); --|] -+loadJsYepnope eyn scripts mcomplete = error "TODO" - - asyncHelper :: (url -> [x] -> Text) - -> [Script (url)] -diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs -index bd94bd3..bf79150 100644 ---- a/Yesod/Widget.hs -+++ b/Yesod/Widget.hs -@@ -15,8 +15,6 @@ module Yesod.Widget - GWidget - , PageContent (..) - -- * Special Hamlet quasiquoter/TH for Widgets -- , whamlet -- , whamletFile - , ihamletToRepHtml - -- * Convert to Widget - , ToWidget (..) -@@ -54,7 +52,6 @@ module Yesod.Widget - , addScriptEither - -- * Internal - , unGWidget -- , whamletFileWithSettings - ) where - - import Data.Monoid -@@ -274,32 +271,6 @@ data PageContent url = PageContent - , pageBody :: HtmlUrl url - } - --whamlet :: QuasiQuoter --whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings -- --whamletFile :: FilePath -> Q Exp --whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings -- --whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp --whamletFileWithSettings = NP.hamletFileWithSettings rules -- --rules :: Q NP.HamletRules --rules = do -- ah <- [|toWidget|] -- let helper qg f = do -- x <- newName "urender" -- e <- f $ VarE x -- let e' = LamE [VarP x] e -- g <- qg -- bind <- [|(>>=)|] -- return $ InfixE (Just g) bind (Just e') -- let ur f = do -- let env = NP.Env -- (Just $ helper [|liftW getUrlRenderParams|]) -- (Just $ helper [|liftM (toHtml .) $ liftW getMessageRender|]) -- f env -- return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b -- - -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. - ihamletToRepHtml :: RenderMessage master message - => HtmlUrlI18n message (Route master) --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/yesod-core_1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch b/standalone/android/haskell-patches/yesod-core_1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch deleted file mode 100644 index af0b3d15b..000000000 --- a/standalone/android/haskell-patches/yesod-core_1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch +++ /dev/null @@ -1,267 +0,0 @@ -From 9ae3db0b3292b53715232fecec3c5e2bf03b89cd Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Fri, 1 Mar 2013 01:02:53 -0400 -Subject: [PATCH 2/2] replaced TH in Yesod.Internal.Core - -Done by running a build with -ddump-splices and manually pasting in the -spliced code, and then modifying it until it compiles. - -(This predated the Evil Splicer, and both this and the previous patch need -to be redone to use it.) ---- - Yesod/Internal/Core.hs | 211 +++++++++++++++++++++++++++++++++++++++++++++--- - 1 file changed, 201 insertions(+), 10 deletions(-) - -diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs -index 90c05fc..b9a0ae8 100644 ---- a/Yesod/Internal/Core.hs -+++ b/Yesod/Internal/Core.hs -@@ -96,6 +96,9 @@ import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerP - import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource) - import System.Log.FastLogger.Date (ZonedDate) - import System.IO (stdout) -+import qualified Data.Foldable -+import qualified Text.Blaze.Internal -+import qualified Text.Hamlet - - yesodVersion :: String - yesodVersion = showVersion Paths_yesod_core.version -@@ -164,7 +167,28 @@ class RenderRoute a => Yesod a where - - -- | Applies some form of layout to the contents of a page. - defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml -- defaultLayout w = error "defaultLayout not implemented" -+ defaultLayout w = do -+ p <- widgetToPageContent w -+ mmsg <- getMessage -+ hamletToRepHtml $ \ _render_ay88 -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<!DOCTYPE html>\n<html><head><title>"); -+ id (TBH.toHtml (pageTitle p)); -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</title>"); -+ id (pageHead p) _render_ay88; -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</head><body>"); -+ Text.Hamlet.maybeH -+ mmsg -+ (\ msg_ay89 -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<p class=\"message\">"); -+ id (TBH.toHtml msg_ay89); -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }) -+ Nothing; -+ id (pageBody p) _render_ay88; -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</body></html>") } - - -- | Override the rendering function for a particular URL. One use case for - -- this is to offload static hosting to a different domain name to avoid -@@ -505,11 +529,45 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do - - -- | The default error handler for 'errorHandler'. - defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep --defaultErrorHandler NotFound = error "Not Found" --defaultErrorHandler (PermissionDenied msg) = error "Permission Denied" --defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments" --defaultErrorHandler (InternalError e) = error "Internal Server Error" --defaultErrorHandler (BadMethod m) = error "Bad Method" -+defaultErrorHandler NotFound = do -+ r <- waiRequest -+ let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r -+ applyLayout' "Not Found" $ \ _render_ayac -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<h1>Not Found</h1><p>"); -+ id (TBH.toHtml path'); -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") } -+defaultErrorHandler (PermissionDenied msg) = -+ applyLayout' "Permission Denied" $ \ _render_ayah -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<h1>Permission denied</h1><p>"); -+ id (TBH.toHtml msg); -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") } -+defaultErrorHandler (InvalidArgs ia) = -+ applyLayout' "Invalid Arguments" $ \ _render_ayam -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<h1>Invalid Arguments</h1><ul>"); -+ Data.Foldable.mapM_ -+ (\ msg_ayan -+ -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "<li>"); -+ id (TBH.toHtml msg_ayan); -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</li>") }) -+ ia; -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</ul>") } -+defaultErrorHandler (InternalError e) = do -+ applyLayout' "Internal Server Error" $ \ _render_ayau -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<h1>Internal Server Error</h1><pre>"); -+ id (TBH.toHtml e); -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</pre>") } -+defaultErrorHandler (BadMethod m) = -+ applyLayout' "Bad Method" $ \ _render_ayaz -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<h1>Method Not Supported</h1><p>Method <code>"); -+ id (TBH.toHtml (S8.unpack m)); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</code> not supported</p>") } - - -- | Return the same URL if the user is authorized to see it. - -- -@@ -565,10 +623,99 @@ widgetToPageContent w = do - -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing - -- the asynchronous loader means your page doesn't have to wait for all the js to load - let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc -- regularScriptLoad = error "TODO" -- -- headAll = error "TODO" -- let bodyScript = error "TODO" -+ regularScriptLoad = \ _render_aybs -> do { Data.Foldable.mapM_ -+ (\ s_aybt -+ -> id (mkScriptTag s_aybt) _render_aybs) -+ scripts; -+ Text.Hamlet.maybeH -+ jscript -+ (\ j_aybu -+ -> Text.Hamlet.maybeH -+ jsLoc -+ (\ s_aybv -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<script src=\""); -+ id (TBH.toHtml s_aybv); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "\"></script>") }) -+ (Just -+ (do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script>"); -+ id (jelper j_aybu) _render_aybs; -+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</script>") }))) -+ Nothing } -+ -+ headAll = \ _render_aybz -> do -+ { id head' _render_aybz; -+ Data.Foldable.mapM_ -+ (\ s_aybA -> id (mkLinkTag s_aybA) _render_aybz) -+ stylesheets; -+ Data.Foldable.mapM_ -+ (\ s_aybB -+ -> do { Text.Hamlet.maybeH -+ (right (snd s_aybB)) -+ (\ t_aybC -+ -> Text.Hamlet.maybeH -+ (fst s_aybB) -+ (\ media_aybD -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<link rel=\"stylesheet\" media=\""); -+ id (TBH.toHtml media_aybD); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "\" href=\""); -+ id (TBH.toHtml t_aybC); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "\">") }) -+ (Just -+ (do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<link rel=\"stylesheet\" href=\""); -+ id (TBH.toHtml t_aybC); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "\">") }))) -+ Nothing; -+ Text.Hamlet.maybeH -+ (left (snd s_aybB)) -+ (\ content_aybE -+ -> Text.Hamlet.maybeH -+ (fst s_aybB) -+ (\ media_aybF -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<style media=\""); -+ id (TBH.toHtml media_aybF); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "\">"); -+ id (TBH.toHtml content_aybE); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</style>") }) -+ (Just -+ (do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<style>"); -+ id (TBH.toHtml content_aybE); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</style>") }))) -+ Nothing }) -+ css; -+ case jsLoader master of -+ BottomOfBody -> return () -+ BottomOfHeadAsync asyncJsLoader -> id (asyncJsLoader asyncScripts mcomplete) _render_aybz -+ BottomOfHeadBlocking -> id regularScriptLoad _render_aybz -+ } -+ -+ let bodyScript = \ _render_aybL -> do { -+ id body _render_aybL; -+ id regularScriptLoad _render_aybL } - - return $ PageContent title headAll (case jsLoader master of - BottomOfBody -> bodyScript -@@ -611,6 +758,50 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String - -- | For use with setting 'jsLoader' to 'BottomOfHeadAsync' - loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master)) - loadJsYepnope eyn scripts mcomplete = error "TODO" -+{- -+ \ _render_aybU -+ -> do { Text.Hamlet.maybeH -+ (left eyn) -+ (\ yn_aybV -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script src=\""); -+ id (TBH.toHtml yn_aybV); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\"></script>") }) -+ Nothing; -+ Text.Hamlet.maybeH -+ (right eyn) -+ (\ yn_aybW -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script src=\""); -+ id -+ (TBH.toHtml -+ (\ u_aybX -> _render_aybU u_aybX [] yn_aybW)); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\"></script>") }) -+ Nothing; -+ Text.Hamlet.maybeH -+ mcomplete -+ (\ complete_aybY -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<script>yepnope({load:"); -+ id (TBH.toHtml (jsonArray scripts)); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ ",complete:function(){"); -+ id complete_aybY _render_aybU; -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "}});</script>") }) -+ (Just -+ (do { id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<script>yepnope({load:"); -+ id (TBH.toHtml (jsonArray scripts)); -+ id -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "});</script>") })) } -+-} - - asyncHelper :: (url -> [x] -> Text) - -> [Script (url)] --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/yesod-core_1.1.8_0003-exports-for-TH-splices.patch b/standalone/android/haskell-patches/yesod-core_1.1.8_0003-exports-for-TH-splices.patch deleted file mode 100644 index 440b57ac8..000000000 --- a/standalone/android/haskell-patches/yesod-core_1.1.8_0003-exports-for-TH-splices.patch +++ /dev/null @@ -1,26 +0,0 @@ -From b7e01a2fded6575678db234e1f2de1f104f11376 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 15:25:07 -0400 -Subject: [PATCH 3/3] exports for TH splices - ---- - Yesod/Widget.hs | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs -index bf79150..01ae294 100644 ---- a/Yesod/Widget.hs -+++ b/Yesod/Widget.hs -@@ -52,6 +52,9 @@ module Yesod.Widget - , addScriptEither - -- * Internal - , unGWidget -+ -+ -- used by TH code -+ , liftW - ) where - - import Data.Monoid --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/yesod-core_expand_TH.patch b/standalone/android/haskell-patches/yesod-core_expand_TH.patch new file mode 100644 index 000000000..9ea21f625 --- /dev/null +++ b/standalone/android/haskell-patches/yesod-core_expand_TH.patch @@ -0,0 +1,427 @@ +From 9e15d4af1f53c76a402ec1782e0306a4bee7eec7 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 04:03:56 +0000 +Subject: [PATCH] expad TH + +used EvilSplicer +Has to remove some logger TH splices which didn't come out. +--- + Yesod/Core.hs | 2 - + Yesod/Core/Class/Yesod.hs | 247 ++++++++++++++++++++++++++++++-------------- + Yesod/Core/Dispatch.hs | 7 -- + Yesod/Core/Handler.hs | 24 ++--- + Yesod/Core/Internal/Run.hs | 2 - + Yesod/Core/Widget.hs | 2 + + 6 files changed, 181 insertions(+), 103 deletions(-) + +diff --git a/Yesod/Core.hs b/Yesod/Core.hs +index 12e59d5..f1ff21c 100644 +--- a/Yesod/Core.hs ++++ b/Yesod/Core.hs +@@ -94,8 +94,6 @@ module Yesod.Core + , JavascriptUrl + , renderJavascriptUrl + -- ** Cassius/Lucius +- , cassius +- , lucius + , CssUrl + , renderCssUrl + ) where +diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs +index cf02a1a..3f1e88e 100644 +--- a/Yesod/Core/Class/Yesod.hs ++++ b/Yesod/Core/Class/Yesod.hs +@@ -9,6 +9,10 @@ import Yesod.Core.Content + import Yesod.Core.Handler + + import Yesod.Routes.Class ++import qualified Text.Blaze.Internal ++import qualified Control.Monad.Logger ++import qualified Text.Hamlet ++import qualified Data.Foldable + + import Blaze.ByteString.Builder (Builder) + import Blaze.ByteString.Builder.Char.Utf8 (fromText) +@@ -87,18 +91,27 @@ class RenderRoute site => Yesod site where + defaultLayout w = do + p <- widgetToPageContent w + mmsg <- getMessage +- giveUrlRenderer [hamlet| +- $newline never +- $doctype 5 +- <html> +- <head> +- <title>#{pageTitle p} +- ^{pageHead p} +- <body> +- $maybe msg <- mmsg +- <p .message>#{msg} +- ^{pageBody p} +- |] ++ giveUrlRenderer $ \ _render_aHra ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<!DOCTYPE html>\n<html><head><title>"); ++ id (TBH.toHtml (pageTitle p)); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</title>"); ++ Text.Hamlet.asHtmlUrl (pageHead p) _render_aHra; ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</head><body>"); ++ Text.Hamlet.maybeH ++ mmsg ++ (\ msg_aHrb ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<p class=\"message\">"); ++ id (TBH.toHtml msg_aHrb); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }) ++ Nothing; ++ Text.Hamlet.asHtmlUrl (pageBody p) _render_aHra; ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "</body></html>") } ++ + + -- | Override the rendering function for a particular URL. One use case for + -- this is to offload static hosting to a different domain name to avoid +@@ -356,45 +369,103 @@ widgetToPageContent w = do + -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing + -- the asynchronous loader means your page doesn't have to wait for all the js to load + let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc +- regularScriptLoad = [hamlet| +- $newline never +- $forall s <- scripts +- ^{mkScriptTag s} +- $maybe j <- jscript +- $maybe s <- jsLoc +- <script src="#{s}"> +- $nothing +- <script>^{jelper j} +- |] +- +- headAll = [hamlet| +- $newline never +- \^{head'} +- $forall s <- stylesheets +- ^{mkLinkTag s} +- $forall s <- css +- $maybe t <- right $ snd s +- $maybe media <- fst s +- <link rel=stylesheet media=#{media} href=#{t}> +- $nothing +- <link rel=stylesheet href=#{t}> +- $maybe content <- left $ snd s +- $maybe media <- fst s +- <style media=#{media}>#{content} +- $nothing +- <style>#{content} +- $case jsLoader master +- $of BottomOfBody +- $of BottomOfHeadAsync asyncJsLoader +- ^{asyncJsLoader asyncScripts mcomplete} +- $of BottomOfHeadBlocking +- ^{regularScriptLoad} +- |] +- let bodyScript = [hamlet| +- $newline never +- ^{body} +- ^{regularScriptLoad} +- |] ++ regularScriptLoad = \ _render_aHsO ++ -> do { Data.Foldable.mapM_ ++ (\ s_aHsP ++ -> Text.Hamlet.asHtmlUrl (mkScriptTag s_aHsP) _render_aHsO) ++ scripts; ++ Text.Hamlet.maybeH ++ jscript ++ (\ j_aHsQ ++ -> Text.Hamlet.maybeH ++ jsLoc ++ (\ s_aHsR ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<script src=\""); ++ id (TBH.toHtml s_aHsR); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\"></script>") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script>"); ++ Text.Hamlet.asHtmlUrl (jelper j_aHsQ) _render_aHsO; ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</script>") }))) ++ Nothing } ++ ++ ++ headAll = \ _render_aHsW ++ -> do { Text.Hamlet.asHtmlUrl head' _render_aHsW; ++ Data.Foldable.mapM_ ++ (\ s_aHsX -> Text.Hamlet.asHtmlUrl (mkLinkTag s_aHsX) _render_aHsW) ++ stylesheets; ++ Data.Foldable.mapM_ ++ (\ s_aHsY ++ -> do { Text.Hamlet.maybeH ++ (right (snd s_aHsY)) ++ (\ t_aHsZ ++ -> Text.Hamlet.maybeH ++ (fst s_aHsY) ++ (\ media_aHt0 ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<link rel=\"stylesheet\" media=\""); ++ id (TBH.toHtml media_aHt0); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\" href=\""); ++ id (TBH.toHtml t_aHsZ); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\">") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<link rel=\"stylesheet\" href=\""); ++ id (TBH.toHtml t_aHsZ); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\">") }))) ++ Nothing; ++ Text.Hamlet.maybeH ++ (left (snd s_aHsY)) ++ (\ content_aHt1 ++ -> Text.Hamlet.maybeH ++ (fst s_aHsY) ++ (\ media_aHt2 ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<style media=\""); ++ id (TBH.toHtml media_aHt2); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\">"); ++ id (TBH.toHtml content_aHt1); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "</style>") }) ++ (Just ++ (do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<style>"); ++ id (TBH.toHtml content_aHt1); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "</style>") }))) ++ Nothing }) ++ css; ++ case jsLoader master of { ++ BottomOfBody -> return () ++ ; BottomOfHeadAsync asyncJsLoader_aHt3 ++ -> Text.Hamlet.asHtmlUrl ++ (asyncJsLoader_aHt3 asyncScripts mcomplete) _render_aHsW ++ ; BottomOfHeadBlocking ++ -> Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHsW } } ++ ++ let bodyScript = \ _render_aHt8 -> do { Text.Hamlet.asHtmlUrl body _render_aHt8; ++ Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHt8 } ++ + + return $ PageContent title headAll $ + case jsLoader master of +@@ -424,10 +495,13 @@ defaultErrorHandler NotFound = selectRep $ do + r <- waiRequest + let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r + setTitle "Not Found" +- toWidget [hamlet| +- <h1>Not Found +- <p>#{path'} +- |] ++ toWidget $ \ _render_aHte ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Not Found</h1>\n<p>"); ++ id (TBH.toHtml path'); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") } ++ + provideRep $ return $ object ["message" .= ("Not Found" :: Text)] + + -- For API requests. +@@ -437,10 +511,11 @@ defaultErrorHandler NotFound = selectRep $ do + defaultErrorHandler NotAuthenticated = selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Not logged in" +- toWidget [hamlet| +- <h1>Not logged in +- <p style="display:none;">Set the authRoute and the user will be redirected there. +- |] ++ toWidget $ \ _render_aHti ++ -> id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Not logged in</h1>\n<p style=\"none;\">Set the authRoute and the user will be redirected there.</p>") ++ + + provideRep $ do + -- 401 *MUST* include a WWW-Authenticate header +@@ -462,10 +537,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do + defaultErrorHandler (PermissionDenied msg) = selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Permission Denied" +- toWidget [hamlet| +- <h1>Permission denied +- <p>#{msg} +- |] ++ toWidget $ \ _render_aHtq ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Permission denied</h1>\n<p>"); ++ id (TBH.toHtml msg); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") } ++ + provideRep $ + return $ object $ [ + "message" .= ("Permission Denied. " <> msg) +@@ -474,30 +552,43 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do + defaultErrorHandler (InvalidArgs ia) = selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Invalid Arguments" +- toWidget [hamlet| +- <h1>Invalid Arguments +- <ul> +- $forall msg <- ia +- <li>#{msg} +- |] ++ toWidget $ \ _render_aHtv ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Invalid Arguments</h1>\n<ul>"); ++ Data.Foldable.mapM_ ++ (\ msg_aHtw ++ -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "<li>"); ++ id (TBH.toHtml msg_aHtw); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</li>") }) ++ ia; ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</ul>") } ++ + provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia] + defaultErrorHandler (InternalError e) = do +- $logErrorS "yesod-core" e + selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Internal Server Error" +- toWidget [hamlet| +- <h1>Internal Server Error +- <pre>#{e} +- |] ++ toWidget $ \ _render_aHtC ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Internal Server Error</h1>\n<pre>"); ++ id (TBH.toHtml e); ++ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</pre>") } ++ + provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e] + defaultErrorHandler (BadMethod m) = selectRep $ do + provideRep $ defaultLayout $ do + setTitle"Bad Method" +- toWidget [hamlet| +- <h1>Method Not Supported +- <p>Method <code>#{S8.unpack m}</code> not supported +- |] ++ toWidget $ \ _render_aHtH ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<h1>Method Not Supported</h1>\n<p>Method <code>"); ++ id (TBH.toHtml (S8.unpack m)); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "</code> not supported</p>") } ++ + provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= m] + + asyncHelper :: (url -> [x] -> Text) +diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs +index 335a15c..4ca05da 100644 +--- a/Yesod/Core/Dispatch.hs ++++ b/Yesod/Core/Dispatch.hs +@@ -123,13 +123,6 @@ toWaiApp site = do + , yreSite = site + , yreSessionBackend = sb + } +- messageLoggerSource +- site +- logger +- $(qLocation >>= liftLoc) +- "yesod-core" +- LevelInfo +- (toLogStr ("Application launched" :: S.ByteString)) + middleware <- mkDefaultMiddlewares logger + return $ middleware $ toWaiAppYre yre + +diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs +index f3b1799..d819b04 100644 +--- a/Yesod/Core/Handler.hs ++++ b/Yesod/Core/Handler.hs +@@ -152,7 +152,7 @@ import qualified Control.Monad.Trans.Writer as Writer + + import Control.Monad.IO.Class (MonadIO, liftIO) + import Control.Monad.Trans.Resource (MonadResource, liftResourceT) +- ++import qualified Text.Blaze.Internal + import qualified Network.HTTP.Types as H + import qualified Network.Wai as W + import Control.Monad.Trans.Class (lift) +@@ -710,19 +710,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) + -> m a + redirectToPost url = do + urlText <- toTextUrl url +- giveUrlRenderer [hamlet| +-$newline never +-$doctype 5 +- +-<html> +- <head> +- <title>Redirecting... +- <body onload="document.getElementById('form').submit()"> +- <form id="form" method="post" action=#{urlText}> +- <noscript> +- <p>Javascript has been disabled; please click on the button below to be redirected. +- <input type="submit" value="Continue"> +-|] >>= sendResponse ++ giveUrlRenderer $ \ _render_awps ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "<!DOCTYPE html>\n<html><head><title>Redirecting...</title></head><body onload=\"document.getElementById('form').submit()\"><form id=\"form\" method=\"post\" action=\""); ++ id (toHtml urlText); ++ id ++ ((Text.Blaze.Internal.preEscapedText . T.pack) ++ "\"><noscript><p>Javascript has been disabled; please click on the button below to be redirected.</p></noscript><input type=\"submit\" value=\"Continue\"></form></body></html>") } ++ >>= sendResponse + + -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. + hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html +diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs +index 35f1d3f..8b92e99 100644 +--- a/Yesod/Core/Internal/Run.hs ++++ b/Yesod/Core/Internal/Run.hs +@@ -122,8 +122,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + -> ErrorResponse + -> YesodApp + safeEh log' er req = do +- liftIO $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError +- $ toLogStr $ "Error handler errored out: " ++ show er + return $ YRPlain + H.status500 + [] +diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs +index be97764..874f018 100644 +--- a/Yesod/Core/Widget.hs ++++ b/Yesod/Core/Widget.hs +@@ -47,6 +47,8 @@ module Yesod.Core.Widget + , handlerToWidget + -- * Internal + , whamletFileWithSettings ++ -- used by TH ++ , asWidgetT + ) where + + import Data.Monoid +-- +1.7.10.4 + 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-form_1.2.1.1-0001-prepare-for-Evil-Splicer.patch b/standalone/android/haskell-patches/yesod-form_1.2.1.1-0001-prepare-for-Evil-Splicer.patch deleted file mode 100644 index c24055b1f..000000000 --- a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0001-prepare-for-Evil-Splicer.patch +++ /dev/null @@ -1,83 +0,0 @@ -From a603bac40f0a0f6232fbfb056a778860270101de Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 15:59:56 -0400 -Subject: [PATCH 1/2] prepare for Evil Splicer - ---- - Yesod/Form/Functions.hs | 3 +-- - evilsplicer-headers.hs | 9 +++++++++ - yesod-form.cabal | 5 +++-- - 3 files changed, 13 insertions(+), 4 deletions(-) - create mode 100644 evilsplicer-headers.hs - -diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs -index db3e493..89eb1e8 100644 ---- a/Yesod/Form/Functions.hs -+++ b/Yesod/Form/Functions.hs -@@ -54,10 +54,9 @@ import Text.Blaze (Markup, toMarkup) - #define toHtml toMarkup - import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod) - import Yesod.Core (RenderMessage, SomeMessage (..)) --import Yesod.Widget (GWidget, whamlet) -+import Yesod.Widget (GWidget) - import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages) - import Network.Wai (requestMethod) --import Text.Hamlet (shamlet) - import Data.Monoid (mempty) - import Data.Maybe (listToMaybe, fromMaybe) - import Yesod.Message (RenderMessage (..)) -diff --git a/evilsplicer-headers.hs b/evilsplicer-headers.hs -new file mode 100644 -index 0000000..865d043 ---- /dev/null -+++ b/evilsplicer-headers.hs -@@ -0,0 +1,9 @@ -+import qualified Data.Text.Lazy.Builder -+import qualified Text.Shakespeare -+import qualified Text.Hamlet -+import qualified Data.Monoid -+import qualified Text.Julius -+import qualified "blaze-markup" Text.Blaze.Internal -+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Markup -+import qualified Yesod.Widget -+import qualified Data.Foldable -diff --git a/yesod-form.cabal b/yesod-form.cabal -index a0d2a80..ae99ddc 100644 ---- a/yesod-form.cabal -+++ b/yesod-form.cabal -@@ -18,7 +18,7 @@ library - , yesod-persistent >= 1.1 && < 1.2 - , time >= 1.1.4 - , hamlet >= 1.1 && < 1.2 -- , shakespeare-css >= 1.0 && < 1.1 -+ , shakespeare-css == 1.0.2 - , shakespeare-js >= 1.0.2 && < 1.2 - , persistent >= 1.0 && < 1.2 - , template-haskell -@@ -37,6 +37,7 @@ library - , attoparsec >= 0.10 && < 0.11 - , crypto-api >= 0.8 && < 0.11 - , aeson -+ , shakespeare - - exposed-modules: Yesod.Form - Yesod.Form.Class -@@ -45,7 +46,6 @@ library - Yesod.Form.Input - Yesod.Form.Fields - Yesod.Form.Jquery -- Yesod.Form.Nic - Yesod.Form.MassInput - Yesod.Form.I18n.English - Yesod.Form.I18n.Portuguese -@@ -56,6 +56,7 @@ library - Yesod.Form.I18n.Japanese
- -- FIXME Yesod.Helpers.Crud - ghc-options: -Wall -+ Extensions: PackageImports - - test-suite test - type: exitcode-stdio-1.0 --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0002-expand-TH.patch b/standalone/android/haskell-patches/yesod-form_1.2.1.1-0002-expand-TH.patch deleted file mode 100644 index 3ce48e5fc..000000000 --- a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0002-expand-TH.patch +++ /dev/null @@ -1,1606 +0,0 @@ -From f98c22ec71695537e0e008a0bd54affdf8a60f64 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 17:35:57 -0400 -Subject: [PATCH 2/2] expand TH - -Used the EvilSplicer, and then some manual fixups, as it is apparently -buggy. Also a few module import fixes. ---- - Yesod/Form/Fields.hs | 623 ++++++++++++++++++++++++++++++++++++++---------- - Yesod/Form/Functions.hs | 240 +++++++++++++++---- - Yesod/Form/Jquery.hs | 141 ++++++++--- - Yesod/Form/MassInput.hs | 228 ++++++++++++++---- - Yesod/Form/Nic.hs | 59 ++++- - 5 files changed, 1042 insertions(+), 249 deletions(-) - -diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs -index 7917ce2..db76ea2 100644 ---- a/Yesod/Form/Fields.hs -+++ b/Yesod/Form/Fields.hs -@@ -46,11 +46,22 @@ module Yesod.Form.Fields - , optionsEnum - ) where - -+import qualified Data.Text.Lazy.Builder -+import qualified Text.Shakespeare -+import qualified Data.Monoid -+import qualified Text.Julius -+import qualified "blaze-markup" Text.Blaze.Internal -+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Internal -+import qualified "blaze-html" Text.Blaze.Html -+import qualified Yesod.Widget -+import qualified Text.Css -+import qualified Control.Monad -+import qualified Data.Foldable - import Yesod.Form.Types - import Yesod.Form.I18n.English - import Yesod.Form.Functions (parseHelper) - import Yesod.Handler (getMessageRender) --import Yesod.Widget (toWidget, whamlet, GWidget) -+import Yesod.Widget (toWidget, GWidget) - import Yesod.Message (RenderMessage (renderMessage), SomeMessage (..)) - import Text.Hamlet - import Text.Blaze (ToMarkup (toMarkup), preEscapedToMarkup, unsafeByteString) -@@ -108,10 +119,24 @@ intField = Field - Right (a, "") -> Right a - _ -> Left $ MsgInvalidInteger s - -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amMY -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"number\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where -@@ -125,10 +150,24 @@ doubleField = Field - Right (a, "") -> Right a - _ -> Left $ MsgInvalidNumber s - -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNa -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where showVal = either id (pack . show) -@@ -136,10 +175,24 @@ $newline never - dayField :: RenderMessage master FormMessage => Field sub master Day - dayField = Field - { fieldParse = parseHelper $ parseDate . unpack -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNk -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where showVal = either id (pack . show) -@@ -147,10 +200,23 @@ $newline never - timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay - timeField = Field - { fieldParse = parseHelper parseTime -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNx -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where -@@ -163,10 +229,18 @@ $newline never - htmlField :: RenderMessage master FormMessage => Field sub master Html - htmlField = Field - { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance -- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| --$newline never --<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val} --|] -+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_amNH -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } -+ - , fieldEnctype = UrlEncoded - } - where showVal = either id (pack . renderHtml) -@@ -192,10 +266,18 @@ instance ToHtml Textarea where - textareaField :: RenderMessage master FormMessage => Field sub master Textarea - textareaField = Field - { fieldParse = parseHelper $ Right . Textarea -- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| --$newline never --<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val} --|] -+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_amNQ -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ id (Text.Blaze.Html.toHtml (either id unTextarea val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -203,10 +285,19 @@ hiddenField :: (PathPiece p, RenderMessage master FormMessage) - => Field sub master p - hiddenField = Field - { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece -- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| --$newline never --<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}"> --|] -+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_amNZ -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"hidden\" id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ id (Text.Blaze.Html.toHtml (either id toPathPiece val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -214,20 +305,50 @@ textField :: RenderMessage master FormMessage => Field sub master Text - textField = Field - { fieldParse = parseHelper $ Right - , fieldView = \theId name attrs val isReq -> -- [whamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}"> --|] -+ do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); -+ Text.Hamlet.condH -+ [(isReq, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ toWidget (Text.Blaze.Html.toHtml (either id id val)); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - - passwordField :: RenderMessage master FormMessage => Field sub master Text - passwordField = Field - { fieldParse = parseHelper $ Right -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amOg -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" type=\"password\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (either id id val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -305,10 +426,24 @@ emailField = Field - then Right s - else Left $ MsgInvalidEmail s - #endif -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amOO -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"email\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (either id id val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -317,20 +452,60 @@ searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master - searchField autoFocus = Field - { fieldParse = parseHelper Right - , fieldView = \theId name attrs val isReq -> do -- [whamlet|\ --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}"> --|] -+ do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\""); -+ Text.Hamlet.condH -+ [(isReq, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ Text.Hamlet.condH -+ [(autoFocus, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ toWidget (Text.Blaze.Html.toHtml (either id id val)); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - when autoFocus $ do - -- we want this javascript to be placed immediately after the field -- [whamlet| --$newline never --<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();} --|] -- toWidget [cassius| -- #{theId} -- -webkit-appearance: textfield -- |] -+ do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('"); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "').focus();}</script>") } -+ -+ toWidget $ \ _render_amP5 -+ -> (Text.Css.CssNoWhitespace -+ . (foldr ($) [])) -+ [((++) -+ $ (map -+ Text.Css.Css -+ ((((:) -+ (Text.Css.Css' -+ (Data.Monoid.mconcat [toCss theId]) -+ [(Data.Monoid.mconcat -+ [(Text.Css.fromText -+ . Text.Css.pack) -+ "-webkit-appearance"], -+ Data.Monoid.mconcat -+ [(Text.Css.fromText -+ . Text.Css.pack) -+ "textfield"])])) -+ . (foldr (.) id [])) -+ [])))] -+ - , fieldEnctype = UrlEncoded - } - -@@ -341,10 +516,25 @@ urlField = Field - Nothing -> Left $ MsgInvalidUrl s - Just _ -> Right s - , fieldView = \theId name attrs val isReq -> -- [whamlet| --$newline never --<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}> --|] -+ do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\""); -+ Text.Hamlet.condH -+ [(isReq, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ toWidget (Text.Blaze.Html.toHtml (either id id val)); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -353,18 +543,48 @@ selectFieldList = selectField . optionsPairs - - selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a - selectField = selectFieldHelper -- (\theId name attrs inside -> [whamlet| --$newline never --<select ##{theId} name=#{name} *{attrs}>^{inside} --|]) -- outside -- (\_theId _name isSel -> [whamlet| --$newline never --<option value=none :isSel:selected>_{MsgSelectNone} --|]) -- onOpt -- (\_theId _name _attrs value isSel text -> [whamlet| --$newline never --<option value=#{value} :isSel:selected>#{text} --|]) -- inside -+ (\theId name attrs inside -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ toWidget inside; -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }) -+ -- outside -+ (\_theId _name isSel -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<option value=\"none\""); -+ Text.Hamlet.condH -+ [(isSel, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .)) -+ $ (Yesod.Widget.liftW getMessageRender)) -+ >>= (\ urender_amPs -> toWidget (urender_amPs MsgSelectNone))); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) -+ -- onOpt -+ (\_theId _name _attrs value isSel text -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); -+ toWidget (Text.Blaze.Html.toHtml value); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ Text.Hamlet.condH -+ [(isSel, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ toWidget (Text.Blaze.Html.toHtml text); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) -+ -- inside - - multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a] - multiSelectFieldList = multiSelectField . optionsPairs -@@ -385,12 +605,40 @@ multiSelectField ioptlist = - view theId name attrs val isReq = do - opts <- fmap olOptions $ lift ioptlist - let selOpts = map (id &&& (optselected val)) opts -- [whamlet| --$newline never -- <select ##{theId} name=#{name} :isReq:required multiple *{attrs}> -- $forall (opt, optsel) <- selOpts -- <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt} -- |] -+ do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ Text.Hamlet.condH -+ [(isReq, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " multiple"); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ Data.Foldable.mapM_ -+ (\ (opt_amPV, optsel_amPW) -+ -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); -+ toWidget (Text.Blaze.Html.toHtml (optionExternalValue opt_amPV)); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ Text.Hamlet.condH -+ [(optsel_amPW, -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ toWidget (Text.Blaze.Html.toHtml (optionDisplay opt_amPV)); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) -+ selOpts; -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") } -+ - where - optselected (Left _) _ = False - optselected (Right vals) opt = (optionInternalValue opt) `elem` vals -@@ -400,41 +648,140 @@ radioFieldList = radioField . optionsPairs - - radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a - radioField = selectFieldHelper -- (\theId _name _attrs inside -> [whamlet| --$newline never --<div ##{theId}>^{inside} --|]) -- (\theId name isSel -> [whamlet| --$newline never --<label .radio for=#{theId}-none> -- <div> -- <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked> -- _{MsgSelectNone} --|]) -- (\theId name attrs value isSel text -> [whamlet| --$newline never --<label .radio for=#{theId}-#{value}> -- <div> -- <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}> -- \#{text} --|]) -+ (\theId _name _attrs inside -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ toWidget inside; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ -+ (\theId name isSel -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<label class=\"radio\" for=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-none\"><div><input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-none\" type=\"radio\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\""); -+ Text.Hamlet.condH -+ [(isSel, -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .)) -+ $ (Yesod.Widget.liftW getMessageRender)) -+ >>= (\ urender_amQa -> toWidget (urender_amQa MsgSelectNone))); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) -+ -+ (\theId name attrs value isSel text -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<label class=\"radio\" for=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-"); -+ toWidget (Text.Blaze.Html.toHtml value); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\"><div><input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-"); -+ toWidget (Text.Blaze.Html.toHtml value); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" type=\"radio\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ toWidget (Text.Blaze.Html.toHtml value); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ Text.Hamlet.condH -+ [(isSel, -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ toWidget (Text.Blaze.Html.toHtml text); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) -+ - - boolField :: RenderMessage master FormMessage => Field sub master Bool - boolField = Field - { fieldParse = \e _ -> return $ boolParser e -- , fieldView = \theId name attrs val isReq -> [whamlet| --$newline never -- $if not isReq -- <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked> -- <label for=#{theId}-none>_{MsgSelectNone} -- -+ , fieldView = \theId name attrs val isReq -> do { Text.Hamlet.condH -+ [(not isReq, -+ do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-none\" type=\"radio\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" value=\"none\" checked"); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-none\">"); -+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .)) -+ $ (Yesod.Widget.liftW getMessageRender)) -+ >>= (\ urender_amQx -> toWidget (urender_amQx MsgSelectNone))); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] -+ Nothing; -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-yes\" type=\"radio\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\""); -+ Text.Hamlet.condH -+ [(showVal id val, -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">"); -+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .)) -+ $ (Yesod.Widget.liftW getMessageRender)) -+ >>= (\ urender_amQy -> toWidget (urender_amQy MsgBoolYes))); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "</label><input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-no\" type=\"radio\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\""); -+ Text.Hamlet.condH -+ [(showVal not val, -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-no\">"); -+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .)) -+ $ (Yesod.Widget.liftW getMessageRender)) -+ >>= (\ urender_amQz -> toWidget (urender_amQz MsgBoolNo))); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "</label>") } - --<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked> --<label for=#{theId}-yes>_{MsgBoolYes} -- --<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked> --<label for=#{theId}-no>_{MsgBoolNo} --|] - , fieldEnctype = UrlEncoded - } - where -@@ -458,10 +805,22 @@ $newline never - checkBoxField :: RenderMessage m FormMessage => Field s m Bool - checkBoxField = Field - { fieldParse = \e _ -> return $ checkBoxParser e -- , fieldView = \theId name attrs val _ -> [whamlet| --$newline never --<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked> --|] -+ , fieldView = \theId name attrs val _ -> do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ toWidget (Text.Blaze.Html.toHtml theId); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" type=\"checkbox\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\""); -+ Text.Hamlet.condH -+ [(showVal id val, -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -566,9 +925,21 @@ fileField = Field - case files of - [] -> Right Nothing - file:_ -> Right $ Just file -- , fieldView = \id' name attrs _ isReq -> toWidget [hamlet| -- <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required> -- |] -+ , fieldView = \id' name attrs _ isReq -> toWidget $ \ _render_amRu -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml id'); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"file\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = Multipart - } - -@@ -594,10 +965,16 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do - { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs - , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs - , fvId = id' -- , fvInput = [whamlet| --$newline never --<input type=file name=#{name} ##{id'} *{fsAttrs fs}> --|] -+ , fvInput = do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"file\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\""); -+ toWidget (Text.Blaze.Html.toHtml id'); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs)); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fvErrors = errs - , fvRequired = True - } -@@ -623,10 +1000,16 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do - { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs - , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs - , fvId = id' -- , fvInput = [whamlet| --$newline never --<input type=file name=#{name} ##{id'} *{fsAttrs fs}> --|] -+ , fvInput = do { toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"file\" name=\""); -+ toWidget (Text.Blaze.Html.toHtml name); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\""); -+ toWidget (Text.Blaze.Html.toHtml id'); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs)); -+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fvErrors = errs - , fvRequired = False - } -diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs -index 89eb1e8..54974bb 100644 ---- a/Yesod/Form/Functions.hs -+++ b/Yesod/Form/Functions.hs -@@ -42,6 +42,15 @@ module Yesod.Form.Functions - , parseHelper - ) where - -+import qualified Data.Text.Lazy.Builder -+import qualified Text.Shakespeare -+import qualified Data.Monoid -+import qualified Text.Julius -+import qualified "blaze-markup" Text.Blaze.Internal -+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Markup -+import qualified Yesod.Widget -+import qualified Data.Foldable -+import qualified Text.Hamlet - import Yesod.Form.Types - import Data.Text (Text, pack) - import Control.Arrow (second) -@@ -191,10 +200,13 @@ postHelper form env = do - let token = - case reqToken req of - Nothing -> mempty -- Just n -> [shamlet| --$newline never --<input type=hidden name=#{tokenKey} value=#{n}> --|] -+ Just n -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"hidden\" name=\""); -+ id (Text.Blaze.Html.toHtml tokenKey); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ id (Text.Blaze.Html.toHtml n); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") } - m <- getYesod - langs <- languages - ((res, xml), enctype) <- runFormGeneric (form token) m langs env -@@ -253,10 +265,11 @@ getKey = "_hasdata" - - getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype) - getHelper form env = do -- let fragment = [shamlet| --$newline never --<input type=hidden name=#{getKey}> --|] -+ let fragment = do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"hidden\" name=\""); -+ id (Text.Blaze.Html.toHtml getKey); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") } - langs <- languages - m <- getYesod - runFormGeneric (form fragment) m langs env -@@ -270,19 +283,64 @@ renderTable, renderDivs, renderDivsNoLabels :: FormRender sub master a - renderTable aform fragment = do - (res, views') <- aFormToForm aform - let views = views' [] -- let widget = [whamlet| --$newline never --\#{fragment} --$forall view <- views -- <tr :fvRequired view:.required :not $ fvRequired view:.optional> -- <td> -- <label for=#{fvId view}>#{fvLabel view} -- $maybe tt <- fvTooltip view -- <div .tooltip>#{tt} -- <td>^{fvInput view} -- $maybe err <- fvErrors view -- <td .errors>#{err} --|] -+ let widget = do { Yesod.Widget.toWidget (Text.Blaze.Html.toHtml fragment); -+ Data.Foldable.mapM_ -+ (\ view_a9GR -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<tr"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_a9GR, not (fvRequired view_a9GR)], -+ do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_a9GR, -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_a9GR), -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "><td><label for=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_a9GR)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_a9GR)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>"); -+ Text.Hamlet.maybeH -+ (fvTooltip view_a9GR) -+ (\ tt_a9GS -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"tooltip\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_a9GS); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>"); -+ Yesod.Widget.toWidget (fvInput view_a9GR); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>"); -+ Text.Hamlet.maybeH -+ (fvErrors view_a9GR) -+ (\ err_a9GT -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<td class=\"errors\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_a9GT); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") }) -+ views } - return (res, widget) - - -- | render a field inside a div -@@ -295,19 +353,65 @@ renderDivsMaybeLabels :: Bool -> FormRender sub master a - renderDivsMaybeLabels withLabels aform fragment = do - (res, views') <- aFormToForm aform - let views = views' [] -- let widget = [whamlet| --$newline never --\#{fragment} --$forall view <- views -- <div :fvRequired view:.required :not $ fvRequired view:.optional> -- $if withLabels -- <label for=#{fvId view}>#{fvLabel view} -- $maybe tt <- fvTooltip view -- <div .tooltip>#{tt} -- ^{fvInput view} -- $maybe err <- fvErrors view -- <div .errors>#{err} --|] -+ let widget = do { Yesod.Widget.toWidget (Text.Blaze.Html.toHtml fragment); -+ Data.Foldable.mapM_ -+ (\ view_a9Hr -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<div"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_a9Hr, not (fvRequired view_a9Hr)], -+ do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_a9Hr, -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_a9Hr), -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ Text.Hamlet.condH -+ [(withLabels, -+ do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_a9Hr)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_a9Hr)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] -+ Nothing; -+ Text.Hamlet.maybeH -+ (fvTooltip view_a9Hr) -+ (\ tt_a9Hs -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"tooltip\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_a9Hs); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ Nothing; -+ Yesod.Widget.toWidget (fvInput view_a9Hr); -+ Text.Hamlet.maybeH -+ (fvErrors view_a9Hr) -+ (\ err_a9Ht -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"errors\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_a9Ht); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ views } - return (res, widget) - - -- | Render a form using Bootstrap-friendly shamlet syntax. -@@ -331,19 +435,61 @@ renderBootstrap aform fragment = do - let views = views' [] - has (Just _) = True - has Nothing = False -- let widget = [whamlet| --$newline never --\#{fragment} --$forall view <- views -- <div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error> -- <label .control-label for=#{fvId view}>#{fvLabel view} -- <div .controls .input> -- ^{fvInput view} -- $maybe tt <- fvTooltip view -- <span .help-block>#{tt} -- $maybe err <- fvErrors view -- <span .help-block>#{err} --|] -+ let widget = do { Yesod.Widget.toWidget (Text.Blaze.Html.toHtml fragment); -+ Data.Foldable.mapM_ -+ (\ view_a9HE -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"control-group clearfix "); -+ Text.Hamlet.condH -+ [(fvRequired view_a9HE, -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_a9HE), -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "optional "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(has (fvErrors view_a9HE), -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "error"))] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\"><label class=\"control-label\" for=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_a9HE)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_a9HE)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "</label><div class=\"controls input\">"); -+ Yesod.Widget.toWidget (fvInput view_a9HE); -+ Text.Hamlet.maybeH -+ (fvTooltip view_a9HE) -+ (\ tt_a9HF -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<span class=\"help-block\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_a9HF); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) -+ Nothing; -+ Text.Hamlet.maybeH -+ (fvErrors view_a9HE) -+ (\ err_a9HG -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<span class=\"help-block\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_a9HG); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") }) -+ views } - return (res, widget) - - check :: RenderMessage master msg -diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs -index 85a0c76..70ac315 100644 ---- a/Yesod/Form/Jquery.hs -+++ b/Yesod/Form/Jquery.hs -@@ -12,14 +12,22 @@ module Yesod.Form.Jquery - , Default (..) - ) where - -+import qualified Data.Text.Lazy.Builder -+import qualified Text.Shakespeare -+import qualified Data.Monoid -+import qualified Text.Julius -+import qualified "blaze-markup" Text.Blaze.Internal -+import qualified "blaze-html" Text.Blaze.Html -+import qualified Yesod.Widget -+import qualified Text.Hamlet -+import qualified Text.Julius - import Yesod.Handler - import Yesod.Core (Route) - import Yesod.Form - import Yesod.Widget - import Data.Time (Day) - import Data.Default --import Text.Hamlet (shamlet) --import Text.Julius (julius, rawJS) -+import Text.Julius (rawJS) - import Data.Text (Text, pack, unpack) - import Data.Monoid (mconcat) - import Yesod.Core (RenderMessage) -@@ -64,27 +72,75 @@ jqueryDayField jds = Field - . readMay - . unpack - , fieldView = \theId name attrs val isReq -> do -- toWidget [shamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}"> --|] -+ toWidget $ do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - addScript' urlJqueryJs - addScript' urlJqueryUiJs - addStylesheet' urlJqueryUiCss -- toWidget [julius| --$(function(){ -- var i = document.getElementById("#{rawJS theId}"); -- if (i.type != "date") { -- $(i).datepicker({ -- dateFormat:'yy-mm-dd', -- changeMonth:#{jsBool $ jdsChangeMonth jds}, -- changeYear:#{jsBool $ jdsChangeYear jds}, -- numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds}, -- yearRange:#{toJSON $ jdsYearRange jds} -- }); -- } --}); --|] -+ toWidget $ Text.Julius.asJavascriptUrl -+ (\ _render_a1esc -+ -> mconcat -+ [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\ -+ \$(function(){\ -+ \ var i = document.getElementById(\""), -+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\");\ -+ \ if (i.type != \"date\") {\ -+ \ $(i).datepicker({\ -+ \ 'yy-mm-dd',\ -+ \ changeMonth:"), -+ Text.Julius.Javascript -+ (Text.Julius.toJavascript (jsBool (jdsChangeMonth jds))), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ ",\ -+ \ changeYear:"), -+ Text.Julius.Javascript -+ (Text.Julius.toJavascript (jsBool (jdsChangeYear jds))), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ ",\ -+ \ numberOfMonths:"), -+ Text.Julius.Javascript -+ (Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds)))), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ ",\ -+ \ yearRange:"), -+ Text.Julius.Javascript -+ (Text.Julius.toJavascript (toJSON (jdsYearRange jds))), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\ -+ \ });\ -+ \ }\ -+ \});")]) -+ - , fieldEnctype = UrlEncoded - } - where -@@ -105,16 +161,47 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master - jqueryAutocompleteField src = Field - { fieldParse = parseHelper $ Right - , fieldView = \theId name attrs val isReq -> do -- toWidget [shamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete> --|] -+ toWidget $ do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input class=\"autocomplete\" id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (Text.Blaze.Html.toHtml (either id id val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - addScript' urlJqueryJs - addScript' urlJqueryUiJs - addStylesheet' urlJqueryUiCss -- toWidget [julius| --$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})}); --|] -+ toWidget $ Text.Julius.asJavascriptUrl -+ (\ _render_a1esq -+ -> mconcat -+ [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\ -+ \$(function(){$(\"#"), -+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\").autocomplete({source:\""), -+ Text.Julius.Javascript -+ (Data.Text.Lazy.Builder.fromText (_render_a1esq src [])), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\",2})});")]) -+ - , fieldEnctype = UrlEncoded - } - -diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs -index 62e89d6..22fdad5 100644 ---- a/Yesod/Form/MassInput.hs -+++ b/Yesod/Form/MassInput.hs -@@ -9,10 +9,20 @@ module Yesod.Form.MassInput - , massTable - ) where - -+import qualified Data.Text.Lazy.Builder -+import qualified Text.Shakespeare -+import qualified Data.Monoid -+import qualified Text.Julius -+import qualified "blaze-markup" Text.Blaze.Internal -+import qualified "blaze-html" Text.Blaze.Html -+import qualified Yesod.Widget -+import qualified Data.Text -+import qualified Text.Hamlet -+import qualified Data.Foldable - import Yesod.Form.Types - import Yesod.Form.Functions - import Yesod.Form.Fields (boolField) --import Yesod.Widget (GWidget, whamlet) -+import Yesod.Widget (GWidget) - import Yesod.Message (RenderMessage) - import Yesod.Handler (newIdent, GHandler) - import Text.Blaze.Html (Html) -@@ -75,16 +85,27 @@ inputList label fixXml single mdef = formToAForm $ do - { fvLabel = label - , fvTooltip = Nothing - , fvId = theId -- , fvInput = [whamlet| --$newline never --^{fixXml views} --<p> -- $forall xml <- xmls -- ^{xml} -- <input .count type=hidden name=#{countName} value=#{count}> -- <input type=checkbox name=#{addName}> -- Add another row --|] -+ , fvInput = do { Yesod.Widget.toWidget (fixXml views); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>"); -+ Data.Foldable.mapM_ -+ (\ xml_aOR7 -> Yesod.Widget.toWidget xml_aOR7) xmls; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<input class=\"count\" type=\"hidden\" name=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml countName); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\" value=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml count); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\"><input type=\"checkbox\" name=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml addName); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\">Add another row</p>") } -+ - , fvErrors = Nothing - , fvRequired = False - }]) -@@ -97,10 +118,14 @@ withDelete af = do - deleteName <- newFormIdent - (menv, _, _) <- ask - res <- case menv >>= Map.lookup deleteName . fst of -- Just ("yes":_) -> return $ Left [whamlet| --$newline never --<input type=hidden name=#{deleteName} value=yes> --|] -+ Just ("yes":_) -> return $ Left $ do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<input type=\"hidden\" name=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml deleteName); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\" value=\"yes\">") } -+ - _ -> do - (_, xml2) <- aFormToForm $ areq boolField FieldSettings - { fsLabel = SomeMessage MsgDelete -@@ -126,32 +151,149 @@ fixme eithers = - massDivs, massTable - :: [[FieldView sub master]] - -> GWidget sub master () --massDivs viewss = [whamlet| --$newline never --$forall views <- viewss -- <fieldset> -- $forall view <- views -- <div :fvRequired view:.required :not $ fvRequired view:.optional> -- <label for=#{fvId view}>#{fvLabel view} -- $maybe tt <- fvTooltip view -- <div .tooltip>#{tt} -- ^{fvInput view} -- $maybe err <- fvErrors view -- <div .errors>#{err} --|] -+massDivs viewss = Data.Foldable.mapM_ -+ (\ views_aORq -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<fieldset>"); -+ Data.Foldable.mapM_ -+ (\ view_aORr -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_aORr, not (fvRequired view_aORr)], -+ do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_aORr, -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_aORr), -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "optional"))] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\"") })] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "><label for=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_aORr)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_aORr)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); -+ Text.Hamlet.maybeH -+ (fvTooltip view_aORr) -+ (\ tt_aORs -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<div class=\"tooltip\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_aORs); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</div>") }) -+ Nothing; -+ Yesod.Widget.toWidget (fvInput view_aORr); -+ Text.Hamlet.maybeH -+ (fvErrors view_aORr) -+ (\ err_aORt -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<div class=\"errors\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_aORt); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</div>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") }) -+ views_aORq; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</fieldset>") }) -+ viewss -+ -+ -+massTable viewss = Data.Foldable.mapM_ -+ (\ views_aORy -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<fieldset><table>"); -+ Data.Foldable.mapM_ -+ (\ view_aORz -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_aORz, not (fvRequired view_aORz)], -+ do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_aORz, -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_aORz), -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "optional"))] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\"") })] -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "><td><label for=\""); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_aORz)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_aORz)); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); -+ Text.Hamlet.maybeH -+ (fvTooltip view_aORz) -+ (\ tt_aORA -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<div class=\"tooltip\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_aORA); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</div>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</td><td>"); -+ Yesod.Widget.toWidget (fvInput view_aORz); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>"); -+ Text.Hamlet.maybeH -+ (fvErrors view_aORz) -+ (\ err_aORB -+ -> do { Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<td class=\"errors\">"); -+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_aORB); -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</td>") }) -+ Nothing; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") }) -+ views_aORy; -+ Yesod.Widget.toWidget -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</table></fieldset>") }) -+ viewss - --massTable viewss = [whamlet| --$newline never --$forall views <- viewss -- <fieldset> -- <table> -- $forall view <- views -- <tr :fvRequired view:.required :not $ fvRequired view:.optional> -- <td> -- <label for=#{fvId view}>#{fvLabel view} -- $maybe tt <- fvTooltip view -- <div .tooltip>#{tt} -- <td>^{fvInput view} -- $maybe err <- fvErrors view -- <td .errors>#{err} --|] -diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs -index 7c65ce4..357532f 100644 ---- a/Yesod/Form/Nic.hs -+++ b/Yesod/Form/Nic.hs -@@ -9,13 +9,19 @@ module Yesod.Form.Nic - , nicHtmlField - ) where - -+import qualified Data.Text.Lazy.Builder -+import qualified Text.Shakespeare -+import qualified Data.Monoid -+import qualified Text.Julius -+import qualified "blaze-markup" Text.Blaze.Internal -+import qualified Yesod.Widget - import Yesod.Handler - import Yesod.Core (Route, ScriptLoadPosition(..), jsLoader, Yesod) - import Yesod.Form - import Yesod.Widget - import Text.HTML.SanitizeXSS (sanitizeBalance) --import Text.Hamlet (Html, shamlet) --import Text.Julius (julius, rawJS) -+import Text.Hamlet (Html) -+import Text.Julius (rawJS) - #if MIN_VERSION_blaze_html(0, 5, 0) - import Text.Blaze (preEscapedToMarkup) - import Text.Blaze.Html.Renderer.String (renderHtml) -@@ -36,20 +42,49 @@ nicHtmlField :: YesodNic master => Field sub master Html - nicHtmlField = Field - { fieldParse = \e _ -> return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe $ e - , fieldView = \theId name attrs val _isReq -> do -- toWidget [shamlet| --$newline never -- <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val} --|] -+ toWidget $ do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<textarea class=\"html\" id=\""); -+ id (Text.Blaze.Html.toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (Text.Blaze.Html.toHtml name); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ id (Text.Blaze.Html.toHtml (showVal val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } -+ - addScript' urlNicEdit - master <- lift getYesod - toWidget $ - case jsLoader master of -- BottomOfHeadBlocking -> [julius| --bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")}); --|] -- _ -> [julius| --(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})(); --|] -+ BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl -+ (\ _render_a1itM -+ -> Data.Monoid.mconcat -+ [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\ -+ \bkLib.onDomLoaded(function(){new nicEditor({true}).panelInstance(\""), -+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\")});")]) -+ -+ _ -> Text.Julius.asJavascriptUrl -+ (\ _render_a1itQ -+ -> Data.Monoid.mconcat -+ [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "(function(){new nicEditor({true}).panelInstance(\""), -+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\")})();")]) -+ - , fieldEnctype = UrlEncoded - } - where --- -1.8.2.rc3 - diff --git a/standalone/android/haskell-patches/yesod-form_spliced-TH.patch b/standalone/android/haskell-patches/yesod-form_spliced-TH.patch new file mode 100644 index 000000000..ed52dadc5 --- /dev/null +++ b/standalone/android/haskell-patches/yesod-form_spliced-TH.patch @@ -0,0 +1,1746 @@ +From 3a17bd1223fcd7a750bc0e5e94ec5b97ad2e573b Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 05:14:21 +0000 +Subject: [PATCH] spliced TH + +Used EvilSplicer. Needed a few syntax fixes, and a lot of added imports. +--- + Yesod/Form/Fields.hs | 747 ++++++++++++++++++++++++++++++++++++----------- + Yesod/Form/Functions.hs | 237 ++++++++++++--- + Yesod/Form/Jquery.hs | 125 ++++++-- + Yesod/Form/MassInput.hs | 233 ++++++++++++--- + Yesod/Form/Nic.hs | 61 +++- + yesod-form.cabal | 1 + + 6 files changed, 1123 insertions(+), 281 deletions(-) + +diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs +index 5c16d7e..edd9715 100644 +--- a/Yesod/Form/Fields.hs ++++ b/Yesod/Form/Fields.hs +@@ -41,8 +41,6 @@ module Yesod.Form.Fields + , Option (..) + , OptionList (..) + , mkOptionList +- , optionsPersist +- , optionsPersistKey + , optionsPairs + , optionsEnum + ) where +@@ -68,6 +66,15 @@ import Text.HTML.SanitizeXSS (sanitizeBalance) + import Control.Monad (when, unless) + import Data.Maybe (listToMaybe, fromMaybe) + ++import qualified Text.Blaze as Text.Blaze.Internal ++import qualified Text.Blaze.Internal ++import qualified Text.Hamlet ++import qualified Yesod.Core.Widget ++import qualified Text.Css ++import qualified Data.Monoid ++import qualified Data.Foldable ++import qualified Control.Monad ++ + import qualified Blaze.ByteString.Builder.Html.Utf8 as B + import Blaze.ByteString.Builder (writeByteString, toLazyByteString) + import Blaze.ByteString.Builder.Internal.Write (fromWriteList) +@@ -80,14 +87,12 @@ import Data.Text (Text, unpack, pack) + import qualified Data.Text.Read + + import qualified Data.Map as Map +-import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery, YesodDB) + import Control.Arrow ((&&&)) + + import Control.Applicative ((<$>), (<|>)) + + import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly) + +-import Yesod.Persist.Core + + defaultFormMessage :: FormMessage -> Text + defaultFormMessage = englishFormMessage +@@ -100,10 +105,24 @@ intField = Field + Right (a, "") -> Right a + _ -> Left $ MsgInvalidInteger s + +- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}"> +-|] ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOn ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"number\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + where +@@ -117,10 +136,24 @@ doubleField = Field + Right (a, "") -> Right a + _ -> Left $ MsgInvalidNumber s + +- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}"> +-|] ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOz ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + where showVal = either id (pack . show) +@@ -128,10 +161,24 @@ $newline never + dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day + dayField = Field + { fieldParse = parseHelper $ parseDate . unpack +- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}"> +-|] ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOJ ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + where showVal = either id (pack . show) +@@ -139,10 +186,23 @@ $newline never + timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay + timeField = Field + { fieldParse = parseHelper parseTime +- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}"> +-|] ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOW ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + where +@@ -155,10 +215,18 @@ $newline never + htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html + htmlField = Field + { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance +- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| +-$newline never +-<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val} +-|] ++ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_arP6 ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } ++ + , fieldEnctype = UrlEncoded + } + where showVal = either id (pack . renderHtml) +@@ -166,7 +234,7 @@ $newline never + -- | A newtype wrapper around a 'Text' that converts newlines to HTML + -- br-tags. + newtype Textarea = Textarea { unTextarea :: Text } +- deriving (Show, Read, Eq, PersistField, PersistFieldSql, Ord) ++ deriving (Show, Read, Eq, PersistField, Ord) + instance ToHtml Textarea where + toHtml = + unsafeByteString +@@ -184,10 +252,18 @@ instance ToHtml Textarea where + textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea + textareaField = Field + { fieldParse = parseHelper $ Right . Textarea +- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| +-$newline never +-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val} +-|] ++ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_arPf ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ id (toHtml (either id unTextarea val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } ++ + , fieldEnctype = UrlEncoded + } + +@@ -195,10 +271,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) + => Field m p + hiddenField = Field + { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece +- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| +-$newline never +-<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}"> +-|] ++ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_arPo ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<input type=\"hidden\" id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); ++ id (toHtml (either id toPathPiece val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + +@@ -206,20 +291,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex + textField = Field + { fieldParse = parseHelper $ Right + , fieldView = \theId name attrs val isReq -> +- [whamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}"> +-|] ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); ++ Text.Hamlet.condH ++ [(isReq, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (either id id val)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + + passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text + passwordField = Field + { fieldParse = parseHelper $ Right +- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}"> +-|] ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arPF ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "\" type=\"password\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (either id id val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + +@@ -291,10 +411,24 @@ emailField = Field + case Email.canonicalizeEmail $ encodeUtf8 s of + Just e -> Right $ decodeUtf8With lenientDecode e + Nothing -> Left $ MsgInvalidEmail s +- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}"> +-|] ++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arQe ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"email\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (either id id val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + +@@ -303,20 +437,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus + searchField autoFocus = Field + { fieldParse = parseHelper Right + , fieldView = \theId name attrs val isReq -> do +- [whamlet|\ +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}"> +-|] ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\""); ++ Text.Hamlet.condH ++ [(isReq, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ Text.Hamlet.condH ++ [(autoFocus, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (either id id val)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + when autoFocus $ do + -- we want this javascript to be placed immediately after the field +- [whamlet| +-$newline never +-<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();} +-|] +- toWidget [cassius| +- ##{theId} +- -webkit-appearance: textfield +- |] ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "').focus();}</script>") } ++ ++ toWidget $ \ _render_arQv ++ -> (Text.Css.CssNoWhitespace ++ . (foldr ($) [])) ++ [((++) ++ $ (map ++ Text.Css.TopBlock ++ (((Text.Css.Block ++ {Text.Css.blockSelector = Data.Monoid.mconcat ++ [(Text.Css.fromText ++ . Text.Css.pack) ++ "#", ++ toCss theId], ++ Text.Css.blockAttrs = (concat ++ $ ([Text.Css.Attr ++ (Data.Monoid.mconcat ++ [(Text.Css.fromText ++ . Text.Css.pack) ++ "-webkit-appearance"]) ++ (Data.Monoid.mconcat ++ [(Text.Css.fromText ++ . Text.Css.pack) ++ "textfield"])] ++ : ++ (map ++ Text.Css.mixinAttrs ++ []))), ++ Text.Css.blockBlocks = (), ++ Text.Css.blockMixins = ()} ++ :) ++ . ((foldr (.) id []) ++ . (concatMap Text.Css.mixinBlocks [] ++))) ++ [])))] ++ + , fieldEnctype = UrlEncoded + } + +@@ -327,7 +519,30 @@ urlField = Field + Nothing -> Left $ MsgInvalidUrl s + Just _ -> Right s + , fieldView = \theId name attrs val isReq -> +- [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>|] ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\""); ++ Text.Hamlet.condH ++ [(isReq, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (either id id val)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + +@@ -340,18 +555,56 @@ selectField :: (Eq a, RenderMessage site FormMessage) + => HandlerT site IO (OptionList a) + -> Field (HandlerT site IO) a + selectField = selectFieldHelper +- (\theId name attrs inside -> [whamlet| +-$newline never +-<select ##{theId} name=#{name} *{attrs}>^{inside} +-|]) -- outside +- (\_theId _name isSel -> [whamlet| +-$newline never +-<option value=none :isSel:selected>_{MsgSelectNone} +-|]) -- onOpt +- (\_theId _name _attrs value isSel text -> [whamlet| +-$newline never +-<option value=#{value} :isSel:selected>#{text} +-|]) -- inside ++ (\theId name attrs inside -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) inside; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }) ++ -- outside ++ (\_theId _name isSel -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<option value=\"none\""); ++ Text.Hamlet.condH ++ [(isSel, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ ((Control.Monad.liftM (toHtml .) getMessageRender) ++ >>= ++ (\ urender_arQS ++ -> (Yesod.Core.Widget.asWidgetT . toWidget) ++ (urender_arQS MsgSelectNone))); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) ++ -- onOpt ++ (\_theId _name _attrs value isSel text -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ Text.Hamlet.condH ++ [(isSel, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml text); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) ++ -- inside + + multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) + => [(msg, a)] +@@ -374,11 +627,48 @@ multiSelectField ioptlist = + view theId name attrs val isReq = do + opts <- fmap olOptions $ handlerToWidget ioptlist + let selOpts = map (id &&& (optselected val)) opts +- [whamlet| +- <select ##{theId} name=#{name} :isReq:required multiple *{attrs}> +- $forall (opt, optsel) <- selOpts +- <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt} +- |] ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ Text.Hamlet.condH ++ [(isReq, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " multiple"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ Data.Foldable.mapM_ ++ (\ (opt_arRl, optsel_arRm) ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (optionExternalValue opt_arRl)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ Text.Hamlet.condH ++ [(optsel_arRm, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (optionDisplay opt_arRl)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) ++ selOpts; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") } ++ + where + optselected (Left _) _ = False + optselected (Right vals) opt = (optionInternalValue opt) `elem` vals +@@ -392,41 +682,167 @@ radioField :: (Eq a, RenderMessage site FormMessage) + => HandlerT site IO (OptionList a) + -> Field (HandlerT site IO) a + radioField = selectFieldHelper +- (\theId _name _attrs inside -> [whamlet| +-$newline never +-<div ##{theId}>^{inside} +-|]) +- (\theId name isSel -> [whamlet| +-$newline never +-<label .radio for=#{theId}-none> +- <div> +- <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked> +- _{MsgSelectNone} +-|]) +- (\theId name attrs value isSel text -> [whamlet| +-$newline never +-<label .radio for=#{theId}-#{value}> +- <div> +- <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}> +- \#{text} +-|]) ++ (\theId _name _attrs inside -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) inside; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) ++ ++ (\theId name isSel -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<label class=\"radio\" for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "-none\"><div><input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "-none\" type=\"radio\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\""); ++ Text.Hamlet.condH ++ [(isSel, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ ((Control.Monad.liftM (toHtml .) getMessageRender) ++ >>= ++ (\ urender_arRA ++ -> (Yesod.Core.Widget.asWidgetT . toWidget) ++ (urender_arRA MsgSelectNone))); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) ++ ++ (\theId name attrs value isSel text -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<label class=\"radio\" for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "-"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "\"><div><input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "-"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "\" type=\"radio\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ Text.Hamlet.condH ++ [(isSel, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml text); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) ++ + + boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool + boolField = Field + { fieldParse = \e _ -> return $ boolParser e +- , fieldView = \theId name attrs val isReq -> [whamlet| +-$newline never +- $if not isReq +- <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked> +- <label for=#{theId}-none>_{MsgSelectNone} +- +- +-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked> +-<label for=#{theId}-yes>_{MsgBoolYes} ++ , fieldView = \theId name attrs val isReq -> do { Text.Hamlet.condH ++ [(not isReq, ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "-none\" type=\"radio\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "\" value=\"none\" checked"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "-none\">"); ++ ((Control.Monad.liftM (toHtml .) getMessageRender) ++ >>= ++ (\ urender_arRX ++ -> (Yesod.Core.Widget.asWidgetT . toWidget) ++ (urender_arRX MsgSelectNone))); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "-yes\" type=\"radio\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\""); ++ Text.Hamlet.condH ++ [(showVal id val, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">"); ++ ((Control.Monad.liftM (toHtml .) getMessageRender) ++ >>= ++ (\ urender_arRY ++ -> (Yesod.Core.Widget.asWidgetT . toWidget) ++ (urender_arRY MsgBoolYes))); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "</label><input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "-no\" type=\"radio\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\""); ++ Text.Hamlet.condH ++ [(showVal not val, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "-no\">"); ++ ((Control.Monad.liftM (toHtml .) getMessageRender) ++ >>= ++ (\ urender_arRZ ++ -> (Yesod.Core.Widget.asWidgetT . toWidget) ++ (urender_arRZ MsgBoolNo))); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") } + +-<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked> +-<label for=#{theId}-no>_{MsgBoolNo} +-|] + , fieldEnctype = UrlEncoded + } + where +@@ -452,10 +868,25 @@ $newline never + checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool + checkBoxField = Field + { fieldParse = \e _ -> return $ checkBoxParser e +- , fieldView = \theId name attrs val _ -> [whamlet| +-$newline never +-<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked> +-|] ++ , fieldView = \theId name attrs val _ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "\" type=\"checkbox\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\""); ++ Text.Hamlet.condH ++ [(showVal id val, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = UrlEncoded + } + +@@ -499,49 +930,7 @@ optionsPairs opts = do + optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) + optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] + +-optionsPersist :: ( YesodPersist site, PersistEntity a +- , PersistQuery (YesodDB site) +- , PathPiece (Key a) +- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site) +- , RenderMessage site msg +- ) +- => [Filter a] +- -> [SelectOpt a] +- -> (a -> msg) +- -> HandlerT site IO (OptionList (Entity a)) +-optionsPersist filts ords toDisplay = fmap mkOptionList $ do +- mr <- getMessageRender +- pairs <- runDB $ selectList filts ords +- return $ map (\(Entity key value) -> Option +- { optionDisplay = mr (toDisplay value) +- , optionInternalValue = Entity key value +- , optionExternalValue = toPathPiece key +- }) pairs +- +--- | An alternative to 'optionsPersist' which returns just the @Key@ instead of +--- the entire @Entity@. +--- +--- Since 1.3.2 +-optionsPersistKey +- :: (YesodPersist site +- , PersistEntity a +- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) +- , PathPiece (Key a) +- , RenderMessage site msg +- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)) +- => [Filter a] +- -> [SelectOpt a] +- -> (a -> msg) +- -> HandlerT site IO (OptionList (Key a)) +- +-optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do +- mr <- getMessageRender +- pairs <- runDB $ selectList filts ords +- return $ map (\(Entity key value) -> Option +- { optionDisplay = mr (toDisplay value) +- , optionInternalValue = key +- , optionExternalValue = toPathPiece key +- }) pairs ++ + + selectFieldHelper + :: (Eq a, RenderMessage site FormMessage) +@@ -585,9 +974,21 @@ fileField = Field + case files of + [] -> Right Nothing + file:_ -> Right $ Just file +- , fieldView = \id' name attrs _ isReq -> toWidget [hamlet| +- <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required> +- |] ++ , fieldView = \id' name attrs _ isReq -> toWidget $ \ _render_arSN ++ -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml id'); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"file\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))] ++ Nothing; ++ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fieldEnctype = Multipart + } + +@@ -614,10 +1015,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do + { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs + , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs + , fvId = id' +- , fvInput = [whamlet| +-$newline never +-<input type=file name=#{name} ##{id'} *{fsAttrs fs}> +-|] ++ , fvInput = do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<input type=\"file\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml id'); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fvErrors = errs + , fvRequired = True + } +@@ -646,10 +1057,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do + { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs + , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs + , fvId = id' +- , fvInput = [whamlet| +-$newline never +-<input type=file name=#{name} ##{id'} *{fsAttrs fs}> +-|] ++ , fvInput = do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<input type=\"file\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml id'); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + , fvErrors = errs + , fvRequired = False + } +diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs +index 8a36710..c375ae0 100644 +--- a/Yesod/Form/Functions.hs ++++ b/Yesod/Form/Functions.hs +@@ -59,6 +59,10 @@ import Data.Maybe (listToMaybe, fromMaybe) + import qualified Data.Map as Map + import qualified Data.Text.Encoding as TE + import Control.Arrow (first) ++import qualified Text.Blaze.Internal ++import qualified Yesod.Core.Widget ++import qualified Data.Foldable ++import qualified Text.Hamlet + + -- | Get a unique identifier. + newFormIdent :: Monad m => MForm m Text +@@ -210,7 +214,14 @@ postHelper form env = do + let token = + case reqToken req of + Nothing -> mempty +- Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|] ++ Just n -> do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<input type=\"hidden\" name=\""); ++ id (toHtml tokenKey); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); ++ id (toHtml n); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") } ++ + m <- getYesod + langs <- languages + ((res, xml), enctype) <- runFormGeneric (form token) m langs env +@@ -279,7 +290,12 @@ getHelper :: MonadHandler m + -> Maybe (Env, FileEnv) + -> m (a, Enctype) + getHelper form env = do +- let fragment = [shamlet|<input type=hidden name=#{getKey}>|] ++ let fragment = do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<input type=\"hidden\" name=\""); ++ id (toHtml getKey); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") } ++ + langs <- languages + m <- getYesod + runFormGeneric (form fragment) m langs env +@@ -293,19 +309,66 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a + renderTable aform fragment = do + (res, views') <- aFormToForm aform + let views = views' [] +- let widget = [whamlet| +-$newline never +-\#{fragment} +-$forall view <- views +- <tr :fvRequired view:.required :not $ fvRequired view:.optional> +- <td> +- <label for=#{fvId view}>#{fvLabel view} +- $maybe tt <- fvTooltip view +- <div .tooltip>#{tt} +- <td>^{fvInput view} +- $maybe err <- fvErrors view +- <td .errors>#{err} +-|] ++ let widget = do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment); ++ Data.Foldable.mapM_ ++ (\ view_aagq ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<tr"); ++ Text.Hamlet.condH ++ [(or [fvRequired view_aagq, not (fvRequired view_aagq)], ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); ++ Text.Hamlet.condH ++ [(fvRequired view_aagq, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] ++ Nothing; ++ Text.Hamlet.condH ++ [(not (fvRequired view_aagq), ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "><td><label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagq)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (fvLabel view_aagq)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</label>"); ++ Text.Hamlet.maybeH ++ (fvTooltip view_aagq) ++ (\ tt_aagr ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<div class=\"tooltip\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagr); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagq); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</td>"); ++ Text.Hamlet.maybeH ++ (fvErrors view_aagq) ++ (\ err_aags ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<td class=\"errors\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aags); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</td>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") }) ++ views } ++ + return (res, widget) + + -- | render a field inside a div +@@ -318,19 +381,67 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a + renderDivsMaybeLabels withLabels aform fragment = do + (res, views') <- aFormToForm aform + let views = views' [] +- let widget = [whamlet| +-$newline never +-\#{fragment} +-$forall view <- views +- <div :fvRequired view:.required :not $ fvRequired view:.optional> +- $if withLabels +- <label for=#{fvId view}>#{fvLabel view} +- $maybe tt <- fvTooltip view +- <div .tooltip>#{tt} +- ^{fvInput view} +- $maybe err <- fvErrors view +- <div .errors>#{err} +-|] ++ let widget = do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment); ++ Data.Foldable.mapM_ ++ (\ view_aagE ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<div"); ++ Text.Hamlet.condH ++ [(or [fvRequired view_aagE, not (fvRequired view_aagE)], ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); ++ Text.Hamlet.condH ++ [(fvRequired view_aagE, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] ++ Nothing; ++ Text.Hamlet.condH ++ [(not (fvRequired view_aagE), ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ Text.Hamlet.condH ++ [(withLabels, ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagE)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (fvLabel view_aagE)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] ++ Nothing; ++ Text.Hamlet.maybeH ++ (fvTooltip view_aagE) ++ (\ tt_aagF ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<div class=\"tooltip\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagF); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagE); ++ Text.Hamlet.maybeH ++ (fvErrors view_aagE) ++ (\ err_aagG ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<div class=\"errors\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aagG); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) ++ views } ++ + return (res, widget) + + -- | Render a form using Bootstrap-friendly shamlet syntax. +@@ -354,19 +465,63 @@ renderBootstrap aform fragment = do + let views = views' [] + has (Just _) = True + has Nothing = False +- let widget = [whamlet| +- $newline never +- \#{fragment} +- $forall view <- views +- <div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error> +- <label .control-label for=#{fvId view}>#{fvLabel view} +- <div .controls .input> +- ^{fvInput view} +- $maybe tt <- fvTooltip view +- <span .help-block>#{tt} +- $maybe err <- fvErrors view +- <span .help-block>#{err} +- |] ++ let widget = do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment); ++ Data.Foldable.mapM_ ++ (\ view_aagR ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<div class=\"control-group clearfix "); ++ Text.Hamlet.condH ++ [(fvRequired view_aagR, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] ++ Nothing; ++ Text.Hamlet.condH ++ [(not (fvRequired view_aagR), ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "optional "))] ++ Nothing; ++ Text.Hamlet.condH ++ [(has (fvErrors view_aagR), ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "error"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "\"><label class=\"control-label\" for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagR)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (fvLabel view_aagR)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "</label><div class=\"controls input\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagR); ++ Text.Hamlet.maybeH ++ (fvTooltip view_aagR) ++ (\ tt_aagS ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<span class=\"help-block\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagS); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) ++ Nothing; ++ Text.Hamlet.maybeH ++ (fvErrors view_aagR) ++ (\ err_aagT ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<span class=\"help-block\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aagT); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") }) ++ views } ++ + return (res, widget) + + check :: (Monad m, RenderMessage (HandlerSite m) msg) +diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs +index 2c4ae25..4362188 100644 +--- a/Yesod/Form/Jquery.hs ++++ b/Yesod/Form/Jquery.hs +@@ -12,6 +12,18 @@ module Yesod.Form.Jquery + , Default (..) + ) where + ++import qualified Text.Blaze as Text.Blaze.Internal ++import qualified Text.Blaze.Internal ++import qualified Text.Hamlet ++import qualified Yesod.Core.Widget ++import qualified Text.Css ++import qualified Data.Monoid ++import qualified Data.Foldable ++import qualified Control.Monad ++import qualified Text.Julius ++import qualified Data.Text.Lazy.Builder ++import qualified Text.Shakespeare ++ + import Yesod.Core + import Yesod.Form + import Data.Time (Day) +@@ -60,27 +72,59 @@ jqueryDayField jds = Field + . readMay + . unpack + , fieldView = \theId name attrs val isReq -> do +- toWidget [shamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}"> +-|] ++ toWidget $ do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + addScript' urlJqueryJs + addScript' urlJqueryUiJs + addStylesheet' urlJqueryUiCss +- toWidget [julius| +-$(function(){ +- var i = document.getElementById("#{rawJS theId}"); +- if (i.type != "date") { +- $(i).datepicker({ +- dateFormat:'yy-mm-dd', +- changeMonth:#{jsBool $ jdsChangeMonth jds}, +- changeYear:#{jsBool $ jdsChangeYear jds}, +- numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds}, +- yearRange:#{toJSON $ jdsYearRange jds} +- }); +- } +-}); +-|] ++ toWidget $ Text.Julius.asJavascriptUrl ++ (\ _render_a1lYC ++ -> mconcat ++ [Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\n$(function(){\n var i = document.getElementById(\""), ++ Text.Julius.toJavascript (rawJS theId), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\");\n if (i.type != \"date\") {\n $(i).datepicker({\n dateFormat:'yy-mm-dd',\n changeMonth:"), ++ Text.Julius.toJavascript (jsBool (jdsChangeMonth jds)), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ ",\n changeYear:"), ++ Text.Julius.toJavascript (jsBool (jdsChangeYear jds)), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ ",\n numberOfMonths:"), ++ Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds))), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ ",\n yearRange:"), ++ Text.Julius.toJavascript (toJSON (jdsYearRange jds)), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\n });\n }\n});")]) ++ + , fieldEnctype = UrlEncoded + } + where +@@ -101,16 +145,47 @@ jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site) + jqueryAutocompleteField src = Field + { fieldParse = parseHelper $ Right + , fieldView = \theId name attrs val isReq -> do +- toWidget [shamlet| +-$newline never +-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete> +-|] ++ toWidget $ do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<input class=\"autocomplete\" id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); ++ Text.Hamlet.condH ++ [(isReq, ++ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] ++ Nothing; ++ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); ++ id (toHtml (either id id val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } ++ + addScript' urlJqueryJs + addScript' urlJqueryUiJs + addStylesheet' urlJqueryUiCss +- toWidget [julius| +-$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})}); +-|] ++ toWidget $ Text.Julius.asJavascriptUrl ++ (\ _render_a1lYP ++ -> mconcat ++ [Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\n$(function(){$(\"#"), ++ Text.Julius.toJavascript (rawJS theId), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\").autocomplete({source:\""), ++ Text.Julius.Javascript ++ (Data.Text.Lazy.Builder.fromText ++ (_render_a1lYP src [])), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\",minLength:2})});")]) ++ + , fieldEnctype = UrlEncoded + } + +diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs +index 332eb66..5015e7b 100644 +--- a/Yesod/Form/MassInput.hs ++++ b/Yesod/Form/MassInput.hs +@@ -9,6 +9,16 @@ module Yesod.Form.MassInput + , massTable + ) where + ++import qualified Data.Text ++import qualified Text.Blaze as Text.Blaze.Internal ++import qualified Text.Blaze.Internal ++import qualified Text.Hamlet ++import qualified Yesod.Core.Widget ++import qualified Text.Css ++import qualified Data.Monoid ++import qualified Data.Foldable ++import qualified Control.Monad ++ + import Yesod.Form.Types + import Yesod.Form.Functions + import Yesod.Form.Fields (boolField) +@@ -70,16 +80,28 @@ inputList label fixXml single mdef = formToAForm $ do + { fvLabel = label + , fvTooltip = Nothing + , fvId = theId +- , fvInput = [whamlet| +-$newline never +-^{fixXml views} +-<p> +- $forall xml <- xmls +- ^{xml} +- <input .count type=hidden name=#{countName} value=#{count}> +- <input type=checkbox name=#{addName}> +- Add another row +-|] ++ , fvInput = do { (Yesod.Core.Widget.asWidgetT . toWidget) (fixXml views); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>"); ++ Data.Foldable.mapM_ ++ (\ xml_aUS3 -> (Yesod.Core.Widget.asWidgetT . toWidget) xml_aUS3) ++ xmls; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<input class=\"count\" type=\"hidden\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml countName); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "\" value=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml count); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "\"><input type=\"checkbox\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml addName); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "\">Add another row</p>") } ++ + , fvErrors = Nothing + , fvRequired = False + }]) +@@ -92,10 +114,14 @@ withDelete af = do + deleteName <- newFormIdent + (menv, _, _) <- ask + res <- case menv >>= Map.lookup deleteName . fst of +- Just ("yes":_) -> return $ Left [whamlet| +-$newline never +-<input type=hidden name=#{deleteName} value=yes> +-|] ++ Just ("yes":_) -> return $ Left $ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<input type=\"hidden\" name=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml deleteName); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "\" value=\"yes\">") } ++ + _ -> do + (_, xml2) <- aFormToForm $ areq boolField FieldSettings + { fsLabel = SomeMessage MsgDelete +@@ -121,32 +147,155 @@ fixme eithers = + massDivs, massTable + :: [[FieldView site]] + -> WidgetT site IO () +-massDivs viewss = [whamlet| +-$newline never +-$forall views <- viewss +- <fieldset> +- $forall view <- views +- <div :fvRequired view:.required :not $ fvRequired view:.optional> +- <label for=#{fvId view}>#{fvLabel view} +- $maybe tt <- fvTooltip view +- <div .tooltip>#{tt} +- ^{fvInput view} +- $maybe err <- fvErrors view +- <div .errors>#{err} +-|] ++massDivs viewss = Data.Foldable.mapM_ ++ (\ views_aUSm ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<fieldset>"); ++ Data.Foldable.mapM_ ++ (\ view_aUSn ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div"); ++ Text.Hamlet.condH ++ [(or [fvRequired view_aUSn, not (fvRequired view_aUSn)], ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ " class=\""); ++ Text.Hamlet.condH ++ [(fvRequired view_aUSn, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "required "))] ++ Nothing; ++ Text.Hamlet.condH ++ [(not (fvRequired view_aUSn), ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "optional"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "\"") })] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "><label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aUSn)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (fvLabel view_aUSn)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); ++ Text.Hamlet.maybeH ++ (fvTooltip view_aUSn) ++ (\ tt_aUSo ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<div class=\"tooltip\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml tt_aUSo); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</div>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aUSn); ++ Text.Hamlet.maybeH ++ (fvErrors view_aUSn) ++ (\ err_aUSp ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<div class=\"errors\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml err_aUSp); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</div>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") }) ++ views_aUSm; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</fieldset>") }) ++ viewss ++ ++ ++massTable viewss = Data.Foldable.mapM_ ++ (\ views_aUSu ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<fieldset><table>"); ++ Data.Foldable.mapM_ ++ (\ view_aUSv ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr"); ++ Text.Hamlet.condH ++ [(or [fvRequired view_aUSv, not (fvRequired view_aUSv)], ++ do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ " class=\""); ++ Text.Hamlet.condH ++ [(fvRequired view_aUSv, ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "required "))] ++ Nothing; ++ Text.Hamlet.condH ++ [(not (fvRequired view_aUSv), ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "optional"))] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "\"") })] ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "><td><label for=\""); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aUSv)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml (fvLabel view_aUSv)); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); ++ Text.Hamlet.maybeH ++ (fvTooltip view_aUSv) ++ (\ tt_aUSw ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<div class=\"tooltip\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml tt_aUSw); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</div>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</td><td>"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aUSv); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>"); ++ Text.Hamlet.maybeH ++ (fvErrors view_aUSv) ++ (\ err_aUSx ++ -> do { (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "<td class=\"errors\">"); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ (toHtml err_aUSx); ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</td>") }) ++ Nothing; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") }) ++ views_aUSu; ++ (Yesod.Core.Widget.asWidgetT . toWidget) ++ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) ++ "</table></fieldset>") }) ++ viewss + +-massTable viewss = [whamlet| +-$newline never +-$forall views <- viewss +- <fieldset> +- <table> +- $forall view <- views +- <tr :fvRequired view:.required :not $ fvRequired view:.optional> +- <td> +- <label for=#{fvId view}>#{fvLabel view} +- $maybe tt <- fvTooltip view +- <div .tooltip>#{tt} +- <td>^{fvInput view} +- $maybe err <- fvErrors view +- <td .errors>#{err} +-|] +diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs +index 2862678..7b49b1a 100644 +--- a/Yesod/Form/Nic.hs ++++ b/Yesod/Form/Nic.hs +@@ -9,6 +9,19 @@ module Yesod.Form.Nic + , nicHtmlField + ) where + ++import qualified Text.Blaze as Text.Blaze.Internal ++import qualified Text.Blaze.Internal ++import qualified Text.Hamlet ++import qualified Yesod.Core.Widget ++import qualified Text.Css ++import qualified Data.Monoid ++import qualified Data.Foldable ++import qualified Control.Monad ++import qualified Text.Julius ++import qualified Data.Text.Lazy.Builder ++import qualified Text.Shakespeare ++ ++ + import Yesod.Core + import Yesod.Form + import Text.HTML.SanitizeXSS (sanitizeBalance) +@@ -27,20 +40,48 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html + nicHtmlField = Field + { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e + , fieldView = \theId name attrs val _isReq -> do +- toWidget [shamlet| +-$newline never +- <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val} +-|] ++ toWidget $ do { id ++ ((Text.Blaze.Internal.preEscapedText . pack) ++ "<textarea class=\"html\" id=\""); ++ id (toHtml theId); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); ++ id (toHtml name); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); ++ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); ++ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); ++ id (toHtml (showVal val)); ++ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } ++ + addScript' urlNicEdit + master <- getYesod + toWidget $ + case jsLoader master of +- BottomOfHeadBlocking -> [julius| +-bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")}); +-|] +- _ -> [julius| +-(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})(); +-|] ++ BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl ++ (\ _render_a1qhO ++ -> Data.Monoid.mconcat ++ [Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\nbkLib.onDomLoaded(function(){new nicEditor({true}).panelInstance(\""), ++ Text.Julius.toJavascript (rawJS theId), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\")});")]) ++ ++ _ -> Text.Julius.asJavascriptUrl ++ (\ _render_a1qhS ++ -> Data.Monoid.mconcat ++ [Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\n(function(){new nicEditor({true}).panelInstance(\""), ++ Text.Julius.toJavascript (rawJS theId), ++ Text.Julius.Javascript ++ ((Data.Text.Lazy.Builder.fromText ++ . Text.Shakespeare.pack') ++ "\")})();")]) ++ + , fieldEnctype = UrlEncoded + } + where +diff --git a/yesod-form.cabal b/yesod-form.cabal +index f6ebbe0..46e3dd7 100644 +--- a/yesod-form.cabal ++++ b/yesod-form.cabal +@@ -19,6 +19,7 @@ library + , time >= 1.1.4 + , hamlet >= 1.1 && < 1.2 + , shakespeare-css >= 1.0 && < 1.1 ++ , shakespeare + , shakespeare-js >= 1.0.2 && < 1.3 + , persistent >= 1.2 && < 1.3 + , template-haskell +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/yesod-persistent_1.1.0.1_0001-avoid-TH.patch b/standalone/android/haskell-patches/yesod-persistent_1.1.0.1_0001-avoid-TH.patch deleted file mode 100644 index 6a28b3fd1..000000000 --- a/standalone/android/haskell-patches/yesod-persistent_1.1.0.1_0001-avoid-TH.patch +++ /dev/null @@ -1,41 +0,0 @@ -From 62cc9e3f70d8cea848d56efa198a68527fd07267 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:40:19 -0400 -Subject: [PATCH] avoid TH - ---- - Yesod/Persist.hs | 2 -- - yesod-persistent.cabal | 1 - - 2 files changed, 3 deletions(-) - -diff --git a/Yesod/Persist.hs b/Yesod/Persist.hs -index 0646152..5130497 100644 ---- a/Yesod/Persist.hs -+++ b/Yesod/Persist.hs -@@ -7,11 +7,9 @@ module Yesod.Persist - , get404 - , getBy404 - , module Database.Persist -- , module Database.Persist.TH - ) where - - import Database.Persist --import Database.Persist.TH - import Control.Monad.Trans.Class (MonadTrans) - - import Yesod.Handler -diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal -index 111c1b9..07f6e17 100644 ---- a/yesod-persistent.cabal -+++ b/yesod-persistent.cabal -@@ -16,7 +16,6 @@ library - build-depends: base >= 4 && < 5 - , yesod-core >= 1.1 && < 1.2 - , persistent >= 1.0 && < 1.2 -- , persistent-template >= 1.0 && < 1.2 - , transformers >= 0.2.2 && < 0.4 - exposed-modules: Yesod.Persist - ghc-options: -Wall --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/yesod-persistent_do-not-really-build.patch b/standalone/android/haskell-patches/yesod-persistent_do-not-really-build.patch new file mode 100644 index 000000000..ecccf75ac --- /dev/null +++ b/standalone/android/haskell-patches/yesod-persistent_do-not-really-build.patch @@ -0,0 +1,26 @@ +From 03819615edb1c5f7414768dae84234d6791bd758 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 04:11:46 +0000 +Subject: [PATCH] do not really build + +--- + yesod-persistent.cabal | 3 +-- + 1 file changed, 1 insertion(+), 2 deletions(-) + +diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal +index 98c2146..11960cf 100644 +--- a/yesod-persistent.cabal ++++ b/yesod-persistent.cabal +@@ -23,8 +23,7 @@ library + , lifted-base + , pool-conduit + , resourcet +- exposed-modules: Yesod.Persist +- Yesod.Persist.Core ++ exposed-modules: + ghc-options: -Wall + + test-suite test +-- +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-routes_export-module-referenced-by-TH-splices.patch b/standalone/android/haskell-patches/yesod-routes_export-module-referenced-by-TH-splices.patch new file mode 100644 index 000000000..e20e3c7f1 --- /dev/null +++ b/standalone/android/haskell-patches/yesod-routes_export-module-referenced-by-TH-splices.patch @@ -0,0 +1,29 @@ +From f6bfe8e01d8fe6d129ad3819070aa17934094a0a Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 06:24:09 +0000 +Subject: [PATCH] export module referenced by TH splices + +--- + yesod-routes.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/yesod-routes.cabal b/yesod-routes.cabal +index 0b245f2..a97582a 100644 +--- a/yesod-routes.cabal ++++ b/yesod-routes.cabal +@@ -27,11 +27,11 @@ library + Yesod.Routes.Class + Yesod.Routes.Parse + Yesod.Routes.Overlap ++ Yesod.Routes.TH.Types + other-modules: Yesod.Routes.TH.Dispatch + Yesod.Routes.TH.RenderRoute + Yesod.Routes.TH.ParseRoute + Yesod.Routes.TH.RouteAttrs +- Yesod.Routes.TH.Types + ghc-options: -Wall + + test-suite runtests +-- +1.7.10.4 + 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) diff --git a/standalone/android/haskell-patches/yesod_001_hacked-up-for-Android.patch b/standalone/android/haskell-patches/yesod_001_hacked-up-for-Android.patch new file mode 100644 index 000000000..23ba50d33 --- /dev/null +++ b/standalone/android/haskell-patches/yesod_001_hacked-up-for-Android.patch @@ -0,0 +1,74 @@ +From 8bf7c428a42b984f63f435bb34f22743202ae449 Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 05:24:19 +0000 +Subject: [PATCH] hacked up for Android + +--- + Yesod.hs | 2 -- + Yesod/Default/Util.hs | 17 ----------------- + 2 files changed, 19 deletions(-) + +diff --git a/Yesod.hs b/Yesod.hs +index b367144..3050bf5 100644 +--- a/Yesod.hs ++++ b/Yesod.hs +@@ -5,9 +5,7 @@ module Yesod + ( -- * Re-exports from yesod-core + module Yesod.Core + , module Yesod.Form +- , module Yesod.Persist + ) where + + import Yesod.Core + import Yesod.Form +-import Yesod.Persist +diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs +index a10358e..c5a4e58 100644 +--- a/Yesod/Default/Util.hs ++++ b/Yesod/Default/Util.hs +@@ -8,7 +8,6 @@ module Yesod.Default.Util + , widgetFileNoReload + , widgetFileReload + , TemplateLanguage (..) +- , defaultTemplateLanguages + , WidgetFileSettings + , wfsLanguages + , wfsHamletSettings +@@ -20,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)) +@@ -69,24 +65,11 @@ data TemplateLanguage = TemplateLanguage + , tlReload :: FilePath -> Q Exp + } + +-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] + , wfsHamletSettings :: HamletSettings + } + +-instance Default WidgetFileSettings where +- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings +- + widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp + widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs + +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/yesod_002_hack-around-missing-symbols.patch b/standalone/android/haskell-patches/yesod_002_hack-around-missing-symbols.patch new file mode 100644 index 000000000..eaad739e5 --- /dev/null +++ b/standalone/android/haskell-patches/yesod_002_hack-around-missing-symbols.patch @@ -0,0 +1,41 @@ +From 7e815b11f242d6836f9615439e32f9937bf2feaf Mon Sep 17 00:00:00 2001 +From: foo <foo@bar> +Date: Sun, 22 Sep 2013 13:59:34 +0000 +Subject: [PATCH] hack around missing symbols + +--- + Yesod.hs | 17 +++++++++++++++++ + 1 file changed, 17 insertions(+) + +diff --git a/Yesod.hs b/Yesod.hs +index 3050bf5..fbe309c 100644 +--- a/Yesod.hs ++++ b/Yesod.hs +@@ -5,7 +5,24 @@ module Yesod + ( -- * Re-exports from yesod-core + module Yesod.Core + , module Yesod.Form ++ , insertBy ++ , replace ++ , deleteBy ++ , delete ++ , insert ++ , Key + ) where + + import Yesod.Core + import Yesod.Form ++ ++-- These symbols are usually imported from persistent, ++-- But it is not built on Android. Still export them ++-- just so that hiding them will work. ++data Key = DummyKey ++insertBy = undefined ++replace = undefined ++deleteBy = undefined ++delete = undefined ++insert = undefined ++ +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/yesod_1.1.8_0001-hacked-up-to-build-on-Android.patch b/standalone/android/haskell-patches/yesod_1.1.8_0001-hacked-up-to-build-on-Android.patch deleted file mode 100644 index 5a042dc41..000000000 --- a/standalone/android/haskell-patches/yesod_1.1.8_0001-hacked-up-to-build-on-Android.patch +++ /dev/null @@ -1,157 +0,0 @@ -From 37abd5d34e18d11ff2961f672cf4491471029684 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:39:18 -0400 -Subject: [PATCH] hacked up to build on Android - -removing stuff I don't need and stuff removed from other modules ---- - Yesod.hs | 7 ------ - yesod.cabal | 77 ----------------------------------------------------------- - 2 files changed, 84 deletions(-) - -diff --git a/Yesod.hs b/Yesod.hs -index ef9623d..255ab56 100644 ---- a/Yesod.hs -+++ b/Yesod.hs -@@ -6,7 +6,6 @@ module Yesod - module Yesod.Core - , module Yesod.Form - , module Yesod.Json -- , module Yesod.Persist - -- * Running your application - , warp - , warpDebug -@@ -21,19 +20,14 @@ module Yesod - , readIntegral - -- * Hamlet library - -- ** Hamlet -- , hamlet -- , xhamlet - , HtmlUrl - , Html - , toHtml - -- ** Julius -- , julius - , JavascriptUrl - , renderJavascriptUrl - , toJSON - -- ** Cassius/Lucius -- , cassius -- , lucius - , CssUrl - , renderCssUrl - ) where -@@ -46,7 +40,6 @@ import Text.Julius - - import Yesod.Form - import Yesod.Json --import Yesod.Persist - import Control.Monad.IO.Class (liftIO, MonadIO(..)) - import Control.Monad.Trans.Control (MonadBaseControl) - -diff --git a/yesod.cabal b/yesod.cabal -index 741f19a..7566cfb 100644 ---- a/yesod.cabal -+++ b/yesod.cabal -@@ -13,7 +13,6 @@ description: - The Yesod documentation site <http://www.yesodweb.com/> has much more information, including on the supporting packages mentioned above. - category: Web, Yesod - stability: Stable --cabal-version: >= 1.6 - build-type: Simple - homepage: http://www.yesodweb.com/ - -@@ -28,9 +27,7 @@ extra-source-files: - library - build-depends: base >= 4.3 && < 5 - , yesod-core >= 1.1.5 && < 1.2 -- , yesod-auth >= 1.1 && < 1.2 - , yesod-json >= 1.1 && < 1.2 -- , yesod-persistent >= 1.1 && < 1.2 - , yesod-form >= 1.1 && < 1.3 - , yesod-default >= 1.1.3 && < 1.2 - , monad-control >= 0.3 && < 0.4 -@@ -48,80 +45,6 @@ library - exposed-modules: Yesod - ghc-options: -Wall - --executable yesod-ghc-wrapper -- main-is: ghcwrapper.hs -- build-depends: -- base >= 4 && < 5 -- , Cabal -- --executable yesod-ld-wrapper -- main-is: ghcwrapper.hs -- cpp-options: -DLDCMD -- build-depends: -- base >= 4 && < 5 -- , Cabal --executable yesod-ar-wrapper -- main-is: ghcwrapper.hs -- cpp-options: -DARCMD -- build-depends: -- base >= 4 && < 5 -- , Cabal -- --executable yesod -- if os(windows) -- cpp-options: -DWINDOWS -- build-depends: base >= 4.3 && < 5 -- , ghc >= 7.0.3 && < 7.8 -- , ghc-paths >= 0.1 -- , parsec >= 2.1 && < 4 -- , text >= 0.11 -- , shakespeare-text >= 1.0 && < 1.1 -- , shakespeare >= 1.0.2 && < 1.1 -- , shakespeare-js >= 1.0.2 && < 1.2 -- , shakespeare-css >= 1.0.2 && < 1.1 -- , bytestring >= 0.9.1.4 -- , time >= 1.1.4 -- , template-haskell -- , directory >= 1.0 -- , Cabal -- , unix-compat >= 0.2 && < 0.5 -- , containers >= 0.2 -- , attoparsec >= 0.10 -- , http-types >= 0.7 -- , blaze-builder >= 0.2.1.4 && < 0.4 -- , filepath >= 1.1 -- , process -- , zlib >= 0.5 && < 0.6 -- , tar >= 0.4 && < 0.5 -- , system-filepath >= 0.4 && < 0.5 -- , system-fileio >= 0.3 && < 0.4 -- , unordered-containers -- , yaml >= 0.8 && < 0.9 -- , optparse-applicative >= 0.4 -- , fsnotify >= 0.0 && < 0.1 -- , split >= 0.2 && < 0.3 -- , file-embed -- , conduit >= 0.5 && < 0.6 -- , resourcet >= 0.3 && < 0.5 -- , base64-bytestring -- , lifted-base -- , http-reverse-proxy >= 0.1.1 -- , network -- , http-conduit -- , network-conduit -- , project-template >= 0.1.1 -- -- ghc-options: -Wall -threaded -- main-is: main.hs -- other-modules: Scaffolding.Scaffolder -- Devel -- Build -- GhcBuild -- Keter -- AddHandler -- Paths_yesod -- Options -- - source-repository head - type: git - location: https://github.com/yesodweb/yesod --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/zlib_0.5.4.0_0001-hack-to-build-on-Android.patch b/standalone/android/haskell-patches/zlib_0.5.4.0_0001-hack-to-build-on-Android.patch index 3b74bc26d..a899fb892 100644 --- a/standalone/android/haskell-patches/zlib_0.5.4.0_0001-hack-to-build-on-Android.patch +++ b/standalone/android/haskell-patches/zlib_0.5.4.0_0001-hack-to-build-on-Android.patch @@ -30,19 +30,6 @@ index fe851e6..c6168f4 100644 c_deflateInit2_ z a b c d e versionStr (#{const sizeof(z_stream)} :: CInt) foreign import ccall unsafe "zlib.h deflateSetDictionary" -diff --git a/zlib.cabal b/zlib.cabal -index f2d1f5d..751bfab 100644 ---- a/zlib.cabal -+++ b/zlib.cabal -@@ -36,7 +36,7 @@ library - other-modules: Codec.Compression.Zlib.Stream - extensions: CPP, ForeignFunctionInterface - build-depends: base >= 3 && < 5, -- bytestring >= 0.9 && < 0.12 -+ bytestring >= 0.10.3.0 - includes: zlib.h - ghc-options: -Wall - if !os(windows) -- 1.7.10.4 |