summaryrefslogtreecommitdiff
path: root/standalone/no-th/haskell-patches
diff options
context:
space:
mode:
Diffstat (limited to 'standalone/no-th/haskell-patches')
-rw-r--r--standalone/no-th/haskell-patches/DAV_build-without-TH.patch414
-rw-r--r--standalone/no-th/haskell-patches/file-embed_remove-TH.patch131
-rw-r--r--standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch394
-rw-r--r--standalone/no-th/haskell-patches/hamlet_remove-TH.patch365
-rw-r--r--standalone/no-th/haskell-patches/lens_no-TH.patch175
-rw-r--r--standalone/no-th/haskell-patches/monad-logger_remove-TH.patch150
-rw-r--r--standalone/no-th/haskell-patches/persistent-template_stub-out.patch25
-rw-r--r--standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch41
-rw-r--r--standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch24
-rw-r--r--standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch26
-rw-r--r--standalone/no-th/haskell-patches/reflection_remove-TH.patch113
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch26
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch351
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch215
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch316
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch153
-rw-r--r--standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch26
-rw-r--r--standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch223
-rw-r--r--standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch82
-rw-r--r--standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch108
-rw-r--r--standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch34
-rw-r--r--standalone/no-th/haskell-patches/yesod-core_expand_TH.patch684
-rw-r--r--standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch1805
-rw-r--r--standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch26
-rw-r--r--standalone/no-th/haskell-patches/yesod-routes_export-module-referenced-by-TH-splices.patch29
-rw-r--r--standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch169
-rw-r--r--standalone/no-th/haskell-patches/yesod-static_remove-TH.patch597
-rw-r--r--standalone/no-th/haskell-patches/yesod_hack-TH.patch140
28 files changed, 6842 insertions, 0 deletions
diff --git a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch
new file mode 100644
index 000000000..ac6ba2a19
--- /dev/null
+++ b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch
@@ -0,0 +1,414 @@
+From 67e5fc4eb21fe801f7ab4c01b98c02912c5cb43f Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 05:44:10 +0000
+Subject: [PATCH] expand TH
+
+plus manual fixups
+---
+ DAV.cabal | 22 +---
+ Network/Protocol/HTTP/DAV.hs | 96 +++++++++++++----
+ Network/Protocol/HTTP/DAV/TH.hs | 232 +++++++++++++++++++++++++++++++++++++++-
+ 3 files changed, 307 insertions(+), 43 deletions(-)
+
+diff --git a/DAV.cabal b/DAV.cabal
+index 1f1eb1f..ea117ff 100644
+--- a/DAV.cabal
++++ b/DAV.cabal
+@@ -36,27 +36,7 @@ library
+ , lifted-base >= 0.1
+ , monad-control
+ , mtl >= 2.1
+- , transformers >= 0.3
+- , transformers-base
+- , 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-client >= 0.2
+- , http-client-tls >= 0.2
+- , http-types >= 0.7
+- , lens >= 3.0
+- , lifted-base >= 0.1
+- , monad-control
+- , mtl >= 2.1
+- , network >= 2.3
+- , optparse-applicative
++ , text
+ , transformers >= 0.3
+ , transformers-base
+ , xml-conduit >= 1.0 && <= 1.2
+diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
+index 9d8c070..5993fca 100644
+--- a/Network/Protocol/HTTP/DAV.hs
++++ b/Network/Protocol/HTTP/DAV.hs
+@@ -77,7 +77,7 @@ 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 qualified Data.Text
+
+ import Data.CaseInsensitive (mk)
+
+@@ -335,28 +335,84 @@ makeCollection url username password = choke $ evalDAVT url $ do
+ 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
+-|]
++ 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")]]))]]
++
+
+ 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">
+-|]
++ root = XML.Element "C:calendar-query" (Map.fromList [("xmlns:D", "DAV:"),("xmlns:C", "urn:ietf:params:xml:ns:caldav")]) $ concat
++ [[XML.NodeElement
++ (XML.Element
++ (XML.Name (Data.Text.pack "D:prop") Nothing Nothing)
++ Map.empty
++ (concat
++ [[XML.NodeElement
++ (XML.Element
++ (XML.Name
++ (Data.Text.pack "D:getetag") Nothing Nothing)
++ Map.empty
++ (concat []))],
++ [XML.NodeElement
++ (XML.Element
++ (XML.Name
++ (Data.Text.pack "C:calendar-data") Nothing Nothing)
++ Map.empty
++ (concat []))]]))],
++ [XML.NodeElement
++ (XML.Element
++ (XML.Name
++ (Data.Text.pack "C:filter") Nothing Nothing)
++ Map.empty
++ (concat
++ [[XML.NodeElement
++ (XML.Element
++ (XML.Name
++ (Data.Text.pack "C:comp-filter") Nothing Nothing)
++ (Map.insert
++ (XML.Name (Data.Text.pack "name") Nothing Nothing)
++ (Data.Text.concat
++ [Data.Text.pack "VCALENDAR"])
++ Map.empty)
++ (concat []))]]))]]
++
+diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs
+index b072116..5a01bf9 100644
+--- a/Network/Protocol/HTTP/DAV/TH.hs
++++ b/Network/Protocol/HTTP/DAV/TH.hs
+@@ -20,9 +20,11 @@
+
+ module Network.Protocol.HTTP.DAV.TH where
+
+-import Control.Lens (makeLenses)
++import Control.Lens
+ import qualified Data.ByteString as B
+ import Network.HTTP.Client (Manager, Request)
++import qualified Control.Lens.Type
++import qualified Data.Functor
+
+ data Depth = Depth0 | Depth1 | DepthInfinity
+ instance Read Depth where
+@@ -47,4 +49,230 @@ data DAVContext = DAVContext {
+ , _lockToken :: Maybe B.ByteString
+ , _userAgent :: B.ByteString
+ }
+-makeLenses ''DAVContext
++allowedMethods :: Control.Lens.Type.Lens' DAVContext [B.ByteString]
++allowedMethods
++ _f_a2PF
++ (DAVContext __allowedMethods'_a2PG
++ __baseRequest_a2PI
++ __basicusername_a2PJ
++ __basicpassword_a2PK
++ __complianceClasses_a2PL
++ __depth_a2PM
++ __httpManager_a2PN
++ __lockToken_a2PO
++ __userAgent_a2PP)
++ = ((\ __allowedMethods_a2PH
++ -> DAVContext
++ __allowedMethods_a2PH
++ __baseRequest_a2PI
++ __basicusername_a2PJ
++ __basicpassword_a2PK
++ __complianceClasses_a2PL
++ __depth_a2PM
++ __httpManager_a2PN
++ __lockToken_a2PO
++ __userAgent_a2PP)
++ Data.Functor.<$> (_f_a2PF __allowedMethods'_a2PG))
++{-# INLINE allowedMethods #-}
++baseRequest :: Control.Lens.Type.Lens' DAVContext Request
++baseRequest
++ _f_a2PQ
++ (DAVContext __allowedMethods_a2PR
++ __baseRequest'_a2PS
++ __basicusername_a2PU
++ __basicpassword_a2PV
++ __complianceClasses_a2PW
++ __depth_a2PX
++ __httpManager_a2PY
++ __lockToken_a2PZ
++ __userAgent_a2Q0)
++ = ((\ __baseRequest_a2PT
++ -> DAVContext
++ __allowedMethods_a2PR
++ __baseRequest_a2PT
++ __basicusername_a2PU
++ __basicpassword_a2PV
++ __complianceClasses_a2PW
++ __depth_a2PX
++ __httpManager_a2PY
++ __lockToken_a2PZ
++ __userAgent_a2Q0)
++ Data.Functor.<$> (_f_a2PQ __baseRequest'_a2PS))
++{-# INLINE baseRequest #-}
++basicpassword :: Control.Lens.Type.Lens' DAVContext B.ByteString
++basicpassword
++ _f_a2Q1
++ (DAVContext __allowedMethods_a2Q2
++ __baseRequest_a2Q3
++ __basicusername_a2Q4
++ __basicpassword'_a2Q5
++ __complianceClasses_a2Q7
++ __depth_a2Q8
++ __httpManager_a2Q9
++ __lockToken_a2Qa
++ __userAgent_a2Qb)
++ = ((\ __basicpassword_a2Q6
++ -> DAVContext
++ __allowedMethods_a2Q2
++ __baseRequest_a2Q3
++ __basicusername_a2Q4
++ __basicpassword_a2Q6
++ __complianceClasses_a2Q7
++ __depth_a2Q8
++ __httpManager_a2Q9
++ __lockToken_a2Qa
++ __userAgent_a2Qb)
++ Data.Functor.<$> (_f_a2Q1 __basicpassword'_a2Q5))
++{-# INLINE basicpassword #-}
++basicusername :: Control.Lens.Type.Lens' DAVContext B.ByteString
++basicusername
++ _f_a2Qc
++ (DAVContext __allowedMethods_a2Qd
++ __baseRequest_a2Qe
++ __basicusername'_a2Qf
++ __basicpassword_a2Qh
++ __complianceClasses_a2Qi
++ __depth_a2Qj
++ __httpManager_a2Qk
++ __lockToken_a2Ql
++ __userAgent_a2Qm)
++ = ((\ __basicusername_a2Qg
++ -> DAVContext
++ __allowedMethods_a2Qd
++ __baseRequest_a2Qe
++ __basicusername_a2Qg
++ __basicpassword_a2Qh
++ __complianceClasses_a2Qi
++ __depth_a2Qj
++ __httpManager_a2Qk
++ __lockToken_a2Ql
++ __userAgent_a2Qm)
++ Data.Functor.<$> (_f_a2Qc __basicusername'_a2Qf))
++{-# INLINE basicusername #-}
++complianceClasses ::
++ Control.Lens.Type.Lens' DAVContext [B.ByteString]
++complianceClasses
++ _f_a2Qn
++ (DAVContext __allowedMethods_a2Qo
++ __baseRequest_a2Qp
++ __basicusername_a2Qq
++ __basicpassword_a2Qr
++ __complianceClasses'_a2Qs
++ __depth_a2Qu
++ __httpManager_a2Qv
++ __lockToken_a2Qw
++ __userAgent_a2Qx)
++ = ((\ __complianceClasses_a2Qt
++ -> DAVContext
++ __allowedMethods_a2Qo
++ __baseRequest_a2Qp
++ __basicusername_a2Qq
++ __basicpassword_a2Qr
++ __complianceClasses_a2Qt
++ __depth_a2Qu
++ __httpManager_a2Qv
++ __lockToken_a2Qw
++ __userAgent_a2Qx)
++ Data.Functor.<$> (_f_a2Qn __complianceClasses'_a2Qs))
++{-# INLINE complianceClasses #-}
++depth :: Control.Lens.Type.Lens' DAVContext (Maybe Depth)
++depth
++ _f_a2Qy
++ (DAVContext __allowedMethods_a2Qz
++ __baseRequest_a2QA
++ __basicusername_a2QB
++ __basicpassword_a2QC
++ __complianceClasses_a2QD
++ __depth'_a2QE
++ __httpManager_a2QG
++ __lockToken_a2QH
++ __userAgent_a2QI)
++ = ((\ __depth_a2QF
++ -> DAVContext
++ __allowedMethods_a2Qz
++ __baseRequest_a2QA
++ __basicusername_a2QB
++ __basicpassword_a2QC
++ __complianceClasses_a2QD
++ __depth_a2QF
++ __httpManager_a2QG
++ __lockToken_a2QH
++ __userAgent_a2QI)
++ Data.Functor.<$> (_f_a2Qy __depth'_a2QE))
++{-# INLINE depth #-}
++httpManager :: Control.Lens.Type.Lens' DAVContext Manager
++httpManager
++ _f_a2QJ
++ (DAVContext __allowedMethods_a2QK
++ __baseRequest_a2QL
++ __basicusername_a2QM
++ __basicpassword_a2QN
++ __complianceClasses_a2QO
++ __depth_a2QP
++ __httpManager'_a2QQ
++ __lockToken_a2QS
++ __userAgent_a2QT)
++ = ((\ __httpManager_a2QR
++ -> DAVContext
++ __allowedMethods_a2QK
++ __baseRequest_a2QL
++ __basicusername_a2QM
++ __basicpassword_a2QN
++ __complianceClasses_a2QO
++ __depth_a2QP
++ __httpManager_a2QR
++ __lockToken_a2QS
++ __userAgent_a2QT)
++ Data.Functor.<$> (_f_a2QJ __httpManager'_a2QQ))
++{-# INLINE httpManager #-}
++lockToken ::
++ Control.Lens.Type.Lens' DAVContext (Maybe B.ByteString)
++lockToken
++ _f_a2QU
++ (DAVContext __allowedMethods_a2QV
++ __baseRequest_a2QW
++ __basicusername_a2QX
++ __basicpassword_a2QY
++ __complianceClasses_a2QZ
++ __depth_a2R0
++ __httpManager_a2R1
++ __lockToken'_a2R2
++ __userAgent_a2R4)
++ = ((\ __lockToken_a2R3
++ -> DAVContext
++ __allowedMethods_a2QV
++ __baseRequest_a2QW
++ __basicusername_a2QX
++ __basicpassword_a2QY
++ __complianceClasses_a2QZ
++ __depth_a2R0
++ __httpManager_a2R1
++ __lockToken_a2R3
++ __userAgent_a2R4)
++ Data.Functor.<$> (_f_a2QU __lockToken'_a2R2))
++{-# INLINE lockToken #-}
++userAgent :: Control.Lens.Type.Lens' DAVContext B.ByteString
++userAgent
++ _f_a2R5
++ (DAVContext __allowedMethods_a2R6
++ __baseRequest_a2R7
++ __basicusername_a2R8
++ __basicpassword_a2R9
++ __complianceClasses_a2Ra
++ __depth_a2Rb
++ __httpManager_a2Rc
++ __lockToken_a2Rd
++ __userAgent'_a2Re)
++ = ((\ __userAgent_a2Rf
++ -> DAVContext
++ __allowedMethods_a2R6
++ __baseRequest_a2R7
++ __basicusername_a2R8
++ __basicpassword_a2R9
++ __complianceClasses_a2Ra
++ __depth_a2Rb
++ __httpManager_a2Rc
++ __lockToken_a2Rd
++ __userAgent_a2Rf)
++ Data.Functor.<$> (_f_a2R5 __userAgent'_a2Re))
++{-# INLINE userAgent #-}
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/file-embed_remove-TH.patch b/standalone/no-th/haskell-patches/file-embed_remove-TH.patch
new file mode 100644
index 000000000..e637465e1
--- /dev/null
+++ b/standalone/no-th/haskell-patches/file-embed_remove-TH.patch
@@ -0,0 +1,131 @@
+From cd49a96991dc3dd8867038fa9d426a8ccdb25f8d Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 18:40:48 +0000
+Subject: [PATCH] remove TH
+
+---
+ Data/FileEmbed.hs | 87 ++++---------------------------------------------------
+ 1 file changed, 5 insertions(+), 82 deletions(-)
+
+diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
+index 5617493..ad92cdc 100644
+--- a/Data/FileEmbed.hs
++++ b/Data/FileEmbed.hs
+@@ -17,13 +17,13 @@
+ -- > {-# LANGUAGE TemplateHaskell #-}
+ module Data.FileEmbed
+ ( -- * Embed at compile time
+- embedFile
+- , embedOneFileOf
+- , embedDir
+- , getDir
++ -- embedFile
++ --, embedOneFileOf
++ --, embedDir
++ getDir
+ -- * Inject into an executable
+ #if MIN_VERSION_template_haskell(2,5,0)
+- , dummySpace
++ --, dummySpace
+ #endif
+ , inject
+ , injectFile
+@@ -56,72 +56,11 @@ import Data.ByteString.Unsafe (unsafePackAddressLen)
+ import System.IO.Unsafe (unsafePerformIO)
+ import System.FilePath ((</>))
+
+--- | Embed a single file in your source code.
+---
+--- > import qualified Data.ByteString
+--- >
+--- > myFile :: Data.ByteString.ByteString
+--- > myFile = $(embedFile "dirName/fileName")
+-embedFile :: FilePath -> Q Exp
+-embedFile fp =
+-#if MIN_VERSION_template_haskell(2,7,0)
+- qAddDependentFile fp >>
+-#endif
+- (runIO $ B.readFile fp) >>= bsToExp
+-
+--- | Embed a single existing file in your source code
+--- out of list a list of paths supplied.
+---
+--- > import qualified Data.ByteString
+--- >
+--- > myFile :: Data.ByteString.ByteString
+--- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
+-embedOneFileOf :: [FilePath] -> Q Exp
+-embedOneFileOf ps =
+- (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
+-#if MIN_VERSION_template_haskell(2,7,0)
+- qAddDependentFile path
+-#endif
+- bsToExp content
+- where
+- readExistingFile :: [FilePath] -> IO ( FilePath, B.ByteString )
+- readExistingFile xs = do
+- ys <- filterM doesFileExist xs
+- case ys of
+- (p:_) -> B.readFile p >>= \ c -> return ( p, c )
+- _ -> throw $ ErrorCall "Cannot find file to embed as resource"
+-
+--- | Embed a directory recursively in your source code.
+---
+--- > import qualified Data.ByteString
+--- >
+--- > myDir :: [(FilePath, Data.ByteString.ByteString)]
+--- > myDir = $(embedDir "dirName")
+-embedDir :: FilePath -> Q Exp
+-embedDir fp = do
+- typ <- [t| [(FilePath, B.ByteString)] |]
+- e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
+- return $ SigE e typ
+-
+--- | Get a directory tree in the IO monad.
+ --
+ -- This is the workhorse of 'embedDir'
+ getDir :: FilePath -> IO [(FilePath, B.ByteString)]
+ getDir = fileList
+
+-pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
+-pairToExp _root (path, bs) = do
+-#if MIN_VERSION_template_haskell(2,7,0)
+- qAddDependentFile $ _root ++ '/' : path
+-#endif
+- exp' <- bsToExp bs
+- return $! TupE [LitE $ StringL path, exp']
+-
+-bsToExp :: B.ByteString -> Q Exp
+-bsToExp bs = do
+- helper <- [| stringToBs |]
+- let chars = B8.unpack bs
+- return $! AppE helper $! LitE $! StringL chars
+
+ stringToBs :: String -> B.ByteString
+ stringToBs = B8.pack
+@@ -164,22 +103,6 @@ padSize i =
+ let s = show i
+ in replicate (sizeLen - length s) '0' ++ s
+
+-#if MIN_VERSION_template_haskell(2,5,0)
+-dummySpace :: Int -> Q Exp
+-dummySpace space = do
+- let size = padSize space
+- let start = magic ++ size
+- let chars = LitE $ StringPrimL $
+-#if MIN_VERSION_template_haskell(2,6,0)
+- map (toEnum . fromEnum) $
+-#endif
+- start ++ replicate space '0'
+- let len = LitE $ IntegerL $ fromIntegral $ length start + space
+- upi <- [|unsafePerformIO|]
+- pack <- [|unsafePackAddressLen|]
+- getInner' <- [|getInner|]
+- return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
+-#endif
+
+ inject :: B.ByteString -- ^ bs to inject
+ -> B.ByteString -- ^ original BS containing dummy
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch b/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch
new file mode 100644
index 000000000..83c8ffd2a
--- /dev/null
+++ b/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch
@@ -0,0 +1,394 @@
+From 9a41401d903f160e11d56fff35c24eb59d97885d Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 19:04:40 +0000
+Subject: [PATCH] remove TH
+
+---
+ src/Generics/Deriving/TH.hs | 354 --------------------------------------------
+ 1 file changed, 354 deletions(-)
+
+diff --git a/src/Generics/Deriving/TH.hs b/src/Generics/Deriving/TH.hs
+index 783cb65..9aab713 100644
+--- a/src/Generics/Deriving/TH.hs
++++ b/src/Generics/Deriving/TH.hs
+@@ -19,18 +19,6 @@
+
+ -- Adapted from Generics.Regular.TH
+ module Generics.Deriving.TH (
+-
+- deriveMeta
+- , deriveData
+- , deriveConstructors
+- , deriveSelectors
+-
+-#if __GLASGOW_HASKELL__ < 701
+- , deriveAll
+- , deriveRepresentable0
+- , deriveRep0
+- , simplInstance
+-#endif
+ ) where
+
+ import Generics.Deriving.Base
+@@ -41,124 +29,6 @@ import Language.Haskell.TH.Syntax (Lift(..))
+ import Data.List (intercalate)
+ import Control.Monad
+
+--- | Given the names of a generic class, a type to instantiate, a function in
+--- the class and the default implementation, generates the code for a basic
+--- generic instance.
+-simplInstance :: Name -> Name -> Name -> Name -> Q [Dec]
+-simplInstance cl ty fn df = do
+- i <- reify (genRepName 0 ty)
+- x <- newName "x"
+- let typ = ForallT [PlainTV x] []
+- ((foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT (genRepName 0 ty))
+- (typeVariables i)) `AppT` (VarT x))
+- fmap (: []) $ instanceD (cxt []) (conT cl `appT` conT ty)
+- [funD fn [clause [] (normalB (varE df `appE`
+- (sigE (global 'undefined) (return typ)))) []]]
+-
+-
+--- | Given the type and the name (as string) for the type to derive,
+--- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
+--- instances, and the 'Representable0' instance.
+-deriveAll :: Name -> Q [Dec]
+-deriveAll n =
+- do a <- deriveMeta n
+- b <- deriveRepresentable0 n
+- return (a ++ b)
+-
+--- | Given the type and the name (as string) for the type to derive,
+--- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'
+--- instances.
+-deriveMeta :: Name -> Q [Dec]
+-deriveMeta n =
+- do a <- deriveData n
+- b <- deriveConstructors n
+- c <- deriveSelectors n
+- return (a ++ b ++ c)
+-
+--- | Given a datatype name, derive a datatype and instance of class 'Datatype'.
+-deriveData :: Name -> Q [Dec]
+-deriveData = dataInstance
+-
+--- | Given a datatype name, derive datatypes and
+--- instances of class 'Constructor'.
+-deriveConstructors :: Name -> Q [Dec]
+-deriveConstructors = constrInstance
+-
+--- | Given a datatype name, derive datatypes and instances of class 'Selector'.
+-deriveSelectors :: Name -> Q [Dec]
+-deriveSelectors = selectInstance
+-
+--- | Given the type and the name (as string) for the Representable0 type
+--- synonym to derive, generate the 'Representable0' instance.
+-deriveRepresentable0 :: Name -> Q [Dec]
+-deriveRepresentable0 n = do
+- rep0 <- deriveRep0 n
+- inst <- deriveInst n
+- return $ rep0 ++ inst
+-
+--- | Derive only the 'Rep0' type synonym. Not needed if 'deriveRepresentable0'
+--- is used.
+-deriveRep0 :: Name -> Q [Dec]
+-deriveRep0 n = do
+- i <- reify n
+- fmap (:[]) $ tySynD (genRepName 0 n) (typeVariables i) (rep0Type n)
+-
+-deriveInst :: Name -> Q [Dec]
+-deriveInst t = do
+- i <- reify t
+- let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q)
+- (typeVariables i)
+-#if __GLASGOW_HASKELL__ >= 707
+- let tyIns = TySynInstD ''Rep (TySynEqn [typ t] (typ (genRepName 0 t)))
+-#else
+- let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))
+-#endif
+- fcs <- mkFrom t 1 0 t
+- tcs <- mkTo t 1 0 t
+- liftM (:[]) $
+- instanceD (cxt []) (conT ''Generic `appT` return (typ t))
+- [return tyIns, funD 'from fcs, funD 'to tcs]
+-
+-
+-dataInstance :: Name -> Q [Dec]
+-dataInstance n = do
+- i <- reify n
+- case i of
+- TyConI (DataD _ n _ _ _) -> mkInstance n
+- TyConI (NewtypeD _ n _ _ _) -> mkInstance n
+- _ -> return []
+- where
+- mkInstance n = do
+- ds <- mkDataData n
+- is <- mkDataInstance n
+- return $ [ds,is]
+-
+-constrInstance :: Name -> Q [Dec]
+-constrInstance n = do
+- i <- reify n
+- case i of
+- TyConI (DataD _ n _ cs _) -> mkInstance n cs
+- TyConI (NewtypeD _ n _ c _) -> mkInstance n [c]
+- _ -> return []
+- where
+- mkInstance n cs = do
+- ds <- mapM (mkConstrData n) cs
+- is <- mapM (mkConstrInstance n) cs
+- return $ ds ++ is
+-
+-selectInstance :: Name -> Q [Dec]
+-selectInstance n = do
+- i <- reify n
+- case i of
+- TyConI (DataD _ n _ cs _) -> mkInstance n cs
+- TyConI (NewtypeD _ n _ c _) -> mkInstance n [c]
+- _ -> return []
+- where
+- mkInstance n cs = do
+- ds <- mapM (mkSelectData n) cs
+- is <- mapM (mkSelectInstance n) cs
+- return $ concat (ds ++ is)
+-
+ typeVariables :: Info -> [TyVarBndr]
+ typeVariables (TyConI (DataD _ _ tv _ _)) = tv
+ typeVariables (TyConI (NewtypeD _ _ tv _ _)) = tv
+@@ -179,233 +49,9 @@ genName = mkName . (++"_") . intercalate "_" . map nameBase
+ genRepName :: Int -> Name -> Name
+ genRepName n = mkName . (++"_") . (("Rep" ++ show n) ++) . nameBase
+
+-mkDataData :: Name -> Q Dec
+-mkDataData n = dataD (cxt []) (genName [n]) [] [] []
+-
+-mkConstrData :: Name -> Con -> Q Dec
+-mkConstrData dt (NormalC n _) =
+- dataD (cxt []) (genName [dt, n]) [] [] []
+-mkConstrData dt r@(RecC _ _) =
+- mkConstrData dt (stripRecordNames r)
+-mkConstrData dt (InfixC t1 n t2) =
+- mkConstrData dt (NormalC n [t1,t2])
+-
+-mkSelectData :: Name -> Con -> Q [Dec]
+-mkSelectData dt r@(RecC n fs) = return (map one fs)
+- where one (f, _, _) = DataD [] (genName [dt, n, f]) [] [] []
+-mkSelectData dt _ = return []
+-
+-
+-mkDataInstance :: Name -> Q Dec
+-mkDataInstance n =
+- instanceD (cxt []) (appT (conT ''Datatype) (conT $ genName [n]))
+- [funD 'datatypeName [clause [wildP] (normalB (stringE (nameBase n))) []]
+- ,funD 'moduleName [clause [wildP] (normalB (stringE name)) []]]
+- where
+- name = maybe (error "Cannot fetch module name!") id (nameModule n)
+-
+-instance Lift Fixity where
+- lift Prefix = conE 'Prefix
+- lift (Infix a n) = conE 'Infix `appE` [| a |] `appE` [| n |]
+-
+-instance Lift Associativity where
+- lift LeftAssociative = conE 'LeftAssociative
+- lift RightAssociative = conE 'RightAssociative
+- lift NotAssociative = conE 'NotAssociative
+-
+-mkConstrInstance :: Name -> Con -> Q Dec
+-mkConstrInstance dt (NormalC n _) = mkConstrInstanceWith dt n []
+-mkConstrInstance dt (RecC n _) = mkConstrInstanceWith dt n
+- [ funD 'conIsRecord [clause [wildP] (normalB (conE 'True)) []]]
+-mkConstrInstance dt (InfixC t1 n t2) =
+- do
+- i <- reify n
+- let fi = case i of
+- DataConI _ _ _ f -> convertFixity f
+- _ -> Prefix
+- instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
+- [funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []],
+- funD 'conFixity [clause [wildP] (normalB [| fi |]) []]]
+- where
+- convertFixity (Fixity n d) = Infix (convertDirection d) n
+- convertDirection InfixL = LeftAssociative
+- convertDirection InfixR = RightAssociative
+- convertDirection InfixN = NotAssociative
+-
+-mkConstrInstanceWith :: Name -> Name -> [Q Dec] -> Q Dec
+-mkConstrInstanceWith dt n extra =
+- instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
+- (funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)
+-
+-mkSelectInstance :: Name -> Con -> Q [Dec]
+-mkSelectInstance dt r@(RecC n fs) = return (map one fs) where
+- one (f, _, _) =
+- InstanceD ([]) (AppT (ConT ''Selector) (ConT $ genName [dt, n, f]))
+- [FunD 'selName [Clause [WildP]
+- (NormalB (LitE (StringL (nameBase f)))) []]]
+-mkSelectInstance _ _ = return []
+-
+-rep0Type :: Name -> Q Type
+-rep0Type n =
+- do
+- -- runIO $ putStrLn $ "processing " ++ show n
+- i <- reify n
+- let b = case i of
+- TyConI (DataD _ dt vs cs _) ->
+- (conT ''D1) `appT` (conT $ genName [dt]) `appT`
+- (foldr1' sum (conT ''V1)
+- (map (rep0Con (dt, map tyVarBndrToName vs)) cs))
+- TyConI (NewtypeD _ dt vs c _) ->
+- (conT ''D1) `appT` (conT $ genName [dt]) `appT`
+- (rep0Con (dt, map tyVarBndrToName vs) c)
+- TyConI (TySynD t _ _) -> error "type synonym?"
+- _ -> error "unknown construct"
+- --appT b (conT $ mkName (nameBase n))
+- b where
+- sum :: Q Type -> Q Type -> Q Type
+- sum a b = conT ''(:+:) `appT` a `appT` b
+-
+-
+-rep0Con :: (Name, [Name]) -> Con -> Q Type
+-rep0Con (dt, vs) (NormalC n []) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
+- (conT ''S1 `appT` conT ''NoSelector `appT` conT ''U1)
+-rep0Con (dt, vs) (NormalC n fs) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
+- (foldr1 prod (map (repField (dt, vs) . snd) fs)) where
+- prod :: Q Type -> Q Type -> Q Type
+- prod a b = conT ''(:*:) `appT` a `appT` b
+-rep0Con (dt, vs) r@(RecC n []) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT` conT ''U1
+-rep0Con (dt, vs) r@(RecC n fs) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
+- (foldr1 prod (map (repField' (dt, vs) n) fs)) where
+- prod :: Q Type -> Q Type -> Q Type
+- prod a b = conT ''(:*:) `appT` a `appT` b
+-
+-rep0Con d (InfixC t1 n t2) = rep0Con d (NormalC n [t1,t2])
+-
+---dataDeclToType :: (Name, [Name]) -> Type
+---dataDeclToType (dt, vs) = foldl (\a b -> AppT a (VarT b)) (ConT dt) vs
+-
+-repField :: (Name, [Name]) -> Type -> Q Type
+---repField d t | t == dataDeclToType d = conT ''I
+-repField d t = conT ''S1 `appT` conT ''NoSelector `appT`
+- (conT ''Rec0 `appT` return t)
+-
+-repField' :: (Name, [Name]) -> Name -> (Name, Strict, Type) -> Q Type
+---repField' d ns (_, _, t) | t == dataDeclToType d = conT ''I
+-repField' (dt, vs) ns (f, _, t) = conT ''S1 `appT` conT (genName [dt, ns, f])
+- `appT` (conT ''Rec0 `appT` return t)
+--- Note: we should generate Par0 too, at some point
+-
+-
+-mkFrom :: Name -> Int -> Int -> Name -> Q [Q Clause]
+-mkFrom ns m i n =
+- do
+- -- runIO $ putStrLn $ "processing " ++ show n
+- let wrapE e = lrE m i e
+- i <- reify n
+- let b = case i of
+- TyConI (DataD _ dt vs cs _) ->
+- zipWith (fromCon wrapE ns (dt, map tyVarBndrToName vs)
+- (length cs)) [0..] cs
+- TyConI (NewtypeD _ dt vs c _) ->
+- [fromCon wrapE ns (dt, map tyVarBndrToName vs) 1 0 c]
+- TyConI (TySynD t _ _) -> error "type synonym?"
+- -- [clause [varP (field 0)] (normalB (wrapE $ conE 'K1 `appE` varE (field 0))) []]
+- _ -> error "unknown construct"
+- return b
+-
+-mkTo :: Name -> Int -> Int -> Name -> Q [Q Clause]
+-mkTo ns m i n =
+- do
+- -- runIO $ putStrLn $ "processing " ++ show n
+- let wrapP p = lrP m i p
+- i <- reify n
+- let b = case i of
+- TyConI (DataD _ dt vs cs _) ->
+- zipWith (toCon wrapP ns (dt, map tyVarBndrToName vs)
+- (length cs)) [0..] cs
+- TyConI (NewtypeD _ dt vs c _) ->
+- [toCon wrapP ns (dt, map tyVarBndrToName vs) 1 0 c]
+- TyConI (TySynD t _ _) -> error "type synonym?"
+- -- [clause [wrapP $ conP 'K1 [varP (field 0)]] (normalB $ varE (field 0)) []]
+- _ -> error "unknown construct"
+- return b
+-
+-fromCon :: (Q Exp -> Q Exp) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
+-fromCon wrap ns (dt, vs) m i (NormalC cn []) =
+- clause
+- [conP cn []]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ appE (conE 'M1) $
+- conE 'M1 `appE` (conE 'U1)) []
+-fromCon wrap ns (dt, vs) m i (NormalC cn fs) =
+- -- runIO (putStrLn ("constructor " ++ show ix)) >>
+- clause
+- [conP cn (map (varP . field) [0..length fs - 1])]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE`
+- foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map snd fs))) []
+- where prod x y = conE '(:*:) `appE` x `appE` y
+-fromCon wrap ns (dt, vs) m i r@(RecC cn []) =
+- clause
+- [conP cn []]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` (conE 'U1)) []
+-fromCon wrap ns (dt, vs) m i r@(RecC cn fs) =
+- clause
+- [conP cn (map (varP . field) [0..length fs - 1])]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE`
+- foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map trd fs))) []
+- where prod x y = conE '(:*:) `appE` x `appE` y
+-fromCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
+- fromCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
+-
+-fromField :: (Name, [Name]) -> Int -> Type -> Q Exp
+---fromField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conE 'I `appE` varE (field nr)
+-fromField (dt, vs) nr t = conE 'M1 `appE` (conE 'K1 `appE` varE (field nr))
+-
+-toCon :: (Q Pat -> Q Pat) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
+-toCon wrap ns (dt, vs) m i (NormalC cn []) =
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'M1 [conP 'U1 []]]]]
+- (normalB $ conE cn) []
+-toCon wrap ns (dt, vs) m i (NormalC cn fs) =
+- -- runIO (putStrLn ("constructor " ++ show ix)) >>
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1
+- [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map snd fs))]]]
+- (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
+- where prod x y = conP '(:*:) [x,y]
+-toCon wrap ns (dt, vs) m i r@(RecC cn []) =
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'U1 []]]]
+- (normalB $ conE cn) []
+-toCon wrap ns (dt, vs) m i r@(RecC cn fs) =
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1
+- [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map trd fs))]]]
+- (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
+- where prod x y = conP '(:*:) [x,y]
+-toCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
+- toCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
+-
+-toField :: (Name, [Name]) -> Int -> Type -> Q Pat
+---toField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conP 'I [varP (field nr)]
+-toField (dt, vs) nr t = conP 'M1 [conP 'K1 [varP (field nr)]]
+-
+-
+ field :: Int -> Name
+ field n = mkName $ "f" ++ show n
+
+-lrP :: Int -> Int -> (Q Pat -> Q Pat)
+-lrP 1 0 p = p
+-lrP m 0 p = conP 'L1 [p]
+-lrP m i p = conP 'R1 [lrP (m-1) (i-1) p]
+-
+-lrE :: Int -> Int -> (Q Exp -> Q Exp)
+-lrE 1 0 e = e
+-lrE m 0 e = conE 'L1 `appE` e
+-lrE m i e = conE 'R1 `appE` lrE (m-1) (i-1) e
+
+ trd (_,_,c) = c
+
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch
new file mode 100644
index 000000000..c5c352fe4
--- /dev/null
+++ b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch
@@ -0,0 +1,365 @@
+From f500a9e447912e68c12f011fe97b62e6a6c5c3ce Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 16:16:32 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Hamlet.hs | 310 ++++-----------------------------------------------------
+ 1 file changed, 17 insertions(+), 293 deletions(-)
+
+diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
+index 4f873f4..10d8ba6 100644
+--- a/Text/Hamlet.hs
++++ b/Text/Hamlet.hs
+@@ -11,34 +11,34 @@
+ module Text.Hamlet
+ ( -- * Plain HTML
+ Html
+- , shamlet
+- , shamletFile
+- , xshamlet
+- , xshamletFile
++ --, shamlet
++ --, shamletFile
++ --, xshamlet
++ --, xshamletFile
+ -- * Hamlet
+ , HtmlUrl
+- , hamlet
+- , hamletFile
+- , xhamlet
+- , xhamletFile
++ --, hamlet
++ --, hamletFile
++ --, xhamlet
++ --, xhamletFile
+ -- * I18N Hamlet
+ , HtmlUrlI18n
+- , ihamlet
+- , ihamletFile
++ --, ihamlet
++ --, ihamletFile
+ -- * Type classes
+ , ToAttributes (..)
+ -- * Internal, for making more
+ , HamletSettings (..)
+ , NewlineStyle (..)
+- , hamletWithSettings
+- , hamletFileWithSettings
++ --, hamletWithSettings
++ --, hamletFileWithSettings
+ , defaultHamletSettings
+ , xhtmlHamletSettings
+- , Env (..)
+- , HamletRules (..)
+- , hamletRules
+- , ihamletRules
+- , htmlRules
++ --, Env (..)
++ --, HamletRules (..)
++ --, hamletRules
++ --, ihamletRules
++ --, htmlRules
+ , CloseStyle (..)
+ -- * Used by generated code
+ , condH
+@@ -100,47 +100,9 @@ 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
+
+-bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
+-bindingPattern (BindAs i@(Ident s) b) = do
+- name <- newName s
+- (pattern, scope) <- bindingPattern b
+- return (AsP name pattern, (i, VarE name):scope)
+-bindingPattern (BindVar i@(Ident s))
+- | all isDigit s = do
+- return (LitP $ IntegerL $ read s, [])
+- | otherwise = do
+- name <- newName s
+- return (VarP name, [(i, VarE name)])
+-bindingPattern (BindTuple is) = do
+- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
+- return (TupP patterns, concat scopes)
+-bindingPattern (BindList is) = do
+- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
+- return (ListP patterns, concat scopes)
+-bindingPattern (BindConstr con is) = do
+- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
+- return (ConP (mkConName con) patterns, concat scopes)
+-bindingPattern (BindRecord con fields wild) = do
+- let f (Ident field,b) =
+- do (p,s) <- bindingPattern b
+- return ((mkName field,p),s)
+- (patterns, scopes) <- fmap unzip $ mapM f fields
+- (patterns1, scopes1) <- if wild
+- then bindWildFields con $ map fst fields
+- else return ([],[])
+- return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)
+-
+ mkConName :: DataConstr -> Name
+ mkConName = mkName . conToStr
+
+@@ -148,248 +110,10 @@ conToStr :: DataConstr -> String
+ conToStr (DCUnqualified (Ident x)) = x
+ conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]
+
+--- Wildcards bind all of the unbound fields to variables whose name
+--- matches the field name.
+---
+--- For example: data R = C { f1, f2 :: Int }
+--- C {..} is equivalent to C {f1=f1, f2=f2}
+--- C {f1 = a, ..} is equivalent to C {f1=a, f2=f2}
+--- C {f2 = a, ..} is equivalent to C {f1=f1, f2=a}
+-bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
+-bindWildFields conName fields = do
+- fieldNames <- recordToFieldNames conName
+- let available n = nameBase n `notElem` map unIdent fields
+- let remainingFields = filter available fieldNames
+- let mkPat n = do
+- e <- newName (nameBase n)
+- return ((n,VarP e), (Ident (nameBase n), VarE e))
+- fmap unzip $ mapM mkPat remainingFields
+-
+--- Important note! reify will fail if the record type is defined in the
+--- same module as the reify is used. This means quasi-quoted Hamlet
+--- literals will not be able to use wildcards to match record types
+--- defined in the same module.
+-recordToFieldNames :: DataConstr -> Q [Name]
+-recordToFieldNames conStr = do
+- -- use 'lookupValueName' instead of just using 'mkName' so we reify the
+- -- data constructor and not the type constructor if their names match.
+- Just conName <- lookupValueName $ conToStr conStr
+- DataConI _ _ typeName _ <- reify conName
+- TyConI (DataD _ _ _ cons _) <- reify typeName
+- [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 ((specialOrIdent, VarE 'or):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 :: (Binding, [Doc]) -> Q Match
+- toMatch (idents, inside) = do
+- (pat, extraScope) <- bindingPattern idents
+- let scope' = extraScope ++ scope
+- 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
+- , hrEmbed :: Env -> Exp -> Q Exp
+- }
+-
+-data Env = Env
+- { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
+- , 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
+-
+-strToExp :: String -> Exp
+-strToExp s@(c:_)
+- | all isDigit s = LitE $ IntegerL $ read s
+- | isUpper c = ConE $ mkName s
+- | otherwise = VarE $ mkName s
+-strToExp "" = error "strToExp on empty string"
+
+ -- | Checks for truth in the left value in each pair in the first argument. If
+ -- a true exists, then the corresponding right action is performed. Only the
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch
new file mode 100644
index 000000000..ffcf0027e
--- /dev/null
+++ b/standalone/no-th/haskell-patches/lens_no-TH.patch
@@ -0,0 +1,175 @@
+From 2b5fa1851a84f58b43e7c4224bd5695a32a80de9 Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Wed, 18 Dec 2013 03:27:54 +0000
+Subject: [PATCH] avoid TH
+
+---
+ lens.cabal | 13 +------------
+ src/Control/Lens.hs | 4 ++--
+ src/Control/Lens/Internal/Exception.hs | 30 ------------------------------
+ src/Control/Lens/Prism.hs | 2 --
+ 4 files changed, 3 insertions(+), 46 deletions(-)
+
+diff --git a/lens.cabal b/lens.cabal
+index 8477892..a6ac7a5 100644
+--- a/lens.cabal
++++ b/lens.cabal
+@@ -10,7 +10,7 @@ stability: provisional
+ homepage: http://github.com/ekmett/lens/
+ bug-reports: http://github.com/ekmett/lens/issues
+ copyright: Copyright (C) 2012-2013 Edward A. Kmett
+-build-type: Custom
++build-type: Simple
+ tested-with: GHC == 7.6.3
+ synopsis: Lenses, Folds and Traversals
+ description:
+@@ -173,7 +173,6 @@ library
+ containers >= 0.4.0 && < 0.6,
+ distributive >= 0.3 && < 1,
+ filepath >= 1.2.0.0 && < 1.4,
+- generic-deriving >= 1.4 && < 1.7,
+ ghc-prim,
+ hashable >= 1.1.2.3 && < 1.3,
+ MonadCatchIO-transformers >= 0.3 && < 0.4,
+@@ -235,14 +234,12 @@ library
+ Control.Lens.Review
+ Control.Lens.Setter
+ Control.Lens.Simple
+- Control.Lens.TH
+ Control.Lens.Traversal
+ Control.Lens.Tuple
+ Control.Lens.Type
+ Control.Lens.Wrapped
+ Control.Lens.Zipper
+ Control.Lens.Zoom
+- Control.Monad.Error.Lens
+ Control.Parallel.Strategies.Lens
+ Control.Seq.Lens
+ Data.Array.Lens
+@@ -266,12 +263,8 @@ library
+ Data.Typeable.Lens
+ Data.Vector.Lens
+ Data.Vector.Generic.Lens
+- Generics.Deriving.Lens
+- GHC.Generics.Lens
+ System.Exit.Lens
+ System.FilePath.Lens
+- System.IO.Error.Lens
+- Language.Haskell.TH.Lens
+ Numeric.Lens
+
+ if flag(safe)
+@@ -370,7 +363,6 @@ test-suite doctests
+ deepseq,
+ doctest >= 0.9.1,
+ filepath,
+- generic-deriving,
+ mtl,
+ nats,
+ parallel,
+@@ -396,7 +388,6 @@ benchmark plated
+ comonad,
+ criterion,
+ deepseq,
+- generic-deriving,
+ lens,
+ transformers
+
+@@ -431,7 +422,6 @@ benchmark unsafe
+ comonads-fd,
+ criterion,
+ deepseq,
+- generic-deriving,
+ lens,
+ transformers
+
+@@ -448,6 +438,5 @@ benchmark zipper
+ comonads-fd,
+ criterion,
+ deepseq,
+- generic-deriving,
+ lens,
+ transformers
+diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
+index f7c6548..125153e 100644
+--- a/src/Control/Lens.hs
++++ b/src/Control/Lens.hs
+@@ -59,7 +59,7 @@ module Control.Lens
+ , module Control.Lens.Review
+ , module Control.Lens.Setter
+ , module Control.Lens.Simple
+-#ifndef DISABLE_TEMPLATE_HASKELL
++#if 0
+ , module Control.Lens.TH
+ #endif
+ , module Control.Lens.Traversal
+@@ -89,7 +89,7 @@ import Control.Lens.Reified
+ import Control.Lens.Review
+ import Control.Lens.Setter
+ import Control.Lens.Simple
+-#ifndef DISABLE_TEMPLATE_HASKELL
++#if 0
+ import Control.Lens.TH
+ #endif
+ import Control.Lens.Traversal
+diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs
+index 387203e..bb1ca10 100644
+--- a/src/Control/Lens/Internal/Exception.hs
++++ b/src/Control/Lens/Internal/Exception.hs
+@@ -128,18 +128,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 +147,3 @@ 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/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
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch
new file mode 100644
index 000000000..78cf7be35
--- /dev/null
+++ b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch
@@ -0,0 +1,150 @@
+From 08aa9d495cb486c45998dfad95518c646b5fa8cc Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 16:24:31 +0000
+Subject: [PATCH] remove TH
+
+---
+ Control/Monad/Logger.hs | 109 ++++++++++--------------------------------------
+ 1 file changed, 21 insertions(+), 88 deletions(-)
+
+diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
+index be756d7..d4979f8 100644
+--- a/Control/Monad/Logger.hs
++++ b/Control/Monad/Logger.hs
+@@ -31,31 +31,31 @@ module Control.Monad.Logger
+ , withChannelLogger
+ , NoLoggingT (..)
+ -- * TH logging
+- , logDebug
+- , logInfo
+- , logWarn
+- , logError
+- , logOther
++ --, logDebug
++ --, logInfo
++ --, logWarn
++ --, logError
++ --, logOther
+ -- * TH logging with source
+- , logDebugS
+- , logInfoS
+- , logWarnS
+- , logErrorS
+- , logOtherS
++ --, logDebugS
++ --, logInfoS
++ --, logWarnS
++ --, logErrorS
++ --, logOtherS
+ -- * TH util
+- , liftLoc
++ -- , liftLoc
+ -- * Non-TH logging
+- , logDebugN
+- , logInfoN
+- , logWarnN
+- , logErrorN
+- , logOtherN
++ --, logDebugN
++ --, logInfoN
++ --, logWarnN
++ --, logErrorN
++ --, logOtherN
+ -- * Non-TH logging with source
+- , logDebugNS
+- , logInfoNS
+- , logWarnNS
+- , logErrorNS
+- , logOtherNS
++ --, logDebugNS
++ --, logInfoNS
++ --, logWarnNS
++ --, logErrorNS
++ --, logOtherNS
+ ) where
+
+ import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)
+@@ -115,13 +115,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
+@@ -152,66 +145,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) (pack "") $(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
+-
+--- | Lift a location into an Exp.
+---
+--- Since 0.3.1
+-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:
+---
+--- > $logDebugS "SomeSource" "This is a debug log message"
+-logDebugS :: Q Exp
+-logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]
+-
+--- | See 'logDebugS'
+-logInfoS :: Q Exp
+-logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
+--- | See 'logDebugS'
+-logWarnS :: Q Exp
+-logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
+--- | See 'logDebugS'
+-logErrorS :: Q Exp
+-logErrorS = [|\a b -> monadLoggerLog $(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:
+---
+--- > $logOtherS "SomeSource" "My new level" "This is a log message"
+-logOtherS :: Q Exp
+-logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
+-
+ -- | Monad transformer that disables logging.
+ --
+ -- Since 0.2.4
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/persistent-template_stub-out.patch b/standalone/no-th/haskell-patches/persistent-template_stub-out.patch
new file mode 100644
index 000000000..6b7b62bd4
--- /dev/null
+++ b/standalone/no-th/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/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch b/standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
new file mode 100644
index 000000000..7a66e1fd1
--- /dev/null
+++ b/standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
@@ -0,0 +1,41 @@
+From efd18199fa245e51e6137036062ded8b0b26f78c Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Tue, 17 Dec 2013 18:08:22 +0000
+Subject: [PATCH] disable TH
+
+---
+ Database/Persist/Sql/Raw.hs | 4 +---
+ 1 file changed, 1 insertion(+), 3 deletions(-)
+
+diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
+index 73189dd..d432790 100644
+--- a/Database/Persist/Sql/Raw.hs
++++ b/Database/Persist/Sql/Raw.hs
+@@ -11,7 +11,7 @@ import Data.IORef (writeIORef, readIORef, newIORef)
+ import Control.Exception (throwIO)
+ import Control.Monad (when, liftM)
+ import Data.Text (Text, pack)
+-import Control.Monad.Logger (logDebugS)
++--import Control.Monad.Logger (logDebugS)
+ import Data.Int (Int64)
+ import Control.Monad.Trans.Class (lift)
+ import qualified Data.Text as T
+@@ -22,7 +22,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m)
+ -> [PersistValue]
+ -> Source m [PersistValue]
+ rawQuery sql vals = do
+- lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
+ conn <- lift askSqlConn
+ bracketP
+ (getStmtConn conn sql)
+@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y
+
+ rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
+ rawExecuteCount sql vals = do
+- $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
+ stmt <- getStmt sql
+ res <- liftIO $ stmtExecute stmt vals
+ liftIO $ stmtReset stmt
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch b/standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch
new file mode 100644
index 000000000..9298c6833
--- /dev/null
+++ b/standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch
@@ -0,0 +1,24 @@
+From c9f40fae5f7f44c7c28b243bf924606ef4f26700 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 04:17:59 +0000
+Subject: [PATCH] avoid TH
+
+---
+ process-conduit.cabal | 1 -
+ 1 file changed, 1 deletion(-)
+
+diff --git a/process-conduit.cabal b/process-conduit.cabal
+index c917d90..4410e2c 100644
+--- a/process-conduit.cabal
++++ b/process-conduit.cabal
+@@ -24,7 +24,6 @@ source-repository head
+
+ library
+ exposed-modules: Data.Conduit.Process
+- System.Process.QQ
+
+ build-depends: base == 4.*
+ , template-haskell >= 2.4
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch b/standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch
new file mode 100644
index 000000000..45397f3e5
--- /dev/null
+++ b/standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch
@@ -0,0 +1,26 @@
+From 392602f5ff14c0b5a801397d075ddcbcd890aa83 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Thu, 18 Apr 2013 17:50:59 -0400
+Subject: [PATCH] fix cross build
+
+---
+ src/Data/Profunctor/Unsafe.hs | 3 ---
+ 1 file changed, 3 deletions(-)
+
+diff --git a/src/Data/Profunctor/Unsafe.hs b/src/Data/Profunctor/Unsafe.hs
+index 025c7c4..0249274 100644
+--- a/src/Data/Profunctor/Unsafe.hs
++++ b/src/Data/Profunctor/Unsafe.hs
+@@ -40,9 +40,6 @@ import Data.Tagged
+ import Prelude hiding (id,(.),sequence)
+ import Unsafe.Coerce
+
+-{-# ANN module "Hlint: ignore Redundant lambda" #-}
+-{-# ANN module "Hlint: ignore Collapse lambdas" #-}
+-
+ infixr 9 #.
+ infixl 8 .#
+
+--
+1.8.2.rc3
+
diff --git a/standalone/no-th/haskell-patches/reflection_remove-TH.patch b/standalone/no-th/haskell-patches/reflection_remove-TH.patch
new file mode 100644
index 000000000..7c63f05fc
--- /dev/null
+++ b/standalone/no-th/haskell-patches/reflection_remove-TH.patch
@@ -0,0 +1,113 @@
+From 22c68b43dce437b3c22956f5a968f1b886e60e0c Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 19:15:16 +0000
+Subject: [PATCH] remove TH
+
+---
+ fast/Data/Reflection.hs | 80 +------------------------------------------------
+ 1 file changed, 1 insertion(+), 79 deletions(-)
+
+diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs
+index 119d773..cf99efa 100644
+--- a/fast/Data/Reflection.hs
++++ b/fast/Data/Reflection.hs
+@@ -58,7 +58,7 @@ module Data.Reflection
+ , Given(..)
+ , give
+ -- * Template Haskell reflection
+- , int, nat
++ --, int, nat
+ -- * Useful compile time naturals
+ , Z, D, SD, PD
+ ) where
+@@ -151,87 +151,9 @@ instance Reifies n Int => Reifies (PD n) Int where
+ reflect = (\n -> n + n - 1) <$> retagPD reflect
+ {-# INLINE reflect #-}
+
+--- | This can be used to generate a template haskell splice for a type level version of a given 'int'.
+---
+--- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used
+--- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.
+-int :: Int -> TypeQ
+-int n = case quotRem n 2 of
+- (0, 0) -> conT ''Z
+- (q,-1) -> conT ''PD `appT` int q
+- (q, 0) -> conT ''D `appT` int q
+- (q, 1) -> conT ''SD `appT` int q
+- _ -> error "ghc is bad at math"
+-
+--- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate
+--- a negative number results in a compile time error. Also the resulting sequence will consist entirely of
+--- Z, D, and SD constructors representing the number in zeroless binary.
+-nat :: Int -> TypeQ
+-nat n
+- | n >= 0 = int n
+- | otherwise = error "nat: negative"
+-
+-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704
+-instance Show (Q a)
+-instance Eq (Q a)
+-#endif
+-instance Num a => Num (Q a) where
+- (+) = liftM2 (+)
+- (*) = liftM2 (*)
+- (-) = liftM2 (-)
+- negate = fmap negate
+- abs = fmap abs
+- signum = fmap signum
+- fromInteger = return . fromInteger
+-
+-instance Fractional a => Fractional (Q a) where
+- (/) = liftM2 (/)
+- recip = fmap recip
+- fromRational = return . fromRational
+-
+--- | This permits the use of $(5) as a type splice.
+-instance Num Type where
+-#ifdef USE_TYPE_LITS
+- a + b = AppT (AppT (VarT ''(+)) a) b
+- a * b = AppT (AppT (VarT ''(*)) a) b
+-#if MIN_VERSION_base(4,8,0)
+- a - b = AppT (AppT (VarT ''(-)) a) b
+-#else
+- (-) = error "Type.(-): undefined"
+-#endif
+- fromInteger = LitT . NumTyLit
+-#else
+- (+) = error "Type.(+): undefined"
+- (*) = error "Type.(*): undefined"
+- (-) = error "Type.(-): undefined"
+- fromInteger n = case quotRem n 2 of
+- (0, 0) -> ConT ''Z
+- (q,-1) -> ConT ''PD `AppT` fromInteger q
+- (q, 0) -> ConT ''D `AppT` fromInteger q
+- (q, 1) -> ConT ''SD `AppT` fromInteger q
+- _ -> error "ghc is bad at math"
+-#endif
+- abs = error "Type.abs"
+- signum = error "Type.signum"
+-
+ plus, times, minus :: Num a => a -> a -> a
+ plus = (+)
+ times = (*)
+ minus = (-)
+ fract :: Fractional a => a -> a -> a
+ fract = (/)
+-
+--- | This permits the use of $(5) as an expression splice.
+-instance Num Exp where
+- a + b = AppE (AppE (VarE 'plus) a) b
+- a * b = AppE (AppE (VarE 'times) a) b
+- a - b = AppE (AppE (VarE 'minus) a) b
+- negate = AppE (VarE 'negate)
+- signum = AppE (VarE 'signum)
+- abs = AppE (VarE 'abs)
+- fromInteger = LitE . IntegerL
+-
+-instance Fractional Exp where
+- a / b = AppE (AppE (VarE 'fract) a) b
+- recip = AppE (VarE 'recip)
+- fromRational = LitE . RationalL
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch b/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch
new file mode 100644
index 000000000..5bf57d527
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0002-expose-modules-used-by-TH.patch
@@ -0,0 +1,26 @@
+From 23e96f0d948e7a26febf1745a4c373faf579c8ee Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Mon, 15 Apr 2013 16:32:31 -0400
+Subject: [PATCH] expose modules used by TH
+
+---
+ shakespeare-css.cabal | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal
+index de2497b..468353a 100644
+--- a/shakespeare-css.cabal
++++ b/shakespeare-css.cabal
+@@ -39,8 +39,8 @@ library
+
+ exposed-modules: Text.Cassius
+ Text.Lucius
+- other-modules: Text.MkSizeType
+ Text.Css
++ other-modules: Text.MkSizeType
+ Text.IndentToBrace
+ Text.CssCommon
+ ghc-options: -Wall
+--
+1.8.2.rc3
+
diff --git a/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch b/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch
new file mode 100644
index 000000000..c57eb01c6
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-css_1.0.2_0003-remove-more-TH.patch
@@ -0,0 +1,351 @@
+From 8c9e29d3716bcbbfc3144cf1f8af0569212a5878 Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Tue, 17 Dec 2013 06:33:03 +0000
+Subject: [PATCH] remove more TH
+
+---
+ Text/Cassius.hs | 23 ---------
+ Text/Css.hs | 151 ------------------------------------------------------
+ Text/CssCommon.hs | 4 --
+ Text/Lucius.hs | 46 +----------------
+ 4 files changed, 2 insertions(+), 222 deletions(-)
+
+diff --git a/Text/Cassius.hs b/Text/Cassius.hs
+index ce05374..ae56b0a 100644
+--- a/Text/Cassius.hs
++++ b/Text/Cassius.hs
+@@ -13,10 +13,6 @@ module Text.Cassius
+ , renderCss
+ , renderCssUrl
+ -- * Parsing
+- , cassius
+- , cassiusFile
+- , cassiusFileDebug
+- , cassiusFileReload
+ -- * ToCss instances
+ -- ** Color
+ , Color (..)
+@@ -27,11 +23,8 @@ module Text.Cassius
+ , AbsoluteUnit (..)
+ , AbsoluteSize (..)
+ , absoluteSize
+- , EmSize (..)
+- , ExSize (..)
+ , PercentageSize (..)
+ , percentageSize
+- , PixelSize (..)
+ -- * Internal
+ , cassiusUsedIdentifiers
+ ) where
+@@ -42,25 +35,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+ import Language.Haskell.TH.Syntax
+ import qualified Data.Text.Lazy as TL
+ import Text.CssCommon
+-import Text.Lucius (lucius)
+ import qualified Text.Lucius
+ import Text.IndentToBrace (i2b)
+
+-cassius :: QuasiQuoter
+-cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }
+-
+-cassiusFile :: FilePath -> Q Exp
+-cassiusFile fp = do
+-#ifdef GHC_7_4
+- qAddDependentFile fp
+-#endif
+- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
+- quoteExp cassius contents
+-
+-cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp
+-cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels
+-cassiusFileReload = cassiusFileDebug
+-
+ -- | 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 fb06dd2..954e574 100644
+--- a/Text/Css.hs
++++ b/Text/Css.hs
+@@ -169,22 +169,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =
+ (scope, rest') = go rest
+ go' (Attr k v) = k ++ v
+
+-cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
+- -> Q Exp
+- -> Parser [TopLevel Unresolved]
+- -> 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 :: HasLeadingSpace
+ -> [Contents]
+ -> [Contents]
+@@ -290,18 +274,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|]
+- c VTMixin = [|CDMixin|]
+-
+ getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]
+ getVars _ ContentRaw{} = return []
+ getVars scope (ContentVar d) =
+@@ -345,111 +317,8 @@ compressBlock (Block x y blocks mixins) =
+ cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
+ cc (a:b) = a : cc b
+
+-blockToMixin :: Name
+- -> Scope
+- -> Block Unresolved
+- -> Q Exp
+-blockToMixin r scope (Block _sel props subblocks mixins) =
+- [|Mixin
+- { mixinAttrs = concat
+- $ $(listE $ map go props)
+- : map mixinAttrs $mixinsE
+- -- FIXME too many complications to implement sublocks for now...
+- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) []
+- }|]
+- {-
+- . foldr (.) id $(listE $ map subGo subblocks)
+- . (concatMap mixinBlocks $mixinsE ++)
+- |]
+- -}
+- where
+- mixinsE = return $ ListE $ map (derefToExp []) mixins
+- go (Attr x y) = conE 'Attr
+- `appE` (contentsToBuilder r scope x)
+- `appE` (contentsToBuilder r scope y)
+- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d
+-
+-blockToCss :: Name
+- -> Scope
+- -> Block Unresolved
+- -> Q Exp
+-blockToCss r scope (Block sel props subblocks mixins) =
+- [|((Block
+- { blockSelector = $(selectorToBuilder r scope sel)
+- , blockAttrs = concat
+- $ $(listE $ map go props)
+- : map mixinAttrs $mixinsE
+- , blockBlocks = ()
+- , blockMixins = ()
+- } :: Block Resolved):)
+- . foldr (.) id $(listE $ map subGo subblocks)
+- . (concatMap mixinBlocks $mixinsE ++)
+- |]
+- where
+- mixinsE = return $ ListE $ map (derefToExp []) mixins
+- go (Attr x y) = conE 'Attr
+- `appE` (contentsToBuilder r scope x)
+- `appE` (contentsToBuilder r scope y)
+- subGo (hls, Block sel' b c d) =
+- blockToCss r scope $ Block sel'' b c d
+- where
+- sel'' = combineSelectors hls sel sel'
+-
+-selectorToBuilder :: Name -> Scope -> [Contents] -> 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))
+-contentToBuilder _ _ ContentMixin{} = error "contentToBuilder on ContentMixin"
+-
+ type Scope = [(String, String)]
+
+-topLevelsToCassius :: [TopLevel Unresolved]
+- -> 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 TopBlock ($(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 <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
+- es <- go r scope rest
+- return $ e : es
+- go r scope (TopAtDecl dec cs:rest) = do
+- e <- [|(:) $ TopAtDecl $(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 Unresolved]
+- -> 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
+@@ -518,23 +387,3 @@ renderBlock haveWhiteSpace indent (Block sel attrs () ())
+ | haveWhiteSpace = fromString ";\n"
+ | otherwise = singleton ';'
+
+-instance Lift Mixin where
+- lift (Mixin a b) = [|Mixin a b|]
+-instance Lift (Attr Unresolved) where
+- lift (Attr k v) = [|Attr k v :: Attr Unresolved |]
+-instance Lift (Attr Resolved) where
+- lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]
+-
+-liftBuilder :: Builder -> Q Exp
+-liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]
+-
+-instance Lift Content where
+- lift (ContentRaw s) = [|ContentRaw s|]
+- lift (ContentVar d) = [|ContentVar d|]
+- lift (ContentUrl d) = [|ContentUrl d|]
+- lift (ContentUrlParam d) = [|ContentUrlParam d|]
+- lift (ContentMixin m) = [|ContentMixin m|]
+-instance Lift (Block Unresolved) where
+- lift (Block a b c d) = [|Block a b c d|]
+-instance Lift (Block Resolved) where
+- lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]
+diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs
+index 719e0a8..8c40e8c 100644
+--- a/Text/CssCommon.hs
++++ b/Text/CssCommon.hs
+@@ -1,4 +1,3 @@
+-{-# LANGUAGE TemplateHaskell #-}
+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+ {-# LANGUAGE FlexibleInstances #-}
+ {-# LANGUAGE CPP #-}
+@@ -156,6 +155,3 @@ showSize :: Rational -> String -> String
+ showSize value' unit = printf "%f" value ++ unit
+ where value = fromRational value' :: Double
+
+-mkSizeType "EmSize" "em"
+-mkSizeType "ExSize" "ex"
+-mkSizeType "PixelSize" "px"
+diff --git a/Text/Lucius.hs b/Text/Lucius.hs
+index c2c4352..8b2bb9c 100644
+--- a/Text/Lucius.hs
++++ b/Text/Lucius.hs
+@@ -8,13 +8,9 @@
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Lucius
+ ( -- * Parsing
+- lucius
+- , luciusFile
+- , luciusFileDebug
+- , luciusFileReload
+ -- ** Mixins
+- , luciusMixin
+- , Mixin
++ -- luciusMixin
++ Mixin
+ -- ** Runtime
+ , luciusRT
+ , luciusRT'
+@@ -40,11 +36,8 @@ module Text.Lucius
+ , AbsoluteUnit (..)
+ , AbsoluteSize (..)
+ , absoluteSize
+- , EmSize (..)
+- , ExSize (..)
+ , PercentageSize (..)
+ , percentageSize
+- , PixelSize (..)
+ -- * Internal
+ , parseTopLevels
+ , luciusUsedIdentifiers
+@@ -66,18 +59,6 @@ import Data.Monoid (mconcat)
+ import Data.List (isSuffixOf)
+ import Control.Arrow (second)
+
+--- |
+---
+--- >>> renderCss ([lucius|foo{bar:baz}|] undefined)
+--- "foo{bar:baz}"
+-lucius :: QuasiQuoter
+-lucius = QuasiQuoter { quoteExp = luciusFromString }
+-
+-luciusFromString :: String -> Q Exp
+-luciusFromString s =
+- topLevelsToCassius
+- $ either (error . show) id $ parse parseTopLevels s s
+-
+ whiteSpace :: Parser ()
+ whiteSpace = many whiteSpace1 >> return ()
+
+@@ -217,17 +198,6 @@ parseComment = do
+ _ <- manyTill anyChar $ try $ string "*/"
+ return $ ContentRaw ""
+
+-luciusFile :: FilePath -> Q Exp
+-luciusFile fp = do
+-#ifdef GHC_7_4
+- qAddDependentFile fp
+-#endif
+- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
+- luciusFromString contents
+-
+-luciusFileDebug, luciusFileReload :: FilePath -> Q Exp
+-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
+-luciusFileReload = luciusFileDebug
+
+ parseTopLevels :: Parser [TopLevel Unresolved]
+ parseTopLevels =
+@@ -376,15 +346,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $
+ -- creating systems like yesod devel.
+ luciusUsedIdentifiers :: String -> [(Deref, VarType)]
+ luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels
+-
+-luciusMixin :: QuasiQuoter
+-luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }
+-
+-luciusMixinFromString :: String -> Q Exp
+-luciusMixinFromString s' = do
+- r <- newName "_render"
+- case fmap compressBlock $ parse parseBlock s s of
+- Left e -> error $ show e
+- Right block -> blockToMixin r [] block
+- where
+- s = concat ["mixin{", s', "}"]
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch
new file mode 100644
index 000000000..3c6924039
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch
@@ -0,0 +1,215 @@
+From 57ad7d1512a3144fd0b00f9796d5fd9e0ea86852 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 16:30:59 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Shakespeare/I18N.hs | 178 ++---------------------------------------------
+ 1 file changed, 4 insertions(+), 174 deletions(-)
+
+diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
+index 2077914..2289214 100644
+--- a/Text/Shakespeare/I18N.hs
++++ b/Text/Shakespeare/I18N.hs
+@@ -51,10 +51,10 @@
+ --
+ -- You can also adapt those instructions for use with other systems.
+ module Text.Shakespeare.I18N
+- ( mkMessage
+- , mkMessageFor
+- , mkMessageVariant
+- , RenderMessage (..)
++ --( mkMessage
++ --, mkMessageFor
++ ---, mkMessageVariant
++ ( RenderMessage (..)
+ , ToMessage (..)
+ , SomeMessage (..)
+ , Lang
+@@ -105,143 +105,6 @@ instance RenderMessage master Text where
+ -- | an RFC1766 / ISO 639-1 language code (eg, @fr@, @en-GB@, etc).
+ type Lang = Text
+
+--- |generate translations from translation files
+---
+--- This function will:
+---
+--- 1. look in the supplied subdirectory for files ending in @.msg@
+---
+--- 2. generate a type based on the constructors found
+---
+--- 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
+@@ -257,39 +120,6 @@ varName a y =
+ upper (x:xs) = toUpper x : xs
+ upper [] = []
+
+-checkDef :: [SDef] -> [Def] -> Q ()
+-checkDef x y =
+- go (sortBy (comparing sconstr) x) (sortBy (comparing constr) y)
+- where
+- go _ [] = return ()
+- go [] (b:_) = error $ "Extra message constructor: " ++ constr b
+- go (a:as) (b:bs)
+- | sconstr a < constr b = go as (b:bs)
+- | sconstr a > constr b = error $ "Extra message constructor: " ++ constr b
+- | otherwise = do
+- go' (svars a) (vars b)
+- go as bs
+- go' ((an, at):as) ((bn, mbt):bs)
+- | an /= bn = error "Mismatched variable names"
+- | otherwise =
+- case mbt of
+- Nothing -> go' as bs
+- Just bt
+- | at == bt -> go' as bs
+- | otherwise -> error "Mismatched variable types"
+- go' [] [] = return ()
+- go' _ _ = error "Mistmached variable count"
+-
+-toSDefs :: [Def] -> Q [SDef]
+-toSDefs = mapM toSDef
+-
+-toSDef :: Def -> Q SDef
+-toSDef d = do
+- vars' <- mapM go $ vars d
+- return $ SDef (constr d) vars' (content d)
+- where
+- go (a, Just b) = return (a, b)
+- go (a, Nothing) = error $ "Main language missing type for " ++ show (constr d, a)
+
+ data SDef = SDef
+ { sconstr :: String
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch
new file mode 100644
index 000000000..52b4b3b7c
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch
@@ -0,0 +1,316 @@
+From be50798c9abc22648a0a3eb81db462abea79698c Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 16:47:03 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Coffee.hs | 56 ++++-----------------------------------------
+ Text/Julius.hs | 67 +++++++++---------------------------------------------
+ Text/Roy.hs | 51 ++++-------------------------------------
+ Text/TypeScript.hs | 51 ++++-------------------------------------
+ 4 files changed, 24 insertions(+), 201 deletions(-)
+
+diff --git a/Text/Coffee.hs b/Text/Coffee.hs
+index 488c81b..61db85b 100644
+--- a/Text/Coffee.hs
++++ b/Text/Coffee.hs
+@@ -51,13 +51,13 @@ 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
++ -- coffee
++ --, coffeeFile
++ --, coffeeFileReload
++ --, coffeeFileDebug
+
+ #ifdef TEST_EXPORT
+- , coffeeSettings
++ --, coffeeSettings
+ #endif
+ ) where
+
+@@ -65,49 +65,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+ 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 = ""
+- , wrapInsertionAddParens = False
+- }
+- }
+- }
+-
+--- | 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 ec30690..5b5a075 100644
+--- a/Text/Julius.hs
++++ b/Text/Julius.hs
+@@ -14,17 +14,17 @@ 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
++ -- js
++ -- julius
++ -- juliusFile
++ -- jsFile
++ --, juliusFileDebug
++ --, jsFileDebug
++ --, juliusFileReload
++ --, jsFileReload
+
+ -- * Datatypes
+- , JavascriptUrl
++ JavascriptUrl
+ , Javascript (..)
+ , RawJavascript (..)
+
+@@ -37,9 +37,9 @@ module Text.Julius
+ , renderJavascriptUrl
+
+ -- ** internal, used by 'Text.Coffee'
+- , javascriptSettings
++ --, javascriptSettings
+ -- ** internal
+- , juliusUsedIdentifiers
++ --, juliusUsedIdentifiers
+ , asJavascriptUrl
+ ) where
+
+@@ -102,48 +102,3 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText
+ instance RawJS Builder where rawJS = RawJavascript
+ instance RawJS Bool where rawJS = RawJavascript . unJavascript . 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)]
+-juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings
+diff --git a/Text/Roy.hs b/Text/Roy.hs
+index 8bffc5a..8bf2a09 100644
+--- a/Text/Roy.hs
++++ b/Text/Roy.hs
+@@ -39,12 +39,12 @@ 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
++ -- roy
++ --, royFile
++ --, royFileReload
+
+ #ifdef TEST_EXPORT
+- , roySettings
++ --, roySettings
+ #endif
+ ) where
+
+@@ -53,46 +53,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", "--browser"]
+- , preEscapeIgnoreBalanced = "'\""
+- , preEscapeIgnoreLine = "//"
+- , wrapInsertion = Just WrapInsertion {
+- wrapInsertionIndent = Just " "
+- , wrapInsertionStartBegin = "(\\"
+- , wrapInsertionSeparator = " "
+- , wrapInsertionStartClose = " ->\n"
+- , wrapInsertionEnd = ")"
+- , wrapInsertionAddParens = True
+- }
+- }
+- }
+-
+--- | 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 70c8820..5be994a 100644
+--- a/Text/TypeScript.hs
++++ b/Text/TypeScript.hs
+@@ -57,12 +57,12 @@ module Text.TypeScript
+ -- ** Template-Reading Functions
+ -- | These QuasiQuoter and Template Haskell methods return values of
+ -- type @'JavascriptUrl' url@. See the Yesod book for details.
+- tsc
+- , typeScriptFile
+- , typeScriptFileReload
++ -- tsc
++ --, typeScriptFile
++ --, typeScriptFileReload
+
+ #ifdef TEST_EXPORT
+- , typeScriptSettings
++ --, typeScriptSettings
+ #endif
+ ) where
+
+@@ -71,46 +71,3 @@ 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 = "})"
+- , wrapInsertionAddParens = False
+- }
+- }
+- }
+-
+--- | Read inline, quasiquoted TypeScript
+-tsc :: QuasiQuoter
+-tsc = QuasiQuoter { quoteExp = \s -> do
+- rs <- typeScriptSettings
+- quoteExp (shakespeare rs) s
+- }
+-
+--- | Read in a TypeScript 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.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch
new file mode 100644
index 000000000..4af0995bd
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch
@@ -0,0 +1,153 @@
+From f94ab5c4fe8f01cb9353a9d246e8f7c48475d834 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 04:10:23 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Shakespeare/Text.hs | 125 +++++------------------------------------------
+ 1 file changed, 11 insertions(+), 114 deletions(-)
+
+diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs
+index 738164b..65818ee 100644
+--- a/Text/Shakespeare/Text.hs
++++ b/Text/Shakespeare/Text.hs
+@@ -7,18 +7,18 @@ module Text.Shakespeare.Text
+ ( TextUrl
+ , ToText (..)
+ , renderTextUrl
+- , stext
+- , text
+- , textFile
+- , textFileDebug
+- , textFileReload
+- , st -- | strict text
+- , lt -- | lazy text, same as stext :)
++ --, stext
++ --, text
++ --, textFile
++ --, textFileDebug
++ --, textFileReload
++ --, st -- | strict text
++ --, lt -- | lazy text, same as stext :)
+ -- * Yesod code generation
+- , codegen
+- , codegenSt
+- , codegenFile
+- , codegenFileReload
++ --, codegen
++ --, codegenSt
++ --, codegenFile
++ --, codegenFileReload
+ ) where
+
+ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+@@ -43,106 +43,3 @@ instance ToText TL.Text where toText = fromLazyText
+ instance ToText Int32 where toText = toText . show
+ instance ToText Int64 where toText = toText . show
+
+-settings :: Q ShakespeareSettings
+-settings = do
+- toTExp <- [|toText|]
+- wrapExp <- [|id|]
+- unWrapExp <- [|id|]
+- return $ defaultShakespeareSettings { toBuilder = toTExp
+- , wrap = wrapExp
+- , unwrap = unWrapExp
+- }
+-
+-
+-stext, lt, st, text :: QuasiQuoter
+-stext =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- settings
+- render <- [|toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-lt = stext
+-
+-st =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- settings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-
+-text = QuasiQuoter { quoteExp = \s -> do
+- rs <- settings
+- quoteExp (shakespeare rs) $ filter (/='\r') s
+- }
+-
+-
+-textFile :: FilePath -> Q Exp
+-textFile fp = do
+- rs <- settings
+- shakespeareFile rs fp
+-
+-
+-textFileDebug :: FilePath -> Q Exp
+-textFileDebug = textFileReload
+-{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-}
+-
+-textFileReload :: FilePath -> Q Exp
+-textFileReload fp = do
+- rs <- settings
+- shakespeareFileReload rs fp
+-
+--- | codegen is designed for generating Yesod code, including templates
+--- So it uses different interpolation characters that won't clash with templates.
+-codegenSettings :: Q ShakespeareSettings
+-codegenSettings = do
+- toTExp <- [|toText|]
+- wrapExp <- [|id|]
+- unWrapExp <- [|id|]
+- return $ defaultShakespeareSettings { toBuilder = toTExp
+- , wrap = wrapExp
+- , unwrap = unWrapExp
+- , varChar = '~'
+- , urlChar = '*'
+- , intChar = '&'
+- , justVarInterpolation = True -- always!
+- }
+-
+--- | codegen is designed for generating Yesod code, including templates
+--- So it uses different interpolation characters that won't clash with templates.
+--- You can use the normal text quasiquoters to generate code
+-codegen :: QuasiQuoter
+-codegen =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- codegenSettings
+- render <- [|toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-
+--- | Generates strict Text
+--- codegen is designed for generating Yesod code, including templates
+--- So it uses different interpolation characters that won't clash with templates.
+-codegenSt :: QuasiQuoter
+-codegenSt =
+- QuasiQuoter { quoteExp = \s -> do
+- rs <- codegenSettings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFromString rs { justVarInterpolation = True } s
+- return (render `AppE` rendered)
+- }
+-
+-codegenFileReload :: FilePath -> Q Exp
+-codegenFileReload fp = do
+- rs <- codegenSettings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp
+- return (render `AppE` rendered)
+-
+-codegenFile :: FilePath -> Q Exp
+-codegenFile fp = do
+- rs <- codegenSettings
+- render <- [|TL.toStrict . toLazyText|]
+- rendered <- shakespeareFile rs{ justVarInterpolation = True } fp
+- return (render `AppE` rendered)
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch
new file mode 100644
index 000000000..51443b5d4
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch
@@ -0,0 +1,26 @@
+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 | 3 +++
+ 1 file changed, 3 insertions(+)
+
+diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
+index 9eb06a2..1290ab1 100644
+--- a/Text/Shakespeare.hs
++++ b/Text/Shakespeare.hs
+@@ -23,6 +23,9 @@ module Text.Shakespeare
+ , Deref
+ , Parser
+
++ -- used by TH
++ , pack'
++
+ #ifdef TEST_EXPORT
+ , preFilter
+ #endif
+--
+1.7.10.4
+
diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch
new file mode 100644
index 000000000..38c2cb012
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch
@@ -0,0 +1,223 @@
+From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 06:17:26 +0000
+Subject: [PATCH 2/2] remove TH
+
+---
+ Text/Shakespeare.hs | 131 +++--------------------------------------------
+ Text/Shakespeare/Base.hs | 28 ----------
+ 2 files changed, 6 insertions(+), 153 deletions(-)
+
+diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
+index f908ff4..55cd1d1 100644
+--- a/Text/Shakespeare.hs
++++ b/Text/Shakespeare.hs
+@@ -12,14 +12,14 @@ module Text.Shakespeare
+ , WrapInsertion (..)
+ , PreConversion (..)
+ , defaultShakespeareSettings
+- , shakespeare
+- , shakespeareFile
+- , shakespeareFileReload
++ --, shakespeare
++ --, shakespeareFile
++ -- , shakespeareFileReload
+ -- * low-level
+- , shakespeareFromString
+- , shakespeareUsedIdentifiers
++ -- , shakespeareFromString
++ --, shakespeareUsedIdentifiers
+ , RenderUrl
+- , VarType
++ --, VarType
+ , Deref
+ , Parser
+
+@@ -151,38 +151,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 wp) =
+- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]
+-
+-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)
+@@ -346,77 +314,12 @@ 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 $ (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 Nothing r $
+-#ifdef WINDOWS
+- filter (/='\r')
+-#endif
+- 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)]
+-getVars ContentRaw{} = []
+-getVars (ContentVar d) = [(d, VTPlain)]
+-getVars (ContentUrl d) = [(d, VTUrl)]
+-getVars (ContentUrlParam d) = [(d, VTUrlParam)]
+-getVars (ContentMix d) = [(d, VTMixin)]
+
+ data VarExp url = EPlain Builder
+ | EUrl url
+ | EUrlParam (url, [(TS.Text, TS.Text)])
+ | EMixin (Shakespeare url)
+
+--- | Determine which identifiers are used by the given template, useful for
+--- creating systems like yesod devel.
+-shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
+-shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
+-
+ type MTime = UTCTime
+
+ {-# NOINLINE reloadMapRef #-}
+@@ -432,28 +335,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
+ insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
+ (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))
+
+-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
+-shakespeareFileReload settings fp = do
+- str <- readFileQ fp
+- s <- qRunIO $ preFilter (Just fp) settings str
+- let b = shakespeareUsedIdentifiers settings s
+- c <- mapM vtToExp b
+- rt <- [|shakespeareRuntime settings fp|]
+- wrap' <- [|\x -> $(return $ wrap settings) . x|]
+- return $ wrap' `AppE` (rt `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 $
+- InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]
+- c VTUrl = [|EUrl|]
+- c VTUrlParam = [|EUrlParam|]
+- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]
+
+
+
+diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
+index 9573533..49f1995 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
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch b/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch
new file mode 100644
index 000000000..b9f4283ca
--- /dev/null
+++ b/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch
@@ -0,0 +1,82 @@
+From 8cc398092892377d5fdbda990a2e860155422afa 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 ----
+ WaiAppStatic/Storage/Embedded.hs | 8 ++++----
+ wai-app-static.cabal | 4 +---
+ 3 files changed, 5 insertions(+), 11 deletions(-)
+
+diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
+index f2fa743..1a82b30 100644
+--- a/Network/Wai/Application/Static.hs
++++ b/Network/Wai/Application/Static.hs
+@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
+
+ import Blaze.ByteString.Builder (toByteString)
+
+-import Data.FileEmbed (embedFile)
+-
+ import Data.Text (Text)
+ import qualified Data.Text as T
+
+@@ -198,8 +196,6 @@ staticAppPieces _ _ req
+ H.status405
+ [("Content-Type", "text/plain")]
+ "Only GET is supported"
+-staticAppPieces _ [".hidden", "folder.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]
+-staticAppPieces _ [".hidden", "haskell.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]
+ staticAppPieces ss rawPieces req = liftIO $ do
+ case toPieces rawPieces of
+ Just pieces -> checkPieces ss pieces req >>= response
+diff --git a/WaiAppStatic/Storage/Embedded.hs b/WaiAppStatic/Storage/Embedded.hs
+index daa6e50..9873d4e 100644
+--- a/WaiAppStatic/Storage/Embedded.hs
++++ b/WaiAppStatic/Storage/Embedded.hs
+@@ -3,10 +3,10 @@ module WaiAppStatic.Storage.Embedded(
+ embeddedSettings
+
+ -- * Template Haskell
+- , Etag
+- , EmbeddableEntry(..)
+- , mkSettings
++ --, Etag
++ --, EmbeddableEntry(..)
++ --, mkSettings
+ ) where
+
+ import WaiAppStatic.Storage.Embedded.Runtime
+-import WaiAppStatic.Storage.Embedded.TH
++--import WaiAppStatic.Storage.Embedded.TH
+diff --git a/wai-app-static.cabal b/wai-app-static.cabal
+index 5d81150..8f8c144 100644
+--- a/wai-app-static.cabal
++++ b/wai-app-static.cabal
+@@ -33,7 +33,6 @@ library
+ , containers >= 0.2
+ , time >= 1.1.4
+ , old-locale >= 1.0.0.2
+- , file-embed >= 0.0.3.1
+ , text >= 0.7
+ , blaze-builder >= 0.2.1.4
+ , base64-bytestring >= 0.1
+@@ -57,9 +56,8 @@ 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.5.1
+
diff --git a/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch b/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
new file mode 100644
index 000000000..b6334d31f
--- /dev/null
+++ b/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
@@ -0,0 +1,108 @@
+From b53713fbb4f3bb6bdd25b07afcaed4940b32dfa8 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 03:32:44 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
+ 1 file changed, 1 insertion(+), 80 deletions(-)
+
+diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
+index f587410..4e830bd 100644
+--- a/Text/Hamlet/XML.hs
++++ b/Text/Hamlet/XML.hs
+@@ -1,9 +1,7 @@
+ {-# LANGUAGE TemplateHaskell #-}
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Hamlet.XML
+- ( xml
+- , xmlFile
+- ) where
++ () where
+
+ import Language.Haskell.TH.Syntax
+ import Language.Haskell.TH.Quote
+@@ -19,80 +17,3 @@ import qualified Data.Foldable as F
+ import Data.Maybe (fromMaybe)
+ import qualified Data.Map as Map
+
+-xml :: QuasiQuoter
+-xml = QuasiQuoter { quoteExp = strToExp }
+-
+-xmlFile :: FilePath -> Q Exp
+-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
+-
+-strToExp :: String -> Q Exp
+-strToExp s =
+- case parseDoc s of
+- Error e -> error e
+- Ok x -> docsToExp [] x
+-
+-docsToExp :: Scope -> [Doc] -> Q Exp
+-docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
+-
+-docToExp :: Scope -> Doc -> Q Exp
+-docToExp scope (DocTag name attrs cs) =
+- [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
+- ] |]
+-docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
+-docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
+-docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
+-docToExp scope (DocForall deref ident@(Ident ident') inside) = do
+- let list' = derefToExp scope deref
+- name <- newName ident'
+- let scope' = (ident, VarE name) : scope
+- inside' <- docsToExp scope' inside
+- let lam = LamE [VarP name] inside'
+- [| F.concatMap $(return lam) $(return list') |]
+-docToExp scope (DocWith [] inside) = docsToExp scope inside
+-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
+- let deref' = derefToExp scope deref
+- name' <- newName name
+- let scope' = (ident, VarE name') : scope
+- inside' <- docToExp scope' (DocWith dis inside)
+- let lam = LamE [VarP name'] inside'
+- return $ lam `AppE` deref'
+-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
+- let deref' = derefToExp scope deref
+- name' <- newName name
+- let scope' = (ident, VarE name') : scope
+- inside' <- docsToExp scope' just
+- let inside'' = LamE [VarP name'] inside'
+- nothing' <-
+- case nothing of
+- Nothing -> [| [] |]
+- Just n -> docsToExp scope n
+- [| maybe $(return nothing') $(return inside'') $(return deref') |]
+-docToExp scope (DocCond conds final) = do
+- unit <- [| () |]
+- body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
+- return $ CaseE unit [Match (TupP []) body []]
+- where
+- go (deref, inside) = do
+- inside' <- docsToExp scope inside
+- return (NormalG $ derefToExp scope deref, inside')
+-
+-mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
+-mkAttrs _ [] = [| Map.empty |]
+-mkAttrs scope ((mderef, name, value):rest) = do
+- rest' <- mkAttrs scope rest
+- this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
+- let with = [| $(return this) $(return rest') |]
+- case mderef of
+- Nothing -> with
+- Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
+- where
+- go (ContentRaw s) = [| pack $(lift s) |]
+- go (ContentVar d) = return $ derefToExp scope d
+- go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
+-
+-liftName :: String -> Q Exp
+-liftName s = do
+- X.Name local mns _ <- return $ fromString s
+- case mns of
+- Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
+- Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch b/standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch
new file mode 100644
index 000000000..7016e001c
--- /dev/null
+++ b/standalone/no-th/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/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
new file mode 100644
index 000000000..d5596395a
--- /dev/null
+++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
@@ -0,0 +1,684 @@
+From 08cc43788c16fb91f63bc0bd520eeccdcdab477a Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Tue, 17 Dec 2013 17:15:33 +0000
+Subject: [PATCH] remove and expand TH
+
+---
+ Yesod/Core.hs | 30 +++---
+ Yesod/Core/Class/Yesod.hs | 249 +++++++++++++++++++++++++++++++--------------
+ Yesod/Core/Dispatch.hs | 27 ++---
+ Yesod/Core/Handler.hs | 25 ++---
+ Yesod/Core/Internal/Run.hs | 4 +-
+ Yesod/Core/Internal/TH.hs | 111 --------------------
+ Yesod/Core/Widget.hs | 32 +-----
+ 7 files changed, 209 insertions(+), 269 deletions(-)
+
+diff --git a/Yesod/Core.hs b/Yesod/Core.hs
+index 12e59d5..2817a69 100644
+--- a/Yesod/Core.hs
++++ b/Yesod/Core.hs
+@@ -29,16 +29,16 @@ module Yesod.Core
+ , unauthorizedI
+ -- * Logging
+ , LogLevel (..)
+- , logDebug
+- , logInfo
+- , logWarn
+- , logError
+- , logOther
+- , logDebugS
+- , logInfoS
+- , logWarnS
+- , logErrorS
+- , logOtherS
++ --, logDebug
++ --, logInfo
++ --, logWarn
++ --, logError
++ --, logOther
++ --, logDebugS
++ --, logInfoS
++ --, logWarnS
++ --, logErrorS
++ --, logOtherS
+ -- * Sessions
+ , SessionBackend (..)
+ , customizeSessionCookies
+@@ -85,17 +85,15 @@ module Yesod.Core
+ , readIntegral
+ -- * Shakespeare
+ -- ** Hamlet
+- , hamlet
+- , shamlet
+- , xhamlet
++ --, hamlet
++ -- , shamlet
++ --, xhamlet
+ , HtmlUrl
+ -- ** Julius
+- , julius
++ --, julius
+ , JavascriptUrl
+ , renderJavascriptUrl
+ -- ** Cassius/Lucius
+- , cassius
+- , lucius
+ , CssUrl
+ , renderCssUrl
+ ) where
+diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
+index a64d6eb..5dffbfa 100644
+--- a/Yesod/Core/Class/Yesod.hs
++++ b/Yesod/Core/Class/Yesod.hs
+@@ -5,11 +5,15 @@
+ {-# LANGUAGE CPP #-}
+ module Yesod.Core.Class.Yesod where
+
+-import Control.Monad.Logger (logErrorS)
++--import Control.Monad.Logger (logErrorS)
+ 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)
+@@ -94,18 +98,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
+@@ -370,45 +383,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
+@@ -438,10 +509,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.
+@@ -451,10 +525,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
+@@ -476,10 +551,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)
+@@ -488,30 +566,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 df822e2..5583495 100644
+--- a/Yesod/Core/Dispatch.hs
++++ b/Yesod/Core/Dispatch.hs
+@@ -6,18 +6,18 @@
+ {-# LANGUAGE CPP #-}
+ module Yesod.Core.Dispatch
+ ( -- * Quasi-quoted routing
+- parseRoutes
+- , parseRoutesNoCheck
+- , parseRoutesFile
+- , parseRoutesFileNoCheck
+- , mkYesod
++ -- parseRoutes
++ --, parseRoutesNoCheck
++ --, parseRoutesFile
++ --, parseRoutesFileNoCheck
++ --, mkYesod
+ -- ** More fine-grained
+- , mkYesodData
+- , mkYesodSubData
+- , mkYesodDispatch
+- , mkYesodSubDispatch
++ --, mkYesodData
++ --, mkYesodSubData
++ --, mkYesodDispatch
++ --, mkYesodSubDispatch
+ -- ** Path pieces
+- , PathPiece (..)
++ PathPiece (..)
+ , PathMultiPiece (..)
+ , Texts
+ -- * Convert to WAI
+@@ -124,13 +124,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 3581dbc..908256e 100644
+--- a/Yesod/Core/Handler.hs
++++ b/Yesod/Core/Handler.hs
+@@ -164,7 +164,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
+ import Data.Text.Encoding.Error (lenientDecode)
+ import qualified Data.Text.Lazy as TL
+ import qualified Text.Blaze.Html.Renderer.Text as RenderText
+-import Text.Hamlet (Html, HtmlUrl, hamlet)
++import Text.Hamlet (Html, HtmlUrl)
+
+ import qualified Data.ByteString as S
+ import qualified Data.ByteString.Lazy as L
+@@ -198,6 +198,7 @@ import Data.CaseInsensitive (CI)
+ #if MIN_VERSION_wai(2, 0, 0)
+ import qualified System.PosixCompat.Files as PC
+ #endif
++import qualified Text.Blaze.Internal
+
+ get :: MonadHandler m => m GHState
+ get = liftHandlerT $ HandlerT $ I.readIORef . handlerState
+@@ -743,19 +744,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 25f51f1..d04d2cd 100644
+--- a/Yesod/Core/Internal/Run.hs
++++ b/Yesod/Core/Internal/Run.hs
+@@ -15,7 +15,7 @@ import Control.Exception.Lifted (catch)
+ import Control.Monad.IO.Class (MonadIO)
+ import Control.Monad.IO.Class (liftIO)
+ import Control.Monad.Logger (LogLevel (LevelError), LogSource,
+- liftLoc)
++ )
+ import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
+ import qualified Data.ByteString as S
+ import qualified Data.ByteString.Char8 as S8
+@@ -128,8 +128,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/Internal/TH.hs b/Yesod/Core/Internal/TH.hs
+index 7e84c1c..a273c29 100644
+--- a/Yesod/Core/Internal/TH.hs
++++ b/Yesod/Core/Internal/TH.hs
+@@ -23,114 +23,3 @@ import Yesod.Core.Content
+ import Yesod.Core.Class.Dispatch
+ import Yesod.Core.Internal.Run
+
+--- | 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
+-
+--- | 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 -> [ResourceTree String] -> Q [Dec]
+-mkYesodSubData name res = mkYesodDataGeneral name True res
+-
+-mkYesodDataGeneral :: String -> Bool -> [ResourceTree String] -> Q [Dec]
+-mkYesodDataGeneral name isSub res = do
+- let (name':rest) = words name
+- fmap fst $ mkYesodGeneral name' rest isSub res
+-
+--- | See 'mkYesodData'.
+-mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
+-mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False
+-
+--- | Get the Handler and Widget type synonyms for the given site.
+-masterTypeSyns :: Type -> [Dec]
+-masterTypeSyns site =
+- [ TySynD (mkName "Handler") []
+- $ ConT ''HandlerT `AppT` site `AppT` ConT ''IO
+- , TySynD (mkName "Widget") []
+- $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
+- ]
+-
+-mkYesodGeneral :: String -- ^ foundation type
+- -> [String] -- ^ arguments for the type
+- -> Bool -- ^ it this a subsite
+- -> [ResourceTree String]
+- -> Q([Dec],[Dec])
+-mkYesodGeneral name args isSub resS = do
+- renderRouteDec <- mkRenderRouteInstance site res
+- routeAttrsDec <- mkRouteAttrsInstance site res
+- dispatchDec <- mkDispatchInstance site res
+- parse <- mkParseRouteInstance site res
+- let rname = mkName $ "resources" ++ name
+- eres <- lift resS
+- let resourcesDec =
+- [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String)
+- , FunD rname [Clause [] (NormalB eres) []]
+- ]
+- let dataDec = concat
+- [ [parse]
+- , renderRouteDec
+- , [routeAttrsDec]
+- , resourcesDec
+- , if isSub then [] else masterTypeSyns site
+- ]
+- return (dataDec, dispatchDec)
+- where site = foldl' AppT (ConT $ mkName name) (map (VarT . mkName) args)
+- res = map (fmap parseType) resS
+-
+-mkMDS :: Q Exp -> MkDispatchSettings
+-mkMDS rh = MkDispatchSettings
+- { mdsRunHandler = rh
+- , mdsSubDispatcher =
+- [|\parentRunner getSub toParent env -> yesodSubDispatch
+- YesodSubRunnerEnv
+- { ysreParentRunner = parentRunner
+- , ysreGetSub = getSub
+- , ysreToParentRoute = toParent
+- , ysreParentEnv = env
+- }
+- |]
+- , mdsGetPathInfo = [|W.pathInfo|]
+- , mdsSetPathInfo = [|\p r -> r { W.pathInfo = p }|]
+- , mdsMethod = [|W.requestMethod|]
+- , mds404 = [|notFound >> return ()|]
+- , mds405 = [|badMethod >> return ()|]
+- , mdsGetHandler = defaultGetHandler
+- }
+-
+--- | 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 :: Type -- ^ The master site type
+- -> [ResourceTree a] -- ^ The resource
+- -> DecsQ
+-mkDispatchInstance master res = do
+- clause' <- mkDispatchClause (mkMDS [|yesodRunner|]) res
+- let thisDispatch = FunD 'yesodDispatch [clause']
+- return [InstanceD [] yDispatch [thisDispatch]]
+- where
+- yDispatch = ConT ''YesodDispatch `AppT` master
+-
+-mkYesodSubDispatch :: [ResourceTree a] -> Q Exp
+-mkYesodSubDispatch res = do
+- clause' <- mkDispatchClause (mkMDS [|subHelper . fmap toTypedContent|]) res
+- inner <- newName "inner"
+- let innerFun = FunD inner [clause']
+- helper <- newName "helper"
+- let fun = FunD helper
+- [ Clause
+- []
+- (NormalB $ VarE inner)
+- [innerFun]
+- ]
+- return $ LetE [fun] (VarE helper)
+diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
+index a972efa..156cd45 100644
+--- a/Yesod/Core/Widget.hs
++++ b/Yesod/Core/Widget.hs
+@@ -16,8 +16,8 @@ module Yesod.Core.Widget
+ WidgetT
+ , PageContent (..)
+ -- * Special Hamlet quasiquoter/TH for Widgets
+- , whamlet
+- , whamletFile
++ --, whamlet
++ --, whamletFile
+ , ihamletToRepHtml
+ , ihamletToHtml
+ -- * Convert to Widget
+@@ -46,7 +46,7 @@ module Yesod.Core.Widget
+ , widgetToParentWidget
+ , handlerToWidget
+ -- * Internal
+- , whamletFileWithSettings
++ --, whamletFileWithSettings
+ , asWidgetT
+ ) where
+
+@@ -189,35 +189,9 @@ addScriptRemote = flip addScriptRemoteAttrs []
+ addScriptRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
+ addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
+
+-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
+-
+ asWidgetT :: WidgetT site m () -> WidgetT site m ()
+ asWidgetT = id
+
+-rules :: Q NP.HamletRules
+-rules = do
+- ah <- [|asWidgetT . 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 [|getUrlRenderParams|])
+- (Just $ helper [|liftM (toHtml .) getMessageRender|])
+- f env
+- return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
+-
+ -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
+ ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+ => HtmlUrlI18n message (Route (HandlerSite m))
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
new file mode 100644
index 000000000..0a82434ea
--- /dev/null
+++ b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
@@ -0,0 +1,1805 @@
+From fbd8f048c239e34625e438a24213534f6f68c3e8 Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Tue, 17 Dec 2013 18:34:25 +0000
+Subject: [PATCH] spliced TH
+
+---
+ Yesod/Form/Fields.hs | 771 ++++++++++++++++++++++++++++++++++++------------
+ Yesod/Form/Functions.hs | 239 ++++++++++++---
+ Yesod/Form/Jquery.hs | 129 ++++++--
+ Yesod/Form/MassInput.hs | 233 ++++++++++++---
+ Yesod/Form/Nic.hs | 65 +++-
+ yesod-form.cabal | 1 +
+ 6 files changed, 1127 insertions(+), 311 deletions(-)
+
+diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
+index b2a47c6..016c98b 100644
+--- a/Yesod/Form/Fields.hs
++++ b/Yesod/Form/Fields.hs
+@@ -1,4 +1,3 @@
+-{-# LANGUAGE QuasiQuotes #-}
+ {-# LANGUAGE TypeFamilies #-}
+ {-# LANGUAGE OverloadedStrings #-}
+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+@@ -36,15 +35,11 @@ module Yesod.Form.Fields
+ , selectFieldList
+ , radioField
+ , radioFieldList
+- , checkboxesFieldList
+- , checkboxesField
+ , multiSelectField
+ , multiSelectFieldList
+ , Option (..)
+ , OptionList (..)
+ , mkOptionList
+- , optionsPersist
+- , optionsPersistKey
+ , optionsPairs
+ , optionsEnum
+ ) where
+@@ -70,6 +65,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)
+@@ -82,14 +86,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
+@@ -102,10 +104,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
+@@ -119,10 +135,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)
+@@ -130,10 +160,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)
+@@ -141,10 +185,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
+@@ -157,10 +214,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)
+@@ -169,8 +234,6 @@ $newline never
+ -- br-tags.
+ newtype Textarea = Textarea { unTextarea :: Text }
+ deriving (Show, Read, Eq, PersistField, Ord)
+-instance PersistFieldSql Textarea where
+- sqlType _ = SqlString
+ instance ToHtml Textarea where
+ toHtml =
+ unsafeByteString
+@@ -188,10 +251,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
+ }
+
+@@ -199,10 +270,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
+ }
+
+@@ -210,20 +290,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
+ }
+
+@@ -295,10 +410,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
+ }
+
+@@ -307,20 +436,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
+ }
+
+@@ -331,7 +518,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
+ }
+
+@@ -344,18 +554,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)]
+@@ -378,11 +626,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,67 +677,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
+ -> Field (HandlerT site IO) a
+ radioFieldList = radioField . optionsPairs
+
+-checkboxesFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)]
+- -> Field (HandlerT site IO) [a]
+-checkboxesFieldList = checkboxesField . optionsPairs
+-
+-checkboxesField :: (Eq a, RenderMessage site FormMessage)
+- => HandlerT site IO (OptionList a)
+- -> Field (HandlerT site IO) [a]
+-checkboxesField ioptlist = (multiSelectField ioptlist)
+- { fieldView =
+- \theId name attrs val isReq -> do
+- opts <- fmap olOptions $ handlerToWidget ioptlist
+- let optselected (Left _) _ = False
+- optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
+- [whamlet|
+- <span ##{theId}>
+- $forall opt <- opts
+- <label>
+- <input type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>
+- #{optionDisplay opt}
+- |]
+- }
+
+ 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}
++ , 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}-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
+@@ -478,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
+ }
+
+@@ -525,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)
+@@ -611,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
+ }
+
+@@ -640,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
+ }
+@@ -672,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..8675a10 100644
+--- a/Yesod/Form/Functions.hs
++++ b/Yesod/Form/Functions.hs
+@@ -53,12 +53,16 @@ import Text.Blaze (Markup, toMarkup)
+ #define toHtml toMarkup
+ import Yesod.Core
+ import Network.Wai (requestMethod)
+-import Text.Hamlet (shamlet)
++--`import Text.Hamlet (shamlet)
+ import Data.Monoid (mempty)
+ 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..ed9b366 100644
+--- a/Yesod/Form/Jquery.hs
++++ b/Yesod/Form/Jquery.hs
+@@ -12,12 +12,24 @@ 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)
+ import Data.Default
+-import Text.Hamlet (shamlet)
+-import Text.Julius (julius, rawJS)
++--import Text.Hamlet (shamlet)
++import Text.Julius (rawJS)
+ import Data.Text (Text, pack, unpack)
+ import Data.Monoid (mconcat)
+
+@@ -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..04ddaba 100644
+--- a/Yesod/Form/Nic.hs
++++ b/Yesod/Form/Nic.hs
+@@ -9,11 +9,24 @@ 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)
+-import Text.Hamlet (shamlet)
+-import Text.Julius (julius, rawJS)
++--import Text.Hamlet (shamlet)
++import Text.Julius ( rawJS)
+ import Text.Blaze.Html.Renderer.String (renderHtml)
+ import Data.Text (Text, pack)
+ import Data.Maybe (listToMaybe)
+@@ -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 9e0c710..a39f71f 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.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch b/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch
new file mode 100644
index 000000000..ecccf75ac
--- /dev/null
+++ b/standalone/no-th/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/no-th/haskell-patches/yesod-routes_export-module-referenced-by-TH-splices.patch b/standalone/no-th/haskell-patches/yesod-routes_export-module-referenced-by-TH-splices.patch
new file mode 100644
index 000000000..e20e3c7f1
--- /dev/null
+++ b/standalone/no-th/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/no-th/haskell-patches/yesod-routes_remove-TH.patch b/standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch
new file mode 100644
index 000000000..18c1416de
--- /dev/null
+++ b/standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch
@@ -0,0 +1,169 @@
+From acebcf203b270d00aac0a29be48832ae2c64ce7e Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 06:57:07 +0000
+Subject: [PATCH] remove TH
+
+---
+ Yesod/Routes/Parse.hs | 39 +++++----------------------------------
+ Yesod/Routes/TH.hs | 16 ++++++++--------
+ Yesod/Routes/TH/Types.hs | 16 ----------------
+ yesod-routes.cabal | 4 ----
+ 4 files changed, 13 insertions(+), 62 deletions(-)
+
+diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs
+index 3d27980..c2e3e6d 100644
+--- a/Yesod/Routes/Parse.hs
++++ b/Yesod/Routes/Parse.hs
+@@ -2,11 +2,11 @@
+ {-# LANGUAGE DeriveDataTypeable #-}
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter
+ module Yesod.Routes.Parse
+- ( parseRoutes
+- , parseRoutesFile
+- , parseRoutesNoCheck
+- , parseRoutesFileNoCheck
+- , parseType
++ --( parseRoutes
++ --, parseRoutesFile
++ --, parseRoutesNoCheck
++ --, parseRoutesFileNoCheck
++ ( parseType
+ , parseTypeTree
+ , TypeTree (..)
+ ) where
+@@ -19,41 +19,12 @@ import Yesod.Routes.TH
+ import Yesod.Routes.Overlap (findOverlapNames)
+ import Data.List (foldl')
+
+--- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for
+--- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the
+--- checking. See documentation site for details on syntax.
+-parseRoutes :: QuasiQuoter
+-parseRoutes = QuasiQuoter { quoteExp = x }
+- where
+- x s = do
+- let res = resourcesFromString s
+- case findOverlapNames res of
+- [] -> lift res
+- z -> error $ "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
+- qAddDependentFile fp
+- s <- qRunIO $ readUtf8File fp
+- quoteExp qq s
+-
+ readUtf8File :: FilePath -> IO String
+ readUtf8File fp = do
+ h <- SIO.openFile fp SIO.ReadMode
+ SIO.hSetEncoding h SIO.utf8_bom
+ SIO.hGetContents h
+
+--- | Same as 'parseRoutes', but performs no overlap checking.
+-parseRoutesNoCheck :: QuasiQuoter
+-parseRoutesNoCheck = QuasiQuoter
+- { quoteExp = lift . resourcesFromString
+- }
+
+ -- | Convert a multi-line string to a set of resources. See documentation for
+ -- the format of this string. This is a partial function which calls 'error' on
+diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs
+index 7b2e50b..b05fc57 100644
+--- a/Yesod/Routes/TH.hs
++++ b/Yesod/Routes/TH.hs
+@@ -2,15 +2,15 @@
+ module Yesod.Routes.TH
+ ( module Yesod.Routes.TH.Types
+ -- * Functions
+- , module Yesod.Routes.TH.RenderRoute
+- , module Yesod.Routes.TH.ParseRoute
+- , module Yesod.Routes.TH.RouteAttrs
++ -- , module Yesod.Routes.TH.RenderRoute
++ -- , module Yesod.Routes.TH.ParseRoute
++ -- , module Yesod.Routes.TH.RouteAttrs
+ -- ** Dispatch
+- , module Yesod.Routes.TH.Dispatch
++ -- , module Yesod.Routes.TH.Dispatch
+ ) where
+
+ import Yesod.Routes.TH.Types
+-import Yesod.Routes.TH.RenderRoute
+-import Yesod.Routes.TH.ParseRoute
+-import Yesod.Routes.TH.RouteAttrs
+-import Yesod.Routes.TH.Dispatch
++--import Yesod.Routes.TH.RenderRoute
++--import Yesod.Routes.TH.ParseRoute
++--import Yesod.Routes.TH.RouteAttrs
++--import Yesod.Routes.TH.Dispatch
+diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs
+index d0a0405..3232e99 100644
+--- a/Yesod/Routes/TH/Types.hs
++++ b/Yesod/Routes/TH/Types.hs
+@@ -31,10 +31,6 @@ instance Functor ResourceTree where
+ fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r)
+ fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c
+
+-instance Lift t => Lift (ResourceTree t) where
+- lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|]
+- lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|]
+-
+ data Resource typ = Resource
+ { resourceName :: String
+ , resourcePieces :: [(CheckOverlap, Piece typ)]
+@@ -48,9 +44,6 @@ type CheckOverlap = Bool
+ instance Functor Resource where
+ fmap f (Resource a b c d) = Resource a (map (second $ fmap f) b) (fmap f c) d
+
+-instance Lift t => Lift (Resource t) where
+- lift (Resource a b c d) = [|Resource a b c d|]
+-
+ data Piece typ = Static String | Dynamic typ
+ deriving Show
+
+@@ -58,10 +51,6 @@ instance Functor Piece where
+ fmap _ (Static s) = (Static s)
+ fmap f (Dynamic t) = Dynamic (f t)
+
+-instance Lift t => Lift (Piece t) where
+- lift (Static s) = [|Static $(lift s)|]
+- lift (Dynamic t) = [|Dynamic $(lift t)|]
+-
+ data Dispatch typ =
+ Methods
+ { methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
+@@ -77,11 +66,6 @@ instance Functor Dispatch where
+ fmap f (Methods a b) = Methods (fmap f a) b
+ fmap f (Subsite a b) = Subsite (f a) b
+
+-instance Lift t => Lift (Dispatch t) where
+- lift (Methods Nothing b) = [|Methods Nothing $(lift b)|]
+- lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|]
+- lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|]
+-
+ resourceMulti :: Resource typ -> Maybe typ
+ resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t
+ resourceMulti _ = Nothing
+diff --git a/yesod-routes.cabal b/yesod-routes.cabal
+index 0e44409..e01ea06 100644
+--- a/yesod-routes.cabal
++++ b/yesod-routes.cabal
+@@ -28,10 +28,6 @@ library
+ 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
+ ghc-options: -Wall
+
+ test-suite runtests
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/yesod-static_remove-TH.patch b/standalone/no-th/haskell-patches/yesod-static_remove-TH.patch
new file mode 100644
index 000000000..425edc017
--- /dev/null
+++ b/standalone/no-th/haskell-patches/yesod-static_remove-TH.patch
@@ -0,0 +1,597 @@
+From ad0166a6e537021c9f5a1e01cde4b7c520edcf3a Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 05:10:59 +0000
+Subject: [PATCH] remove TH
+
+---
+ Yesod/EmbeddedStatic.hs | 64 -----------
+ Yesod/EmbeddedStatic/Generators.hs | 102 +----------------
+ Yesod/EmbeddedStatic/Internal.hs | 41 -------
+ Yesod/EmbeddedStatic/Types.hs | 14 ---
+ Yesod/Static.hs | 224 +------------------------------------
+ 5 files changed, 12 insertions(+), 433 deletions(-)
+
+diff --git a/Yesod/EmbeddedStatic.hs b/Yesod/EmbeddedStatic.hs
+index e819630..a564d4b 100644
+--- a/Yesod/EmbeddedStatic.hs
++++ b/Yesod/EmbeddedStatic.hs
+@@ -41,7 +41,6 @@ module Yesod.EmbeddedStatic (
+ -- * Subsite
+ EmbeddedStatic
+ , embeddedResourceR
+- , mkEmbeddedStatic
+ , embedStaticContent
+
+ -- * Generators
+@@ -91,69 +90,6 @@ instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) wh
+ ("widget":_) -> staticApp (widgetSettings site) req
+ _ -> return $ responseLBS status404 [] "Not Found"
+
+--- | Create the haskell variable for the link to the entry
+-mkRoute :: ComputedEntry -> Q [Dec]
+-mkRoute (ComputedEntry { cHaskellName = Nothing }) = return []
+-mkRoute (c@ComputedEntry { cHaskellName = Just name }) = do
+- routeType <- [t| Route EmbeddedStatic |]
+- link <- [| $(cLink c) |]
+- return [ SigD name routeType
+- , ValD (VarP name) (NormalB link) []
+- ]
+-
+--- | Creates an 'EmbeddedStatic' by running, at compile time, a list of generators.
+--- Each generator produces a list of entries to embed into the executable.
+---
+--- This template haskell splice creates a variable binding holding the resulting
+--- 'EmbeddedStatic' and in addition creates variable bindings for all the routes
+--- produced by the generators. For example, if a directory called static has
+--- the following contents:
+---
+--- * js/jquery.js
+---
+--- * css/bootstrap.css
+---
+--- * img/logo.png
+---
+--- then a call to
+---
+--- > #ifdef DEVELOPMENT
+--- > #define DEV_BOOL True
+--- > #else
+--- > #define DEV_BOOL False
+--- > #endif
+--- > mkEmbeddedStatic DEV_BOOL "myStatic" [embedDir "static"]
+---
+--- will produce variables
+---
+--- > myStatic :: EmbeddedStatic
+--- > js_jquery_js :: Route EmbeddedStatic
+--- > css_bootstrap_css :: Route EmbeddedStatic
+--- > img_logo_png :: Route EmbeddedStatic
+-mkEmbeddedStatic :: Bool -- ^ development?
+- -> String -- ^ variable name for the created 'EmbeddedStatic'
+- -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators")
+- -> Q [Dec]
+-mkEmbeddedStatic dev esName gen = do
+- entries <- concat <$> sequence gen
+- computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries
+-
+- let settings = Static.mkSettings $ return $ map cStEntry computed
+- devExtra = listE $ catMaybes $ map ebDevelExtraFiles entries
+- ioRef = [| unsafePerformIO $ newIORef M.empty |]
+-
+- -- build the embedded static
+- esType <- [t| EmbeddedStatic |]
+- esCreate <- if dev
+- then [| EmbeddedStatic (develApp $settings $devExtra) $ioRef |]
+- else [| EmbeddedStatic (staticApp $! $settings) $ioRef |]
+- let es = [ SigD (mkName esName) esType
+- , ValD (VarP $ mkName esName) (NormalB esCreate) []
+- ]
+-
+- routes <- mapM mkRoute computed
+-
+- return $ es ++ concat routes
+
+ -- | Use this for 'addStaticContent' to have the widget static content be served by
+ -- the embedded static subsite. For example,
+diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs
+index e83785d..bc35359 100644
+--- a/Yesod/EmbeddedStatic/Generators.hs
++++ b/Yesod/EmbeddedStatic/Generators.hs
+@@ -6,12 +6,12 @@
+ module Yesod.EmbeddedStatic.Generators (
+ -- * Generators
+ Location
+- , embedFile
+- , embedFileAt
+- , embedDir
+- , embedDirAt
+- , concatFiles
+- , concatFilesWith
++ --, embedFile
++ --, embedFileAt
++ --, embedDir
++ --, embedDirAt
++ --, concatFiles
++ --, concatFilesWith
+
+ -- * Compression options for 'concatFilesWith'
+ , jasmine
+@@ -50,28 +50,6 @@ import qualified Data.Text as T
+
+ import Yesod.EmbeddedStatic.Types
+
+--- | Embed a single file. Equivalent to passing the same string twice to 'embedFileAt'.
+-embedFile :: FilePath -> Generator
+-embedFile f = embedFileAt f f
+-
+--- | Embed a single file at a given location within the static subsite and generate a
+--- route variable based on the location via 'pathToName'. The @FilePath@ must be a relative
+--- path to the directory in which you run @cabal build@. During development, the file located
+--- at this filepath will be reloaded on every request. When compiling for production, the contents
+--- of the file will be embedded into the executable and so the file does not need to be
+--- distributed along with the executable.
+-embedFileAt :: Location -> FilePath -> Generator
+-embedFileAt loc f = do
+- let mime = defaultMimeLookup $ T.pack f
+- let entry = def {
+- ebHaskellName = Just $ pathToName loc
+- , ebLocation = loc
+- , ebMimeType = mime
+- , ebProductionContent = BL.readFile f
+- , ebDevelReload = [| BL.readFile $(litE $ stringL f) |]
+- }
+- return [entry]
+-
+ -- | List all files recursively in a directory
+ getRecursiveContents :: Location -- ^ The directory to search
+ -> FilePath -- ^ The prefix to add to the filenames
+@@ -88,74 +66,6 @@ getRecursiveContents prefix topdir = do
+ else return [(loc, path)]
+ return (concat paths)
+
+--- | Embed all files in a directory into the static subsite.
+---
+--- Equivalent to passing the empty string as the location to 'embedDirAt',
+--- so the directory path itself is not part of the resource locations (and so
+--- also not part of the generated route variable names).
+-embedDir :: FilePath -> Generator
+-embedDir = embedDirAt ""
+-
+--- | Embed all files in a directory to a given location within the static subsite.
+---
+--- The directory tree rooted at the 'FilePath' (which must be relative to the directory in
+--- which you run @cabal build@) is embedded into the static subsite at the given
+--- location. Also, route variables will be created based on the final location
+--- of each file. For example, if a directory \"static\" contains the files
+---
+--- * css/bootstrap.css
+---
+--- * js/jquery.js
+---
+--- * js/bootstrap.js
+---
+--- then @embedDirAt \"somefolder\" \"static\"@ will
+---
+--- * Make the file @static\/css\/bootstrap.css@ available at the location
+--- @somefolder\/css\/bootstrap.css@ within the static subsite and similarly
+--- for the other two files.
+---
+--- * Create variables @somefolder_css_bootstrap_css@, @somefolder_js_jquery_js@,
+--- @somefolder_js_bootstrap_js@ all of type @Route EmbeddedStatic@.
+---
+--- * During development, the files will be reloaded on every request. During
+--- production, the contents of all files will be embedded into the executable.
+---
+--- * During development, files that are added to the directory while the server
+--- is running will not be detected. You need to recompile the module which
+--- contains the call to @mkEmbeddedStatic@. This will also generate new route
+--- variables for the new files.
+-embedDirAt :: Location -> FilePath -> Generator
+-embedDirAt loc dir = do
+- files <- runIO $ getRecursiveContents loc dir
+- concat <$> mapM (uncurry embedFileAt) files
+-
+--- | Concatinate a list of files and embed it at the location. Equivalent to passing @return@ to
+--- 'concatFilesWith'.
+-concatFiles :: Location -> [FilePath] -> Generator
+-concatFiles loc files = concatFilesWith loc return files
+-
+--- | Concatinate a list of files into a single 'BL.ByteString', run the resulting content through the given
+--- function, embed it at the given location, and create a haskell variable name for the route based on
+--- the location.
+---
+--- The processing function is only run when compiling for production, and the processing function is
+--- executed at compile time. During development, on every request the files listed are reloaded,
+--- concatenated, and served as a single resource at the given location without being processed.
+-concatFilesWith :: Location -> (BL.ByteString -> IO BL.ByteString) -> [FilePath] -> Generator
+-concatFilesWith loc process files = do
+- let load = do putStrLn $ "Creating " ++ loc
+- BL.concat <$> mapM BL.readFile files >>= process
+- expFiles = listE $ map (litE . stringL) files
+- expCt = [| BL.concat <$> mapM BL.readFile $expFiles |]
+- mime = defaultMimeLookup $ T.pack loc
+- return [def { ebHaskellName = Just $ pathToName loc
+- , ebLocation = loc
+- , ebMimeType = mime
+- , ebProductionContent = load
+- , ebDevelReload = expCt
+- }]
+-
+ -- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.
+ jasmine :: BL.ByteString -> IO BL.ByteString
+ jasmine ct = return $ either (const ct) id $ minifym ct
+diff --git a/Yesod/EmbeddedStatic/Internal.hs b/Yesod/EmbeddedStatic/Internal.hs
+index 0882c16..6f61a0f 100644
+--- a/Yesod/EmbeddedStatic/Internal.hs
++++ b/Yesod/EmbeddedStatic/Internal.hs
+@@ -7,9 +7,6 @@
+ module Yesod.EmbeddedStatic.Internal (
+ EmbeddedStatic(..)
+ , Route(..)
+- , ComputedEntry(..)
+- , devEmbed
+- , prodEmbed
+ , develApp
+ , AddStaticContent
+ , staticContentHelper
+@@ -68,44 +65,6 @@ instance ParseRoute EmbeddedStatic where
+ parseRoute (["widget",h], _) = Just $ EmbeddedWidgetR h
+ parseRoute _ = Nothing
+
+--- | At compile time, one of these is created for every 'Entry' created by
+--- the generators. The cLink is a template haskell expression of type @Route EmbeddedStatic@.
+-data ComputedEntry = ComputedEntry {
+- cHaskellName :: Maybe Name -- ^ Optional haskell name to create a variable for the route
+- , cStEntry :: Static.EmbeddableEntry -- ^ The entry to be embedded into the executable
+- , cLink :: ExpQ -- ^ The route for this entry
+-}
+-
+-mkStr :: String -> ExpQ
+-mkStr = litE . stringL
+-
+--- | Create a 'ComputedEntry' for development mode, reloading the content on every request.
+-devEmbed :: Entry -> IO ComputedEntry
+-devEmbed e = return computed
+- where
+- st = Static.EmbeddableEntry {
+- Static.eLocation = "res/" `T.append` T.pack (ebLocation e)
+- , Static.eMimeType = ebMimeType e
+- , Static.eContent = Right [| $(ebDevelReload e) >>= \c ->
+- return (T.pack (base64md5 c), c) |]
+- }
+- link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) [] |]
+- computed = ComputedEntry (ebHaskellName e) st link
+-
+--- | Create a 'ComputedEntry' for production mode, hashing and embedding the content into the executable.
+-prodEmbed :: Entry -> IO ComputedEntry
+-prodEmbed e = do
+- ct <- ebProductionContent e
+- let hash = base64md5 ct
+- link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e))
+- [(T.pack "etag", T.pack $(mkStr hash))] |]
+- st = Static.EmbeddableEntry {
+- Static.eLocation = "res/" `T.append` T.pack (ebLocation e)
+- , Static.eMimeType = ebMimeType e
+- , Static.eContent = Left (T.pack hash, ct)
+- }
+- return $ ComputedEntry (ebHaskellName e) st link
+-
+ tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application
+ tryExtraDevelFiles [] _ = return $ responseLBS status404 [] ""
+ tryExtraDevelFiles (f:fs) r = do
+diff --git a/Yesod/EmbeddedStatic/Types.hs b/Yesod/EmbeddedStatic/Types.hs
+index 5cbd662..d3e514f 100644
+--- a/Yesod/EmbeddedStatic/Types.hs
++++ b/Yesod/EmbeddedStatic/Types.hs
+@@ -1,7 +1,6 @@
+ {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
+ module Yesod.EmbeddedStatic.Types(
+ Location
+- , Generator
+ -- ** Entry
+ , Entry
+ , ebHaskellName
+@@ -52,16 +51,3 @@ data Entry = Entry {
+ -- taking as input the list of path pieces and optionally returning a mime type
+ -- and content.
+ }
+-
+--- | When using 'def', you must fill in at least 'ebLocation'.
+-instance Default Entry where
+- def = Entry { ebHaskellName = Nothing
+- , ebLocation = "xxxx"
+- , ebMimeType = "application/octet-stream"
+- , ebProductionContent = return BL.empty
+- , ebDevelReload = [| return BL.empty |]
+- , ebDevelExtraFiles = Nothing
+- }
+-
+--- | An embedded generator is executed at compile time to produce the entries to embed.
+-type Generator = Q [Entry]
+diff --git a/Yesod/Static.hs b/Yesod/Static.hs
+index ef27f1b..5795f45 100644
+--- a/Yesod/Static.hs
++++ b/Yesod/Static.hs
+@@ -37,8 +37,8 @@ module Yesod.Static
+ , staticDevel
+ -- * Combining CSS/JS
+ -- $combining
+- , combineStylesheets'
+- , combineScripts'
++ --, combineStylesheets'
++ --, combineScripts'
+ -- ** Settings
+ , CombineSettings
+ , csStaticDir
+@@ -48,13 +48,13 @@ module Yesod.Static
+ , csJsPreProcess
+ , csCombinedFolder
+ -- * Template Haskell helpers
+- , staticFiles
+- , staticFilesList
+- , publicFiles
++ --, staticFiles
++ --, staticFilesList
++ --, publicFiles
+ -- * Hashing
+ , base64md5
+ -- * Embed
+- , embed
++ --, embed
+ #ifdef TEST_EXPORT
+ , getFileListPieces
+ #endif
+@@ -64,7 +64,6 @@ import Prelude hiding (FilePath)
+ import qualified Prelude
+ import System.Directory
+ import Control.Monad
+-import Data.FileEmbed (embedDir)
+
+ import Yesod.Core
+ import Yesod.Core.Types
+@@ -135,21 +134,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.
+---
+--- You should use "Yesod.EmbeddedStatic" instead, it is much more powerful.
+---
+--- 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').
+ --
+@@ -214,59 +198,6 @@ getFileListPieces = flip evalStateT M.empty . flip go id
+ put $ M.insert s s m
+ return s
+
+--- | 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
+@@ -309,53 +240,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 $(TH.lift f)|]
+- let route = mkName routeConName
+- pack' <- [|pack|]
+- qs <- if makeHash
+- then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f
+- [|[(pack "etag", pack $(TH.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
+@@ -379,55 +263,6 @@ base64 = map tr
+ tr '/' = '_'
+ tr c = c
+
+--- $combining
+---
+--- A common scenario on a site is the desire to include many external CSS and
+--- Javascript files on every page. Doing so via the Widget functionality in
+--- Yesod will work, but would also mean that the same content will be
+--- downloaded many times. A better approach would be to combine all of these
+--- files together into a single static file and serve that as a static resource
+--- for every page. That resource can be cached on the client, and bandwidth
+--- usage reduced.
+---
+--- This could be done as a manual process, but that becomes tedious. Instead,
+--- you can use some Template Haskell code which will combine these files into a
+--- single static file at compile time.
+-
+-data CombineType = JS | CSS
+-
+-combineStatics' :: CombineType
+- -> CombineSettings
+- -> [Route Static] -- ^ files to combine
+- -> Q Exp
+-combineStatics' combineType CombineSettings {..} routes = do
+- texts <- qRunIO $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume
+- ltext <- qRunIO $ preProcess $ TL.fromChunks texts
+- bs <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext
+- let hash' = base64md5 bs
+- suffix = csCombinedFolder </> F.decodeString hash' <.> extension
+- fp = csStaticDir </> suffix
+- qRunIO $ do
+- createTree $ F.directory fp
+- L.writeFile (F.encodeString fp) bs
+- let pieces = map T.unpack $ T.splitOn "/" $ either id id $ F.toText suffix
+- [|StaticRoute (map pack pieces) []|]
+- where
+- fps :: [F.FilePath]
+- fps = map toFP routes
+- toFP (StaticRoute pieces _) = csStaticDir </> F.concat (map F.fromText pieces)
+- readUTFFile fp = sourceFile (F.encodeString fp) =$= CT.decode CT.utf8
+- postProcess =
+- case combineType of
+- JS -> csJsPostProcess
+- CSS -> csCssPostProcess
+- preProcess =
+- case combineType of
+- JS -> csJsPreProcess
+- CSS -> csCssPreProcess
+- extension =
+- case combineType of
+- JS -> "js"
+- CSS -> "css"
+
+ -- | Data type for holding all settings for combining files.
+ --
+@@ -504,50 +339,3 @@ instance Default CombineSettings where
+ errorIntro :: [FilePath] -> [Char] -> [Char]
+ errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
+
+-liftRoutes :: [Route Static] -> Q Exp
+-liftRoutes =
+- fmap ListE . mapM go
+- where
+- go :: Route Static -> Q Exp
+- go (StaticRoute x y) = [|StaticRoute $(liftTexts x) $(liftPairs y)|]
+-
+- liftTexts = fmap ListE . mapM liftT
+- liftT t = [|pack $(TH.lift $ T.unpack t)|]
+-
+- liftPairs = fmap ListE . mapM liftPair
+- liftPair (x, y) = [|($(liftT x), $(liftT y))|]
+-
+--- | Combine multiple CSS files together. Common usage would be:
+---
+--- >>> combineStylesheets' development def 'StaticR [style1_css, style2_css]
+---
+--- Where @development@ is a variable in your site indicated whether you are in
+--- development or production mode.
+---
+--- Since 1.2.0
+-combineStylesheets' :: Bool -- ^ development? if so, perform no combining
+- -> CombineSettings
+- -> Name -- ^ Static route constructor name, e.g. \'StaticR
+- -> [Route Static] -- ^ files to combine
+- -> Q Exp
+-combineStylesheets' development cs con routes
+- | development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutes routes) |]
+- | otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStatics' CSS cs routes) |]
+-
+-
+--- | Combine multiple JS files together. Common usage would be:
+---
+--- >>> combineScripts' development def 'StaticR [script1_js, script2_js]
+---
+--- Where @development@ is a variable in your site indicated whether you are in
+--- development or production mode.
+---
+--- Since 1.2.0
+-combineScripts' :: Bool -- ^ development? if so, perform no combining
+- -> CombineSettings
+- -> Name -- ^ Static route constructor name, e.g. \'StaticR
+- -> [Route Static] -- ^ files to combine
+- -> Q Exp
+-combineScripts' development cs con routes
+- | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
+- | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch
new file mode 100644
index 000000000..eedc7df15
--- /dev/null
+++ b/standalone/no-th/haskell-patches/yesod_hack-TH.patch
@@ -0,0 +1,140 @@
+From e3d1ead4f02c2c45e64a1ccad5b461cc6fdabbd2 Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Tue, 17 Dec 2013 18:48:56 +0000
+Subject: [PATCH] hack for TH
+
+---
+ Yesod.hs | 19 ++++++++++++--
+ Yesod/Default/Util.hs | 69 ++-------------------------------------------------
+ 2 files changed, 19 insertions(+), 69 deletions(-)
+
+diff --git a/Yesod.hs b/Yesod.hs
+index b367144..fbe309c 100644
+--- a/Yesod.hs
++++ b/Yesod.hs
+@@ -5,9 +5,24 @@ module Yesod
+ ( -- * Re-exports from yesod-core
+ module Yesod.Core
+ , module Yesod.Form
+- , module Yesod.Persist
++ , insertBy
++ , replace
++ , deleteBy
++ , delete
++ , insert
++ , Key
+ ) where
+
+ import Yesod.Core
+ import Yesod.Form
+-import Yesod.Persist
++
++-- 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
++
+diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
+index a10358e..0547424 100644
+--- a/Yesod/Default/Util.hs
++++ b/Yesod/Default/Util.hs
+@@ -5,10 +5,9 @@
+ module Yesod.Default.Util
+ ( addStaticContentExternal
+ , globFile
+- , widgetFileNoReload
+- , widgetFileReload
++ --, 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,68 +65,7 @@ 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
+-
+-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.8.5.1
+