diff options
Diffstat (limited to 'standalone/no-th/haskell-patches')
24 files changed, 0 insertions, 6680 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 deleted file mode 100644 index 6d17d634e9..0000000000 --- a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch +++ /dev/null @@ -1,420 +0,0 @@ -From e54cfacbb9fb24f75d3d93cd8ee6da67b161574f Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:51:28 +0000 -Subject: [PATCH] remove TH - ---- - DAV.cabal | 28 +---- - Network/Protocol/HTTP/DAV.hs | 92 +++++++++++++--- - Network/Protocol/HTTP/DAV/TH.hs | 232 +++++++++++++++++++++++++++++++++++++++- - 3 files changed, 306 insertions(+), 46 deletions(-) - -diff --git a/DAV.cabal b/DAV.cabal -index 95fffd8..5669c51 100644 ---- a/DAV.cabal -+++ b/DAV.cabal -@@ -47,33 +47,7 @@ library - , utf8-string - , xml-conduit >= 1.0 && < 1.3 - , 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 -- , data-default -- , either >= 4.3 -- , errors -- , exceptions -- , http-client >= 0.2 -- , http-client-tls >= 0.2 -- , http-types >= 0.7 -- , lens >= 3.0 -- , mtl >= 2.1 -- , optparse-applicative >= 0.10.0 -- , transformers >= 0.3 -- , transformers-base -- , utf8-string -- , xml-conduit >= 1.0 && < 1.3 -- , xml-hamlet >= 0.4 && < 0.5 -- if flag(network-uri) -- build-depends: network-uri >= 2.6, network >= 2.6 -- else -- build-depends: network >= 2.3 && <2.6 -+ , text - - source-repository head - type: git -diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs -index 4c6d68f..55979b6 100644 ---- a/Network/Protocol/HTTP/DAV.hs -+++ b/Network/Protocol/HTTP/DAV.hs -@@ -82,6 +82,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho - 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) - -@@ -330,31 +331,88 @@ withLockIfPossibleForDelete nocreate f = 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 --|] -+ 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 []))]]))]] -+ - - -- | Normally, DAVT actions act on the url that is provided to eg, evalDAVT. - -- Sometimes, it's useful to adjust the url that is acted on, while -diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs -index 0ecd476..1653bf6 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 Data.Functor -+import qualified Control.Lens.Type - - 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_a3iH -+ (DAVContext __allowedMethods'_a3iI -+ __baseRequest_a3iK -+ __basicusername_a3iL -+ __basicpassword_a3iM -+ __complianceClasses_a3iN -+ __depth_a3iO -+ __httpManager_a3iP -+ __lockToken_a3iQ -+ __userAgent_a3iR) -+ = ((\ __allowedMethods_a3iJ -+ -> DAVContext -+ __allowedMethods_a3iJ -+ __baseRequest_a3iK -+ __basicusername_a3iL -+ __basicpassword_a3iM -+ __complianceClasses_a3iN -+ __depth_a3iO -+ __httpManager_a3iP -+ __lockToken_a3iQ -+ __userAgent_a3iR) -+ Data.Functor.<$> (_f_a3iH __allowedMethods'_a3iI)) -+{-# INLINE allowedMethods #-} -+baseRequest :: Control.Lens.Type.Lens' DAVContext Request -+baseRequest -+ _f_a3iS -+ (DAVContext __allowedMethods_a3iT -+ __baseRequest'_a3iU -+ __basicusername_a3iW -+ __basicpassword_a3iX -+ __complianceClasses_a3iY -+ __depth_a3iZ -+ __httpManager_a3j0 -+ __lockToken_a3j1 -+ __userAgent_a3j2) -+ = ((\ __baseRequest_a3iV -+ -> DAVContext -+ __allowedMethods_a3iT -+ __baseRequest_a3iV -+ __basicusername_a3iW -+ __basicpassword_a3iX -+ __complianceClasses_a3iY -+ __depth_a3iZ -+ __httpManager_a3j0 -+ __lockToken_a3j1 -+ __userAgent_a3j2) -+ Data.Functor.<$> (_f_a3iS __baseRequest'_a3iU)) -+{-# INLINE baseRequest #-} -+basicpassword :: Control.Lens.Type.Lens' DAVContext B.ByteString -+basicpassword -+ _f_a3j3 -+ (DAVContext __allowedMethods_a3j4 -+ __baseRequest_a3j5 -+ __basicusername_a3j6 -+ __basicpassword'_a3j7 -+ __complianceClasses_a3j9 -+ __depth_a3ja -+ __httpManager_a3jb -+ __lockToken_a3jc -+ __userAgent_a3jd) -+ = ((\ __basicpassword_a3j8 -+ -> DAVContext -+ __allowedMethods_a3j4 -+ __baseRequest_a3j5 -+ __basicusername_a3j6 -+ __basicpassword_a3j8 -+ __complianceClasses_a3j9 -+ __depth_a3ja -+ __httpManager_a3jb -+ __lockToken_a3jc -+ __userAgent_a3jd) -+ Data.Functor.<$> (_f_a3j3 __basicpassword'_a3j7)) -+{-# INLINE basicpassword #-} -+basicusername :: Control.Lens.Type.Lens' DAVContext B.ByteString -+basicusername -+ _f_a3je -+ (DAVContext __allowedMethods_a3jf -+ __baseRequest_a3jg -+ __basicusername'_a3jh -+ __basicpassword_a3jj -+ __complianceClasses_a3jk -+ __depth_a3jl -+ __httpManager_a3jm -+ __lockToken_a3jn -+ __userAgent_a3jo) -+ = ((\ __basicusername_a3ji -+ -> DAVContext -+ __allowedMethods_a3jf -+ __baseRequest_a3jg -+ __basicusername_a3ji -+ __basicpassword_a3jj -+ __complianceClasses_a3jk -+ __depth_a3jl -+ __httpManager_a3jm -+ __lockToken_a3jn -+ __userAgent_a3jo) -+ Data.Functor.<$> (_f_a3je __basicusername'_a3jh)) -+{-# INLINE basicusername #-} -+complianceClasses :: -+ Control.Lens.Type.Lens' DAVContext [B.ByteString] -+complianceClasses -+ _f_a3jp -+ (DAVContext __allowedMethods_a3jq -+ __baseRequest_a3jr -+ __basicusername_a3js -+ __basicpassword_a3jt -+ __complianceClasses'_a3ju -+ __depth_a3jw -+ __httpManager_a3jx -+ __lockToken_a3jy -+ __userAgent_a3jz) -+ = ((\ __complianceClasses_a3jv -+ -> DAVContext -+ __allowedMethods_a3jq -+ __baseRequest_a3jr -+ __basicusername_a3js -+ __basicpassword_a3jt -+ __complianceClasses_a3jv -+ __depth_a3jw -+ __httpManager_a3jx -+ __lockToken_a3jy -+ __userAgent_a3jz) -+ Data.Functor.<$> (_f_a3jp __complianceClasses'_a3ju)) -+{-# INLINE complianceClasses #-} -+depth :: Control.Lens.Type.Lens' DAVContext (Maybe Depth) -+depth -+ _f_a3jA -+ (DAVContext __allowedMethods_a3jB -+ __baseRequest_a3jC -+ __basicusername_a3jD -+ __basicpassword_a3jE -+ __complianceClasses_a3jF -+ __depth'_a3jG -+ __httpManager_a3jI -+ __lockToken_a3jJ -+ __userAgent_a3jK) -+ = ((\ __depth_a3jH -+ -> DAVContext -+ __allowedMethods_a3jB -+ __baseRequest_a3jC -+ __basicusername_a3jD -+ __basicpassword_a3jE -+ __complianceClasses_a3jF -+ __depth_a3jH -+ __httpManager_a3jI -+ __lockToken_a3jJ -+ __userAgent_a3jK) -+ Data.Functor.<$> (_f_a3jA __depth'_a3jG)) -+{-# INLINE depth #-} -+httpManager :: Control.Lens.Type.Lens' DAVContext (Maybe Manager) -+httpManager -+ _f_a3jL -+ (DAVContext __allowedMethods_a3jM -+ __baseRequest_a3jN -+ __basicusername_a3jO -+ __basicpassword_a3jP -+ __complianceClasses_a3jQ -+ __depth_a3jR -+ __httpManager'_a3jS -+ __lockToken_a3jU -+ __userAgent_a3jV) -+ = ((\ __httpManager_a3jT -+ -> DAVContext -+ __allowedMethods_a3jM -+ __baseRequest_a3jN -+ __basicusername_a3jO -+ __basicpassword_a3jP -+ __complianceClasses_a3jQ -+ __depth_a3jR -+ __httpManager_a3jT -+ __lockToken_a3jU -+ __userAgent_a3jV) -+ Data.Functor.<$> (_f_a3jL __httpManager'_a3jS)) -+{-# INLINE httpManager #-} -+lockToken :: -+ Control.Lens.Type.Lens' DAVContext (Maybe B.ByteString) -+lockToken -+ _f_a3jW -+ (DAVContext __allowedMethods_a3jX -+ __baseRequest_a3jY -+ __basicusername_a3jZ -+ __basicpassword_a3k0 -+ __complianceClasses_a3k1 -+ __depth_a3k2 -+ __httpManager_a3k3 -+ __lockToken'_a3k4 -+ __userAgent_a3k6) -+ = ((\ __lockToken_a3k5 -+ -> DAVContext -+ __allowedMethods_a3jX -+ __baseRequest_a3jY -+ __basicusername_a3jZ -+ __basicpassword_a3k0 -+ __complianceClasses_a3k1 -+ __depth_a3k2 -+ __httpManager_a3k3 -+ __lockToken_a3k5 -+ __userAgent_a3k6) -+ Data.Functor.<$> (_f_a3jW __lockToken'_a3k4)) -+{-# INLINE lockToken #-} -+userAgent :: Control.Lens.Type.Lens' DAVContext B.ByteString -+userAgent -+ _f_a3k7 -+ (DAVContext __allowedMethods_a3k8 -+ __baseRequest_a3k9 -+ __basicusername_a3ka -+ __basicpassword_a3kb -+ __complianceClasses_a3kc -+ __depth_a3kd -+ __httpManager_a3ke -+ __lockToken_a3kf -+ __userAgent'_a3kg) -+ = ((\ __userAgent_a3kh -+ -> DAVContext -+ __allowedMethods_a3k8 -+ __baseRequest_a3k9 -+ __basicusername_a3ka -+ __basicpassword_a3kb -+ __complianceClasses_a3kc -+ __depth_a3kd -+ __httpManager_a3ke -+ __lockToken_a3kf -+ __userAgent_a3kh) -+ Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg)) -+{-# INLINE userAgent #-} --- -2.1.1 - diff --git a/standalone/no-th/haskell-patches/aeson_remove-TH.patch b/standalone/no-th/haskell-patches/aeson_remove-TH.patch deleted file mode 100644 index dc40de79ed..0000000000 --- a/standalone/no-th/haskell-patches/aeson_remove-TH.patch +++ /dev/null @@ -1,40 +0,0 @@ -From f147ec9aeaa03ca6e30232c84c413ef29b95fb62 Mon Sep 17 00:00:00 2001 -From: Your Name <you@example.com> -Date: Tue, 20 May 2014 19:53:55 +0000 -Subject: [PATCH] avoid TH - ---- - aeson.cabal | 3 --- - 1 file changed, 3 deletions(-) - -diff --git a/aeson.cabal b/aeson.cabal -index 493d625..02dc6f4 100644 ---- a/aeson.cabal -+++ b/aeson.cabal -@@ -88,7 +88,6 @@ library - Data.Aeson.Generic - Data.Aeson.Parser - Data.Aeson.Types -- Data.Aeson.TH - - other-modules: - Data.Aeson.Functions -@@ -121,7 +120,6 @@ library - old-locale, - scientific >= 0.3.1 && < 0.4, - syb, -- template-haskell >= 2.4, - time, - unordered-containers >= 0.2.3.0, - vector >= 0.7.1 -@@ -164,7 +162,6 @@ test-suite tests - base, - containers, - bytestring, -- template-haskell, - test-framework, - test-framework-quickcheck2, - test-framework-hunit, --- -2.0.0.rc2 - diff --git a/standalone/no-th/haskell-patches/file-embed_remove-TH.patch b/standalone/no-th/haskell-patches/file-embed_remove-TH.patch deleted file mode 100644 index 12e344504c..0000000000 --- a/standalone/no-th/haskell-patches/file-embed_remove-TH.patch +++ /dev/null @@ -1,132 +0,0 @@ -From 497d09a91f9eb1e5979948cd128078491b0e8bca Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Fri, 12 Sep 2014 20:52:08 -0400 -Subject: [PATCH] remove TH - ---- - Data/FileEmbed.hs | 87 ++++--------------------------------------------------- - 1 file changed, 5 insertions(+), 82 deletions(-) - -diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs -index 5617493..adacdba 100644 ---- a/Data/FileEmbed.hs -+++ b/Data/FileEmbed.hs -@@ -17,13 +17,13 @@ - -- > {-# LANGUAGE TemplateHaskell #-} - module Data.FileEmbed - ( -- * Embed at compile time -- embedFile -- , embedOneFileOf -- , embedDir -- , getDir -+ -- embedFile -+ --, embedOneFileOf -+ --, embedDir -+ getDir - -- * Inject into an executable - #if MIN_VERSION_template_haskell(2,5,0) -- , dummySpace -+ --, dummySpace - #endif - , inject - , injectFile -@@ -56,73 +56,12 @@ import Data.ByteString.Unsafe (unsafePackAddressLen) - import System.IO.Unsafe (unsafePerformIO) - import System.FilePath ((</>)) - ---- | Embed a single file in your source code. ---- ---- > import qualified Data.ByteString ---- > ---- > myFile :: Data.ByteString.ByteString ---- > myFile = $(embedFile "dirName/fileName") --embedFile :: FilePath -> Q Exp --embedFile fp = --#if MIN_VERSION_template_haskell(2,7,0) -- qAddDependentFile fp >> --#endif -- (runIO $ B.readFile fp) >>= bsToExp -- ---- | Embed a single existing file in your source code ---- out of list a list of paths supplied. ---- ---- > import qualified Data.ByteString ---- > ---- > myFile :: Data.ByteString.ByteString ---- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ]) --embedOneFileOf :: [FilePath] -> Q Exp --embedOneFileOf ps = -- (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do --#if MIN_VERSION_template_haskell(2,7,0) -- qAddDependentFile path --#endif -- bsToExp content -- where -- readExistingFile :: [FilePath] -> IO ( FilePath, B.ByteString ) -- readExistingFile xs = do -- ys <- filterM doesFileExist xs -- case ys of -- (p:_) -> B.readFile p >>= \ c -> return ( p, c ) -- _ -> throw $ ErrorCall "Cannot find file to embed as resource" -- ---- | Embed a directory recursively in your source code. ---- ---- > import qualified Data.ByteString ---- > ---- > myDir :: [(FilePath, Data.ByteString.ByteString)] ---- > myDir = $(embedDir "dirName") --embedDir :: FilePath -> Q Exp --embedDir fp = do -- typ <- [t| [(FilePath, B.ByteString)] |] -- e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp)) -- return $ SigE e typ -- - -- | Get a directory tree in the IO monad. - -- - -- This is the workhorse of 'embedDir' - getDir :: FilePath -> IO [(FilePath, B.ByteString)] - getDir = fileList - --pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp --pairToExp _root (path, bs) = do --#if MIN_VERSION_template_haskell(2,7,0) -- qAddDependentFile $ _root ++ '/' : path --#endif -- exp' <- bsToExp bs -- return $! TupE [LitE $ StringL path, exp'] -- --bsToExp :: B.ByteString -> Q Exp --bsToExp bs = do -- helper <- [| stringToBs |] -- let chars = B8.unpack bs -- return $! AppE helper $! LitE $! StringL chars -- - stringToBs :: String -> B.ByteString - stringToBs = B8.pack - -@@ -164,22 +103,6 @@ padSize i = - let s = show i - in replicate (sizeLen - length s) '0' ++ s - --#if MIN_VERSION_template_haskell(2,5,0) --dummySpace :: Int -> Q Exp --dummySpace space = do -- let size = padSize space -- let start = magic ++ size -- let chars = LitE $ StringPrimL $ --#if MIN_VERSION_template_haskell(2,6,0) -- map (toEnum . fromEnum) $ --#endif -- start ++ replicate space '0' -- let len = LitE $ IntegerL $ fromIntegral $ length start + space -- upi <- [|unsafePerformIO|] -- pack <- [|unsafePackAddressLen|] -- getInner' <- [|getInner|] -- return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars)) --#endif - - inject :: B.ByteString -- ^ bs to inject - -> B.ByteString -- ^ original BS containing dummy --- -2.1.0 - diff --git a/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch b/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch deleted file mode 100644 index 83c8ffd2a7..0000000000 --- a/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch +++ /dev/null @@ -1,394 +0,0 @@ -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/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch deleted file mode 100644 index bc453bfa1a..0000000000 --- a/standalone/no-th/haskell-patches/lens_no-TH.patch +++ /dev/null @@ -1,230 +0,0 @@ -From 10c9ade98b3ac2054947f411d77db2eb28896b9f Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 01:43:10 +0000 -Subject: [PATCH] avoid TH - ---- - lens.cabal | 17 +---------------- - src/Control/Lens.hs | 8 ++------ - src/Control/Lens/Cons.hs | 2 -- - src/Control/Lens/Internal/Fold.hs | 2 -- - src/Control/Lens/Operators.hs | 2 +- - src/Control/Lens/Prism.hs | 2 -- - src/Control/Monad/Primitive/Lens.hs | 1 - - 7 files changed, 4 insertions(+), 30 deletions(-) - -diff --git a/lens.cabal b/lens.cabal -index 5388301..d7b02b9 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-2014 Edward A. Kmett --build-type: Custom -+build-type: Simple - -- build-tools: cpphs - tested-with: GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2 - synopsis: Lenses, Folds and Traversals -@@ -217,7 +217,6 @@ library - Control.Exception.Lens - Control.Lens - Control.Lens.Action -- Control.Lens.At - Control.Lens.Combinators - Control.Lens.Cons - Control.Lens.Each -@@ -234,8 +233,6 @@ library - Control.Lens.Internal.Context - Control.Lens.Internal.Deque - Control.Lens.Internal.Exception -- Control.Lens.Internal.FieldTH -- Control.Lens.Internal.PrismTH - Control.Lens.Internal.Fold - Control.Lens.Internal.Getter - Control.Lens.Internal.Indexed -@@ -247,25 +244,21 @@ library - Control.Lens.Internal.Reflection - Control.Lens.Internal.Review - Control.Lens.Internal.Setter -- Control.Lens.Internal.TH - Control.Lens.Internal.Zoom - Control.Lens.Iso - Control.Lens.Lens - Control.Lens.Level - Control.Lens.Loupe - Control.Lens.Operators -- Control.Lens.Plated - Control.Lens.Prism - Control.Lens.Reified - Control.Lens.Review - Control.Lens.Setter -- Control.Lens.TH - Control.Lens.Traversal - Control.Lens.Tuple - Control.Lens.Type - Control.Lens.Wrapped - Control.Lens.Zoom -- Control.Monad.Error.Lens - Control.Monad.Primitive.Lens - Control.Parallel.Strategies.Lens - Control.Seq.Lens -@@ -291,12 +284,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 - - other-modules: -@@ -403,7 +392,6 @@ test-suite doctests - deepseq, - doctest >= 0.9.1, - filepath, -- generic-deriving, - mtl, - nats, - parallel, -@@ -441,7 +429,6 @@ benchmark plated - comonad, - criterion, - deepseq, -- generic-deriving, - lens, - transformers - -@@ -476,7 +463,6 @@ benchmark unsafe - comonads-fd, - criterion, - deepseq, -- generic-deriving, - lens, - transformers - -@@ -493,6 +479,5 @@ benchmark zipper - comonads-fd, - criterion, - deepseq, -- generic-deriving, - lens, - transformers -diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs -index 7e15267..433f1fc 100644 ---- a/src/Control/Lens.hs -+++ b/src/Control/Lens.hs -@@ -41,7 +41,6 @@ - ---------------------------------------------------------------------------- - module Control.Lens - ( module Control.Lens.Action -- , module Control.Lens.At - , module Control.Lens.Cons - , module Control.Lens.Each - , module Control.Lens.Empty -@@ -53,12 +52,11 @@ module Control.Lens - , module Control.Lens.Lens - , module Control.Lens.Level - , module Control.Lens.Loupe -- , module Control.Lens.Plated - , module Control.Lens.Prism - , module Control.Lens.Reified - , module Control.Lens.Review - , module Control.Lens.Setter --#ifndef DISABLE_TEMPLATE_HASKELL -+#if 0 - , module Control.Lens.TH - #endif - , module Control.Lens.Traversal -@@ -69,7 +67,6 @@ module Control.Lens - ) where - - import Control.Lens.Action --import Control.Lens.At - import Control.Lens.Cons - import Control.Lens.Each - import Control.Lens.Empty -@@ -81,12 +78,11 @@ import Control.Lens.Iso - import Control.Lens.Lens - import Control.Lens.Level - import Control.Lens.Loupe --import Control.Lens.Plated - import Control.Lens.Prism - import Control.Lens.Reified - import Control.Lens.Review - import Control.Lens.Setter --#ifndef DISABLE_TEMPLATE_HASKELL -+#if 0 - import Control.Lens.TH - #endif - import Control.Lens.Traversal -diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs -index a80e9c8..7d27b80 100644 ---- a/src/Control/Lens/Cons.hs -+++ b/src/Control/Lens/Cons.hs -@@ -55,8 +55,6 @@ import Data.Vector.Unboxed (Unbox) - import qualified Data.Vector.Unboxed as Unbox - import Data.Word - --{-# ANN module "HLint: ignore Eta reduce" #-} -- - -- $setup - -- >>> :set -XNoOverloadedStrings - -- >>> import Control.Lens -diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs -index ab09c6b..43aa905 100644 ---- a/src/Control/Lens/Internal/Fold.hs -+++ b/src/Control/Lens/Internal/Fold.hs -@@ -37,8 +37,6 @@ import Data.Maybe - import Data.Semigroup hiding (Min, getMin, Max, getMax) - import Data.Reflection - --{-# ANN module "HLint: ignore Avoid lambda" #-} -- - ------------------------------------------------------------------------------ - -- Folding - ------------------------------------------------------------------------------ -diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs -index 9992e63..631e8e6 100644 ---- a/src/Control/Lens/Operators.hs -+++ b/src/Control/Lens/Operators.hs -@@ -111,7 +111,7 @@ module Control.Lens.Operators - , (<#~) - , (<#=) - -- * "Control.Lens.Plated" -- , (...) -+ --, (...) - -- * "Control.Lens.Review" - , ( # ) - -- * "Control.Lens.Setter" -diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs -index b75c870..c6c6596 100644 ---- a/src/Control/Lens/Prism.hs -+++ b/src/Control/Lens/Prism.hs -@@ -61,8 +61,6 @@ import Unsafe.Coerce - import Data.Profunctor.Unsafe - #endif - --{-# ANN module "HLint: ignore Use camelCase" #-} -- - -- $setup - -- >>> :set -XNoOverloadedStrings - -- >>> import Control.Lens -diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs -index ee942c6..2f37134 100644 ---- a/src/Control/Monad/Primitive/Lens.hs -+++ b/src/Control/Monad/Primitive/Lens.hs -@@ -20,7 +20,6 @@ import Control.Lens - import Control.Monad.Primitive (PrimMonad(..)) - import GHC.Prim (State#) - --{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-} - - prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) - prim = iso internal primitive --- -2.1.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 deleted file mode 100644 index c24fa5aa26..0000000000 --- a/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch +++ /dev/null @@ -1,27 +0,0 @@ -From 8e78a25ce0cc19e52d063f66bd4cd316462393d4 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 6 Mar 2014 23:27:06 +0000 -Subject: [PATCH] disable th - ---- - monad-logger.cabal | 4 ++-- - 1 file changed, 2 insertions(+), 2 deletions(-) - -diff --git a/monad-logger.cabal b/monad-logger.cabal -index b0aa271..cd56c0f 100644 ---- a/monad-logger.cabal -+++ b/monad-logger.cabal -@@ -14,8 +14,8 @@ cabal-version: >=1.8 - - flag template_haskell { - Description: Enable Template Haskell support -- Default: True -- Manual: True -+ Default: False -+ Manual: False - } - - library --- -1.9.0 - diff --git a/standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch b/standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch deleted file mode 100644 index 1bb843524e..0000000000 --- a/standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch +++ /dev/null @@ -1,33 +0,0 @@ -From b128590966d4946219e45e2efd88acf7a354abc2 Mon Sep 17 00:00:00 2001 -From: androidbuilder <androidbuilder@example.com> -Date: Tue, 14 Oct 2014 02:28:02 +0000 -Subject: [PATCH] remove ANN - ---- - Options/Applicative.hs | 2 -- - Options/Applicative/Help/Core.hs | 2 -- - 2 files changed, 4 deletions(-) - -diff --git a/Options/Applicative.hs b/Options/Applicative.hs -index bd4129d..f412062 100644 ---- a/Options/Applicative.hs -+++ b/Options/Applicative.hs -@@ -34,5 +34,3 @@ import Options.Applicative.Common - import Options.Applicative.Builder - import Options.Applicative.Builder.Completer - import Options.Applicative.Extra -- --{-# ANN module "HLint: ignore Use import/export shortcut" #-} -diff --git a/Options/Applicative/Help/Core.hs b/Options/Applicative/Help/Core.hs -index 0a79169..3f1ce3f 100644 ---- a/Options/Applicative/Help/Core.hs -+++ b/Options/Applicative/Help/Core.hs -@@ -139,5 +139,3 @@ parserUsage pprefs p progn = hsep - [ string "Usage:" - , string progn - , align (extractChunk (briefDesc pprefs p)) ] -- --{-# ANN footerHelp "HLint: ignore Eta reduce" #-} --- -1.7.10.4 - diff --git a/standalone/no-th/haskell-patches/persistent-template_stub-out.patch b/standalone/no-th/haskell-patches/persistent-template_stub-out.patch deleted file mode 100644 index 506fa1add0..0000000000 --- a/standalone/no-th/haskell-patches/persistent-template_stub-out.patch +++ /dev/null @@ -1,68 +0,0 @@ -From b22a4d77c1262f77ce4298b53ca90a138a14ceb7 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joeyh@joeyh.name> -Date: Sun, 22 Feb 2015 15:21:19 -0400 -Subject: [PATCH] stub out TH - -this method avoids needing to delete the entire file contents, so patch is -kept minimal ---- - Database/Persist/TH.hs | 1 + - persistent-template.cabal | 1 + - stub/Database/Persist/TH.hs | 21 +++++++++++++++++++++ - 3 files changed, 23 insertions(+) - create mode 100644 stub/Database/Persist/TH.hs - -diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs -index 43eb3ee..2172b77 100644 ---- a/Database/Persist/TH.hs -+++ b/Database/Persist/TH.hs -@@ -35,6 +35,7 @@ module Database.Persist.TH - -- * Internal - , packPTH - , lensPTH -+ , plusPlus - ) where - - import Prelude hiding ((++), take, concat, splitAt) -diff --git a/persistent-template.cabal b/persistent-template.cabal -index 59b4149..4705d97 100644 ---- a/persistent-template.cabal -+++ b/persistent-template.cabal -@@ -30,6 +30,7 @@ library - ghc-options: -Wall - if impl(ghc >= 7.4) - cpp-options: -DGHC_7_4 -+ hs-source-dirs: stub - - test-suite test - type: exitcode-stdio-1.0 -diff --git a/stub/Database/Persist/TH.hs b/stub/Database/Persist/TH.hs -new file mode 100644 -index 0000000..dfbb874 ---- /dev/null -+++ b/stub/Database/Persist/TH.hs -@@ -0,0 +1,21 @@ -+{-# LANGUAGE RecordWildCards #-} -+{-# LANGUAGE CPP #-} -+{-# LANGUAGE OverloadedStrings #-} -+{-# LANGUAGE RankNTypes #-} -+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-fields #-} -+-- | This module provides utilities for creating backends. Regular users do not -+-- need to use this module. -+module Database.Persist.TH where -+ -+import Data.Text -+ -+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t -+ -+lensPTH :: (s -> a) -> (s -> b -> t) -> Lens s t a b -+lensPTH sa sbt afb s = fmap (sbt s) (afb $ sa s) -+ -+packPTH :: String -> Text -+packPTH = pack -+#if !MIN_VERSION_text(0, 11, 2) -+{-# NOINLINE packPTH #-} -+#endif --- -2.1.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 deleted file mode 100644 index cd86ccd2db..0000000000 --- a/standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch +++ /dev/null @@ -1,41 +0,0 @@ -From aae3ace106cf26c931cc94c96fb6fbfe83f950f2 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Wed, 15 Oct 2014 17:05:37 +0000 -Subject: [PATCH] avoid TH - ---- - Database/Persist/Sql/Raw.hs | 4 +--- - 1 file changed, 1 insertion(+), 3 deletions(-) - -diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs -index 3ac2ca9..bcc2011 100644 ---- a/Database/Persist/Sql/Raw.hs -+++ b/Database/Persist/Sql/Raw.hs -@@ -11,7 +11,7 @@ import Data.IORef (writeIORef, readIORef, newIORef) - import Control.Exception (throwIO) - import Control.Monad (when, liftM) - import Data.Text (Text, pack) --import Control.Monad.Logger (logDebugS) -+--import Control.Monad.Logger (logDebugS) - import Data.Int (Int64) - import Control.Monad.Trans.Class (lift) - import qualified Data.Text as T -@@ -23,7 +23,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m) - -> [PersistValue] - -> Source m [PersistValue] - rawQuery sql vals = do -- lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals - conn <- lift askSqlConn - bracketP - (getStmtConn conn sql) -@@ -35,7 +34,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y - - rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64 - rawExecuteCount sql vals = do -- $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals - stmt <- getStmt sql - res <- liftIO $ stmtExecute stmt vals - liftIO $ stmtReset stmt --- -2.1.1 - diff --git a/standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch b/standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch deleted file mode 100644 index 875119afdb..0000000000 --- a/standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch +++ /dev/null @@ -1,24 +0,0 @@ -From ed77588c57704030a9d412dd49f11c172c6268ab Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Tue, 14 Oct 2014 03:46:03 +0000 -Subject: [PATCH] unused - ---- - process-conduit.cabal | 1 - - 1 file changed, 1 deletion(-) - -diff --git a/process-conduit.cabal b/process-conduit.cabal -index 34bb168..2f137a8 100644 ---- a/process-conduit.cabal -+++ b/process-conduit.cabal -@@ -22,7 +22,6 @@ source-repository head - - library - exposed-modules: Data.Conduit.ProcessOld -- System.Process.QQ - - build-depends: base == 4.* - , template-haskell >= 2.4 --- -1.7.10.4 - 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 deleted file mode 100644 index 45397f3e5d..0000000000 --- a/standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch +++ /dev/null @@ -1,26 +0,0 @@ -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 deleted file mode 100644 index 4f8b4bc20f..0000000000 --- a/standalone/no-th/haskell-patches/reflection_remove-TH.patch +++ /dev/null @@ -1,59 +0,0 @@ -From c0f5dcfd6ba7a05bb84b6adc4664c8dde109e6ac Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Fri, 7 Mar 2014 04:30:22 +0000 -Subject: [PATCH] remove TH - ---- - fast/Data/Reflection.hs | 8 +++++--- - 1 file changed, 5 insertions(+), 3 deletions(-) - -diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs -index ca57d35..d3f8356 100644 ---- a/fast/Data/Reflection.hs -+++ b/fast/Data/Reflection.hs -@@ -59,7 +59,7 @@ module Data.Reflection - , Given(..) - , give - -- * Template Haskell reflection -- , int, nat -+ --, int, nat - -- * Useful compile time naturals - , Z, D, SD, PD - ) where -@@ -161,6 +161,7 @@ instance Reifies n Int => Reifies (PD n) Int where - -- instead of @$(int 3)@. Sometimes the two will produce the same - -- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor - -- directive). -+{- - int :: Int -> TypeQ - int n = case quotRem n 2 of - (0, 0) -> conT ''Z -@@ -176,7 +177,7 @@ nat :: Int -> TypeQ - nat n - | n >= 0 = int n - | otherwise = error "nat: negative" -- -+-} - #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704 - instance Show (Q a) - instance Eq (Q a) -@@ -195,6 +196,7 @@ instance Fractional a => Fractional (Q a) where - recip = fmap recip - fromRational = return . fromRational - -+{- - -- | This permits the use of $(5) as a type splice. - instance Num Type where - #ifdef USE_TYPE_LITS -@@ -254,7 +256,7 @@ instance Num Exp where - abs = onProxyType1 abs - signum = onProxyType1 signum - fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n) -- -+-} - #ifdef USE_TYPE_LITS - addProxy :: Proxy a -> Proxy b -> Proxy (a + b) - addProxy _ _ = Proxy --- -1.9.0 - diff --git a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch deleted file mode 100644 index 68226dcc6f..0000000000 --- a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch +++ /dev/null @@ -1,1438 +0,0 @@ -From 4694f3a7ee4eb15d33ecda9d62712ea236304c1b Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 2 Jul 2015 22:17:29 +0000 -Subject: [PATCH] hack TH - ---- - Text/Cassius.hs | 30 +--- - Text/Coffee.hs | 56 +------- - Text/Css.hs | 151 --------------------- - Text/CssCommon.hs | 22 --- - Text/Hamlet.hs | 346 +++-------------------------------------------- - Text/Julius.hs | 59 +------- - Text/Lucius.hs | 47 +------ - Text/Roy.hs | 52 +------ - Text/Shakespeare.hs | 70 ++-------- - Text/Shakespeare/Base.hs | 28 ---- - Text/Shakespeare/Text.hs | 117 ++-------------- - Text/TypeScript.hs | 48 +------ - shakespeare.cabal | 6 +- - 13 files changed, 69 insertions(+), 963 deletions(-) - -diff --git a/Text/Cassius.hs b/Text/Cassius.hs -index ba73bdd..ffe7c51 100644 ---- a/Text/Cassius.hs -+++ b/Text/Cassius.hs -@@ -14,12 +14,7 @@ module Text.Cassius - , renderCss - , renderCssUrl - -- * Parsing -- , cassius -- , cassiusFile -- , cassiusFileDebug -- , cassiusFileReload - -- ** Mixims -- , cassiusMixin - , Mixin - -- * ToCss instances - -- ** Color -@@ -27,15 +22,12 @@ module Text.Cassius - , colorRed - , colorBlack - -- ** Size -- , mkSize -+ --, mkSize - , AbsoluteUnit (..) - , AbsoluteSize (..) - , absoluteSize -- , EmSize (..) -- , ExSize (..) - , PercentageSize (..) - , percentageSize -- , PixelSize (..) - -- * Internal - , cassiusUsedIdentifiers - ) where -@@ -47,25 +39,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)] -@@ -74,10 +50,6 @@ cassiusUsedIdentifiers = cssUsedIdentifiers True Text.Lucius.parseTopLevels - -- | Create a mixin with Cassius syntax. - -- - -- Since 2.0.3 --cassiusMixin :: QuasiQuoter --cassiusMixin = QuasiQuoter -- { quoteExp = quoteExp Text.Lucius.luciusMixin . i2bMixin -- } - - i2bMixin :: String -> String - i2bMixin s' = -diff --git a/Text/Coffee.hs b/Text/Coffee.hs -index 488c81b..4e28c94 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/Css.hs b/Text/Css.hs -index 75dc549..20c206c 100644 ---- a/Text/Css.hs -+++ b/Text/Css.hs -@@ -166,22 +166,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] -@@ -287,18 +271,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) = -@@ -342,111 +314,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 -@@ -515,23 +384,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..0635cf4 100644 ---- a/Text/CssCommon.hs -+++ b/Text/CssCommon.hs -@@ -1,4 +1,3 @@ --{-# LANGUAGE TemplateHaskell #-} - {-# LANGUAGE GeneralizedNewtypeDeriving #-} - {-# LANGUAGE FlexibleInstances #-} - {-# LANGUAGE CPP #-} -@@ -47,24 +46,6 @@ colorBlack = Color 0 0 0 - - -- CSS size wrappers - ---- | Create a CSS size, e.g. $(mkSize "100px"). --mkSize :: String -> ExpQ --mkSize s = appE nameE valueE -- where [(value, unit)] = reads s :: [(Double, String)] -- absoluteSizeE = varE $ mkName "absoluteSize" -- nameE = case unit of -- "cm" -> appE absoluteSizeE (conE $ mkName "Centimeter") -- "em" -> conE $ mkName "EmSize" -- "ex" -> conE $ mkName "ExSize" -- "in" -> appE absoluteSizeE (conE $ mkName "Inch") -- "mm" -> appE absoluteSizeE (conE $ mkName "Millimeter") -- "pc" -> appE absoluteSizeE (conE $ mkName "Pica") -- "pt" -> appE absoluteSizeE (conE $ mkName "Point") -- "px" -> conE $ mkName "PixelSize" -- "%" -> varE $ mkName "percentageSize" -- _ -> error $ "In mkSize, invalid unit: " ++ unit -- valueE = litE $ rationalL (toRational value) -- - -- | Absolute size units. - data AbsoluteUnit = Centimeter - | Inch -@@ -156,6 +137,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/Hamlet.hs b/Text/Hamlet.hs -index 4618be3..4ad3633 100644 ---- a/Text/Hamlet.hs -+++ b/Text/Hamlet.hs -@@ -11,36 +11,36 @@ - module Text.Hamlet - ( -- * Plain HTML - Html -- , shamlet -- , shamletFile -- , xshamlet -- , xshamletFile -+ --, shamlet -+ --, shamletFile -+ --, xshamlet -+ --, xshamletFile - -- * Hamlet - , HtmlUrl -- , hamlet -- , hamletFile -- , hamletFileReload -- , ihamletFileReload -- , xhamlet -- , xhamletFile -+ --, hamlet -+ -- , hamletFile -+ -- , hamletFileReload -+ -- , ihamletFileReload -+ -- , 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 -@@ -109,48 +109,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)) -- | s == "_" = return (WildP, []) -- | 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 - -@@ -158,257 +119,15 @@ 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 -- 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 -- hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s -- - docFromString :: HamletSettings -> String -> [Doc] - docFromString set s = - case parseDoc set s of - Error s' -> error s' - Ok (_, d) -> 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 -- --hamletFileReload :: FilePath -> Q Exp --hamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings -- where runtimeRules = HamletRuntimeRules { hrrI18n = False } -- --ihamletFileReload :: FilePath -> Q Exp --ihamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings -- where runtimeRules = HamletRuntimeRules { hrrI18n = True } -- --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 - -- first is performed. In there are no true values, then the second argument is -@@ -461,33 +180,6 @@ data HamletRuntimeRules = HamletRuntimeRules { - hrrI18n :: Bool - } - --hamletFileReloadWithSettings :: HamletRuntimeRules -- -> HamletSettings -> FilePath -> Q Exp --hamletFileReloadWithSettings hrr settings fp = do -- s <- readFileQ fp -- let b = hamletUsedIdentifiers settings s -- c <- mapM vtToExp b -- rt <- if hrrI18n hrr -- then [|hamletRuntimeMsg settings fp|] -- else [|hamletRuntime settings fp|] -- return $ rt `AppE` ListE c -- where -- vtToExp :: (Deref, VarType) -> Q Exp -- vtToExp (d, vt) = do -- d' <- lift d -- c' <- toExp vt -- return $ TupE [d', c' `AppE` derefToExp [] d] -- where -- toExp = c -- where -- c :: VarType -> Q Exp -- c VTAttrs = [|EPlain . attrsToHtml . toAttributes|] -- c VTPlain = [|EPlain . toHtml|] -- c VTUrl = [|EUrl|] -- c VTUrlParam = [|EUrlParam|] -- c VTMixin = [|\r -> EMixin $ \c -> r c|] -- c VTMsg = [|EMsg|] -- - -- move to Shakespeare.Base? - readFileUtf8 :: FilePath -> IO String - readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp -diff --git a/Text/Julius.hs b/Text/Julius.hs -index 8c15a99..47b42fd 100644 ---- a/Text/Julius.hs -+++ b/Text/Julius.hs -@@ -14,17 +14,9 @@ module Text.Julius - -- ** Template-Reading Functions - -- | These QuasiQuoter and Template Haskell methods return values of - -- type @'JavascriptUrl' url@. See the Yesod book for details. -- js -- , julius -- , juliusFile -- , jsFile -- , juliusFileDebug -- , jsFileDebug -- , juliusFileReload -- , jsFileReload - - -- * Datatypes -- , JavascriptUrl -+ JavascriptUrl - , Javascript (..) - , RawJavascript (..) - -@@ -37,9 +29,9 @@ module Text.Julius - , renderJavascriptUrl - - -- ** internal, used by 'Text.Coffee' -- , javascriptSettings -+ --, javascriptSettings - -- ** internal -- , juliusUsedIdentifiers -+ --, juliusUsedIdentifiers - , asJavascriptUrl - ) where - -@@ -102,48 +94,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/Lucius.hs b/Text/Lucius.hs -index 3226b79..fd0b7be 100644 ---- a/Text/Lucius.hs -+++ b/Text/Lucius.hs -@@ -9,13 +9,13 @@ - {-# OPTIONS_GHC -fno-warn-missing-fields #-} - module Text.Lucius - ( -- * Parsing -- lucius -- , luciusFile -- , luciusFileDebug -- , luciusFileReload -+ -- lucius -+ --, luciusFile -+ --, luciusFileDebug -+ --, luciusFileReload - -- ** Mixins -- , luciusMixin -- , Mixin -+ --, luciusMixin -+ Mixin - -- ** Runtime - , luciusRT - , luciusRT' -@@ -37,15 +37,12 @@ module Text.Lucius - , colorRed - , colorBlack - -- ** Size -- , mkSize -+ --, mkSize - , AbsoluteUnit (..) - , AbsoluteSize (..) - , absoluteSize -- , EmSize (..) -- , ExSize (..) - , PercentageSize (..) - , percentageSize -- , PixelSize (..) - -- * Internal - , parseTopLevels - , luciusUsedIdentifiers -@@ -72,13 +69,6 @@ import Text.Shakespeare (VarType) - -- - -- >>> 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 () -@@ -219,18 +209,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 = - go id -@@ -379,14 +357,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $ - 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', "}"] -diff --git a/Text/Roy.hs b/Text/Roy.hs -index 6e5e246..a08b019 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 - -@@ -52,47 +52,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..)) - 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/Shakespeare.hs b/Text/Shakespeare.hs -index 98c0c2d..2f6431b 100644 ---- a/Text/Shakespeare.hs -+++ b/Text/Shakespeare.hs -@@ -16,12 +16,12 @@ module Text.Shakespeare - , WrapInsertion (..) - , PreConversion (..) - , defaultShakespeareSettings -- , shakespeare -- , shakespeareFile -- , shakespeareFileReload -+ -- , shakespeare -+ -- , shakespeareFile -+ -- , shakespeareFileReload - -- * low-level -- , shakespeareFromString -- , shakespeareUsedIdentifiers -+ -- , shakespeareFromString -+ -- , shakespeareUsedIdentifiers - , RenderUrl - , VarType (..) - , Deref -@@ -153,38 +153,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) -@@ -348,6 +316,7 @@ pack' = TS.pack - {-# NOINLINE pack' #-} - #endif - -+{- - contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp - contentsToShakespeare rs a = do - r <- newName "_render" -@@ -399,16 +368,19 @@ shakespeareFile r fp = - qAddDependentFile fp >> - #endif - readFileQ fp >>= shakespeareFromString r -+-} - - data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) - -+{- - 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 -@@ -417,8 +389,10 @@ data VarExp url = EPlain Builder - - -- | 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 - -@@ -435,28 +409,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 a0e983c..23b4692 100644 ---- a/Text/Shakespeare/Base.hs -+++ b/Text/Shakespeare/Base.hs -@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident - | DerefTuple [Deref] - deriving (Show, Eq, Read, Data, Typeable, Ord) - --instance Lift Ident where -- lift (Ident s) = [|Ident|] `appE` lift s --instance Lift Deref where -- lift (DerefModulesIdent v s) = do -- dl <- [|DerefModulesIdent|] -- v' <- lift v -- s' <- lift s -- return $ dl `AppE` v' `AppE` s' -- lift (DerefIdent s) = do -- dl <- [|DerefIdent|] -- s' <- lift s -- return $ dl `AppE` s' -- lift (DerefBranch x y) = do -- x' <- lift x -- y' <- lift y -- db <- [|DerefBranch|] -- return $ db `AppE` x' `AppE` y' -- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i -- lift (DerefRational r) = do -- n <- lift $ numerator r -- d <- lift $ denominator r -- per <- [|(%) :: Int -> Int -> Ratio Int|] -- dr <- [|DerefRational|] -- return $ dr `AppE` InfixE (Just n) per (Just d) -- lift (DerefString s) = [|DerefString|] `appE` lift s -- lift (DerefList x) = [|DerefList $(lift x)|] -- lift (DerefTuple x) = [|DerefTuple $(lift x)|] -- - derefParens, derefCurlyBrackets :: UserParser a Deref - derefParens = between (char '(') (char ')') parseDeref - derefCurlyBrackets = between (char '{') (char '}') parseDeref -diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs -index f490d7f..5154618 100644 ---- a/Text/Shakespeare/Text.hs -+++ b/Text/Shakespeare/Text.hs -@@ -7,20 +7,20 @@ module Text.Shakespeare.Text - ( TextUrl - , ToText (..) - , renderTextUrl -- , stext -- , text -- , textFile -- , textFileDebug -- , textFileReload -- , st -- | strict text -- , lt -- | lazy text, same as stext :) -- , sbt -- | strict text whose left edge is aligned with bar ('|') -- , lbt -- | lazy text, whose left edge is aligned with bar ('|') -+ --, stext -+ --, text -+ --, textFile -+ --, textFileDebug -+ --, textFileReload -+ --, st -- | strict text -+ --, lt -- | lazy text, same as stext :) -+ --, sbt -- | strict text whose left edge is aligned with bar ('|') -+ --, lbt -- | lazy text, whose left edge is aligned with bar ('|') - -- * Yesod code generation -- , codegen -- , codegenSt -- , codegenFile -- , codegenFileReload -+ --, codegen -+ --, codegenSt -+ --, codegenFile -+ --, codegenFileReload - ) where - - import Language.Haskell.TH.Quote (QuasiQuoter (..)) -@@ -59,66 +59,12 @@ settings = do - } - - --stext, lt, st, text, lbt, sbt :: 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 -- } -- - dropBar :: [TL.Text] -> [TL.Text] - dropBar [] = [] - dropBar (c:cx) = c:dropBar' cx - where - dropBar' txt = reverse $ drop 1 $ map (TL.drop 1 . TL.dropWhile (/= '|')) $ reverse txt - --lbt = -- QuasiQuoter { quoteExp = \s -> do -- rs <- settings -- render <- [|TL.unlines . dropBar . TL.lines . toLazyText|] -- rendered <- shakespeareFromString rs { justVarInterpolation = True } s -- return (render `AppE` rendered) -- } -- --sbt = -- QuasiQuoter { quoteExp = \s -> do -- rs <- settings -- render <- [|TL.toStrict . TL.unlines . dropBar . TL.lines . toLazyText|] -- rendered <- shakespeareFromString rs { justVarInterpolation = True } s -- return (render `AppE` rendered) -- } -- --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 -@@ -135,40 +81,3 @@ codegenSettings = do - , 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) -diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs -index 85f6abd..3188272 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 - -@@ -74,43 +74,3 @@ 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 TypeScript 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 -diff --git a/shakespeare.cabal b/shakespeare.cabal -index 37029fc..2c4b557 100644 ---- a/shakespeare.cabal -+++ b/shakespeare.cabal -@@ -62,18 +62,16 @@ library - Text.Shakespeare.Base - Text.Shakespeare - Text.TypeScript -- other-modules: Text.Hamlet.Parse - Text.Css -+ Text.CssCommon -+ other-modules: Text.Hamlet.Parse - Text.MkSizeType - Text.IndentToBrace -- Text.CssCommon - ghc-options: -Wall - - if flag(test_export) - cpp-options: -DTEST_EXPORT - -- extensions: TemplateHaskell -- - if impl(ghc >= 7.4) - cpp-options: -DGHC_7_4 - --- -2.1.4 - diff --git a/standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch b/standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch deleted file mode 100644 index 7333742b00..0000000000 --- a/standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 3a04b41ffce4e4e87b0fedd3a1e3434a3f06cc76 Mon Sep 17 00:00:00 2001 -From: foo <foo@bar> -Date: Sun, 22 Sep 2013 00:18:12 +0000 -Subject: [PATCH] hardcode little endian - -This is the same as building with a cabal flag. - ---- - c_impl/optimized/skein_port.h | 1 + - 1 file changed, 1 insertion(+) - -diff --git a/c_impl/optimized/skein_port.h b/c_impl/optimized/skein_port.h -index a2d0fc2..6929bb0 100644 ---- a/c_impl/optimized/skein_port.h -+++ b/c_impl/optimized/skein_port.h -@@ -45,6 +45,7 @@ typedef uint64_t u64b_t; /* 64-bit unsigned integer */ - * platform-specific code instead (e.g., for big-endian CPUs).
- *
- */
-+#define SKEIN_NEED_SWAP (0)
- #ifndef SKEIN_NEED_SWAP /* compile-time "override" for endianness? */
-
- #include "brg_endian.h" /* get endianness selection */
--- -1.7.10.4 - diff --git a/standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch b/standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch deleted file mode 100644 index f89f0d60b5..0000000000 --- a/standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch +++ /dev/null @@ -1,49 +0,0 @@ -From 6ffd4fcb7d27ec6df709d80a40a262406446a259 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Wed, 15 Oct 2014 17:00:56 +0000 -Subject: [PATCH] cross build - ---- - Data/Vector/Fusion/Stream/Monadic.hs | 1 - - Data/Vector/Unboxed/Base.hs | 13 ------------- - 2 files changed, 14 deletions(-) - -diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs -index 51fec75..b089b3d 100644 ---- a/Data/Vector/Fusion/Stream/Monadic.hs -+++ b/Data/Vector/Fusion/Stream/Monadic.hs -@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) ) - - data SPEC = SPEC | SPEC2 - #if __GLASGOW_HASKELL__ >= 700 --{-# ANN type SPEC ForceSpecConstr #-} - #endif - - emptyStream :: String -diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs -index 00350cb..34bfc4a 100644 ---- a/Data/Vector/Unboxed/Base.hs -+++ b/Data/Vector/Unboxed/Base.hs -@@ -65,19 +65,6 @@ vectorTyCon = mkTyCon3 "vector" - vectorTyCon m s = mkTyCon $ m ++ "." ++ s - #endif - --instance Typeable1 Vector where -- typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] -- --instance Typeable2 MVector where -- typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] -- --instance (Data a, Unbox a) => Data (Vector a) where -- gfoldl = G.gfoldl -- toConstr _ = error "toConstr" -- gunfold _ _ = error "gunfold" -- dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector" -- dataCast1 = G.dataCast -- - -- ---- - -- Unit - -- ---- --- -2.1.1 - 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 deleted file mode 100644 index 93314312f7..0000000000 --- a/standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch +++ /dev/null @@ -1,82 +0,0 @@ -From 3aef808eee43c973ae1fbf6e8769d89b7f0d355b Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Tue, 10 Jun 2014 14:47:42 +0000 -Subject: [PATCH] deal with TH - -Export modules referenced by it. - -Should not need these icons in git-annex, so not worth using the Evil -Splicer. ---- - Network/Wai/Application/Static.hs | 4 ---- - WaiAppStatic/Storage/Embedded.hs | 8 ++++---- - 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 db2b835..b2c1aec 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 sendResponse - H.status405 - [("Content-Type", "text/plain")] - "Only GET is supported" --staticAppPieces _ [".hidden", "folder.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")] --staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")] - staticAppPieces ss rawPieces req sendResponse = liftIO $ do - 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 ef6f898..9a59d71 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 -@@ -61,9 +60,8 @@ library - WaiAppStatic.Listing - WaiAppStatic.Types - WaiAppStatic.CmdLine -- other-modules: Util - WaiAppStatic.Storage.Embedded.Runtime -- WaiAppStatic.Storage.Embedded.TH -+ other-modules: Util - ghc-options: -Wall - extensions: CPP - --- -2.0.0 - diff --git a/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch b/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch deleted file mode 100644 index b6334d31f4..0000000000 --- a/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch +++ /dev/null @@ -1,108 +0,0 @@ -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 deleted file mode 100644 index 3e0d0d9ba7..0000000000 --- a/standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch +++ /dev/null @@ -1,34 +0,0 @@ -From 583575461dc58b76c6c7e14d429f73182d49ef81 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Tue, 10 Jun 2014 20:29:51 +0000 -Subject: [PATCH] don't really build - ---- - yesod-auth.cabal | 11 ----------- - 1 file changed, 11 deletions(-) - -diff --git a/yesod-auth.cabal b/yesod-auth.cabal -index 906c08b..b4bc841 100644 ---- a/yesod-auth.cabal -+++ b/yesod-auth.cabal -@@ -65,17 +65,6 @@ library - , conduit-extra - , attoparsec-conduit - -- exposed-modules: Yesod.Auth -- Yesod.Auth.BrowserId -- Yesod.Auth.Dummy -- Yesod.Auth.Email -- Yesod.Auth.OpenId -- Yesod.Auth.Rpxnow -- Yesod.Auth.Message -- Yesod.Auth.GoogleEmail -- Yesod.Auth.GoogleEmail2 -- other-modules: Yesod.Auth.Routes -- Yesod.PasswordStore - ghc-options: -Wall - - source-repository head --- -2.0.0 - diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch deleted file mode 100644 index f58fcb353e..0000000000 --- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +++ /dev/null @@ -1,768 +0,0 @@ -From f1feea61dcba0b16afed5ce8dd5d2433fe505461 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:15:23 +0000 -Subject: [PATCH] hack TH - ---- - Yesod/Core.hs | 30 +++--- - Yesod/Core/Class/Yesod.hs | 256 ++++++++++++++++++++++++++++++--------------- - Yesod/Core/Dispatch.hs | 38 ++----- - Yesod/Core/Handler.hs | 25 ++--- - Yesod/Core/Internal/Run.hs | 6 +- - Yesod/Core/Internal/TH.hs | 111 -------------------- - Yesod/Core/Types.hs | 3 +- - Yesod/Core/Widget.hs | 32 +----- - 8 files changed, 213 insertions(+), 288 deletions(-) - -diff --git a/Yesod/Core.hs b/Yesod/Core.hs -index 9b29317..7c0792d 100644 ---- a/Yesod/Core.hs -+++ b/Yesod/Core.hs -@@ -31,16 +31,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 -@@ -87,17 +87,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 8631d27..c40eb10 100644 ---- a/Yesod/Core/Class/Yesod.hs -+++ b/Yesod/Core/Class/Yesod.hs -@@ -5,18 +5,22 @@ - {-# 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) - import Control.Arrow ((***), second) - import Control.Monad (forM, when, void) - import Control.Monad.IO.Class (MonadIO (liftIO)) --import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), -+import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther), - LogSource) - import qualified Data.ByteString.Char8 as S8 - import qualified Data.ByteString.Lazy as L -@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE - import Data.Text.Lazy.Builder (toLazyText) - import Data.Text.Lazy.Encoding (encodeUtf8) - import Data.Word (Word64) --import Language.Haskell.TH.Syntax (Loc (..)) - import Network.HTTP.Types (encodePath) - import qualified Network.Wai as W - import Data.Default (def) -@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where - defaultLayout w = do - p <- widgetToPageContent w - mmsg <- getMessage -- withUrlRenderer [hamlet| -- $newline never -- $doctype 5 -- <html> -- <head> -- <title>#{pageTitle p} -- ^{pageHead p} -- <body> -- $maybe msg <- mmsg -- <p .message>#{msg} -- ^{pageBody p} -- |] -+ withUrlRenderer $ \ _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 -@@ -374,45 +385,103 @@ widgetToPageContent w = do - -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing - -- the asynchronous loader means your page doesn't have to wait for all the js to load - let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc -- 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 -@@ -442,10 +511,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. -@@ -455,10 +527,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 -@@ -480,10 +553,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) -@@ -492,30 +568,42 @@ 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" .= TE.decodeUtf8With TEE.lenientDecode m] - - asyncHelper :: (url -> [x] -> Text) -@@ -682,8 +770,4 @@ loadClientSession key getCachedDate sessionName req = load - -- turn the TH Loc loaction information into a human readable string - -- leaving out the loc_end parameter - fileLocationToString :: Loc -> String --fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++ -- ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc) -- where -- line = show . fst . loc_start -- char = show . snd . loc_start -+fileLocationToString loc = "unknown" -diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs -index e0d1f0e..cc23fdd 100644 ---- a/Yesod/Core/Dispatch.hs -+++ b/Yesod/Core/Dispatch.hs -@@ -1,4 +1,3 @@ --{-# LANGUAGE TemplateHaskell #-} - {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE TypeFamilies #-} - {-# LANGUAGE FlexibleInstances #-} -@@ -6,18 +5,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 -@@ -135,13 +134,6 @@ toWaiAppLogger logger 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 - -@@ -170,14 +162,7 @@ warp port site = do - ] - -} - , Network.Wai.Handler.Warp.settingsOnException = const $ \e -> -- when (shouldLog' e) $ -- messageLoggerSource -- site -- logger -- $(qLocation >>= liftLoc) -- "yesod-core" -- LevelError -- (toLogStr $ "Exception from Warp: " ++ show e) -+ when (shouldLog' e) $ error (show e) - } - where - shouldLog' = -@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr - -- | Deprecated synonym for 'warp'. - warpDebug :: YesodDispatch site => Int -> site -> IO () - warpDebug = warp --{-# DEPRECATED warpDebug "Please use warp instead" #-} - - -- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It - -- reads port information from the PORT environment variable, as used by tools -diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs -index d2b196b..13cac17 100644 ---- a/Yesod/Core/Handler.hs -+++ b/Yesod/Core/Handler.hs -@@ -174,7 +174,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) - import Data.Text.Encoding.Error (lenientDecode) - import qualified Data.Text.Lazy as TL - import qualified Text.Blaze.Html.Renderer.Text as RenderText --import Text.Hamlet (Html, HtmlUrl, hamlet) -+import Text.Hamlet (Html, HtmlUrl) - - import qualified Data.ByteString as S - import qualified Data.ByteString.Lazy as L -@@ -203,6 +203,7 @@ import Control.Exception (throwIO) - import Blaze.ByteString.Builder (Builder) - import Safe (headMay) - import Data.CaseInsensitive (CI) -+import qualified Text.Blaze.Internal - import qualified Data.Conduit.List as CL - import Control.Monad (unless) - import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO -@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) - -> m a - redirectToPost url = do - urlText <- toTextUrl url -- withUrlRenderer [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 -+ withUrlRenderer $ \ _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 311f208..63f666f 100644 ---- a/Yesod/Core/Internal/Run.hs -+++ b/Yesod/Core/Internal/Run.hs -@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) - import Control.Monad (mplus) - import Control.Monad.IO.Class (MonadIO) - import Control.Monad.IO.Class (liftIO) --import Control.Monad.Logger (LogLevel (LevelError), LogSource, -+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource, - liftLoc) - import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) - import qualified Data.ByteString as S -@@ -31,7 +31,7 @@ import qualified Data.Text as T - import Data.Text.Encoding (encodeUtf8) - import Data.Text.Encoding (decodeUtf8With) - import Data.Text.Encoding.Error (lenientDecode) --import Language.Haskell.TH.Syntax (Loc, qLocation) -+import Language.Haskell.TH.Syntax (qLocation) - import qualified Network.HTTP.Types as H - import Network.Wai - #if MIN_VERSION_wai(2, 0, 0) -@@ -158,8 +158,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/Types.hs b/Yesod/Core/Types.hs -index 388dfe3..b3fce0f 100644 ---- a/Yesod/Core/Types.hs -+++ b/Yesod/Core/Types.hs -@@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..)) - import Control.Monad.Catch (MonadMask (..)) - #endif - import Control.Monad.IO.Class (MonadIO (liftIO)) -+import qualified Control.Monad.Logger - import Control.Monad.Logger (LogLevel, LogSource, - MonadLogger (..)) - import Control.Monad.Trans.Control (MonadBaseControl (..)) -@@ -191,7 +192,7 @@ data RunHandlerEnv site = RunHandlerEnv - , rheRoute :: !(Maybe (Route site)) - , rheSite :: !site - , rheUpload :: !(RequestBodyLength -> FileUpload) -- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -+ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ()) - , rheOnError :: !(ErrorResponse -> YesodApp) - -- ^ How to respond when an error is thrown internally. - -- -diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs -index 481199e..8489fbe 100644 ---- a/Yesod/Core/Widget.hs -+++ 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 - -@@ -207,35 +207,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)) --- -2.1.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 deleted file mode 100644 index 84314a8d93..0000000000 --- a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch +++ /dev/null @@ -1,2086 +0,0 @@ -From 1b24ece1a40c9365f719472ca6e342c8c4065c25 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:31:20 +0000 -Subject: [PATCH] hack TH - ---- - Yesod/Form/Bootstrap3.hs | 186 +++++++++-- - Yesod/Form/Fields.hs | 816 +++++++++++++++++++++++++++++++++++------------ - Yesod/Form/Functions.hs | 257 ++++++++++++--- - Yesod/Form/Jquery.hs | 134 ++++++-- - Yesod/Form/MassInput.hs | 226 ++++++++++--- - Yesod/Form/Nic.hs | 67 +++- - 6 files changed, 1322 insertions(+), 364 deletions(-) - -diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs -index 84e85fc..1954fb4 100644 ---- a/Yesod/Form/Bootstrap3.hs -+++ b/Yesod/Form/Bootstrap3.hs -@@ -26,6 +26,9 @@ import Data.String (IsString(..)) - import Yesod.Core - - import qualified Data.Text as T -+import qualified Text.Hamlet -+import qualified Text.Blaze.Internal -+import qualified Data.Foldable - - import Yesod.Form.Types - import Yesod.Form.Functions -@@ -152,44 +155,144 @@ renderBootstrap3 formLayout aform fragment = do - let views = views' [] - has (Just _) = True - has Nothing = False -- widget = [whamlet| -- $newline never -- #{fragment} -- $forall view <- views -- <div .form-group :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.has-error> -- $case formLayout -- $of BootstrapBasicForm -- $if fvId view /= bootstrapSubmitId -- <label for=#{fvId view}>#{fvLabel view} -- ^{fvInput view} -- ^{helpWidget view} -- $of BootstrapInlineForm -- $if fvId view /= bootstrapSubmitId -- <label .sr-only for=#{fvId view}>#{fvLabel view} -- ^{fvInput view} -- ^{helpWidget view} -- $of BootstrapHorizontalForm labelOffset labelSize inputOffset inputSize -- $if fvId view /= bootstrapSubmitId -- <label .control-label .#{toOffset labelOffset} .#{toColumn labelSize} for=#{fvId view}>#{fvLabel view} -- <div .#{toOffset inputOffset} .#{toColumn inputSize}> -- ^{fvInput view} -- ^{helpWidget view} -- $else -- <div .#{toOffset (addGO inputOffset (addGO labelOffset labelSize))} .#{toColumn inputSize}> -- ^{fvInput view} -- ^{helpWidget view} -- |] -+ widget = do { (asWidgetT . toWidget) (toHtml fragment); -+ Data.Foldable.mapM_ -+ (\ view_as0a -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<div class=\"form-group "); -+ Text.Hamlet.condH -+ [(fvRequired view_as0a, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_as0a), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "optional "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(has (fvErrors view_as0a), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "has-error"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ case formLayout of { -+ ; BootstrapBasicForm -+ -> do { Text.Hamlet.condH -+ [((/=) (fvId view_as0a) bootstrapSubmitId, -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_as0a)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</label>") })] -+ Nothing; -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a) } -+ ; BootstrapInlineForm -+ -> do { Text.Hamlet.condH -+ [((/=) (fvId view_as0a) bootstrapSubmitId, -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<label class=\"sr-only\" for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_as0a)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</label>") })] -+ Nothing; -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a) } -+ ; BootstrapHorizontalForm labelOffset_as0b -+ labelSize_as0c -+ inputOffset_as0d -+ inputSize_as0e -+ -> Text.Hamlet.condH -+ [((/=) (fvId view_as0a) bootstrapSubmitId, -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<label class=\"control-label "); -+ (asWidgetT . toWidget) (toHtml (toOffset labelOffset_as0b)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) " "); -+ (asWidgetT . toWidget) (toHtml (toColumn labelSize_as0c)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\" for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_as0a)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</label><div class=\""); -+ (asWidgetT . toWidget) (toHtml (toOffset inputOffset_as0d)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) " "); -+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_as0e)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</div>") })] -+ (Just -+ (do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<div class=\""); -+ (asWidgetT . toWidget) -+ (toHtml -+ (toOffset -+ (addGO -+ inputOffset_as0d -+ (addGO labelOffset_as0b labelSize_as0c)))); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) " "); -+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_as0e)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">"); -+ (asWidgetT . toWidget) (fvInput view_as0a); -+ (asWidgetT . toWidget) (helpWidget view_as0a); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "</div>") })) }; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</div>") }) -+ views } -+ - return (res, widget) - - - -- | (Internal) Render a help widget for tooltips and errors. - helpWidget :: FieldView site -> WidgetT site IO () --helpWidget view = [whamlet| -- $maybe tt <- fvTooltip view -- <span .help-block>#{tt} -- $maybe err <- fvErrors view -- <span .help-block>#{err} --|] -+helpWidget view = do { Text.Hamlet.maybeH -+ (fvTooltip view) -+ (\ tt_as0k -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml tt_as0k); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") }) -+ Nothing; -+ Text.Hamlet.maybeH -+ (fvErrors view) -+ (\ err_as0l -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml err_as0l); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") }) -+ Nothing } -+ - - - -- | How the 'bootstrapSubmit' button should be rendered. -@@ -244,7 +347,22 @@ mbootstrapSubmit - => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) - mbootstrapSubmit (BootstrapSubmit msg classes attrs) = - let res = FormSuccess () -- widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|] -+ widget = do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "<button class=\"btn "); -+ (asWidgetT . toWidget) (toHtml classes); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) -+ "\" type=\"submit\""); -+ (asWidgetT . toWidget) -+ ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) ">"); -+ ((liftM (toHtml .) getMessageRender) -+ >>= (\ urender_as0w -> (asWidgetT . toWidget) (urender_as0w msg))); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</button>") } -+ - fv = FieldView { fvLabel = "" - , fvTooltip = Nothing - , fvId = bootstrapSubmitId -diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs -index c6091a9..9e6bd4e 100644 ---- a/Yesod/Form/Fields.hs -+++ b/Yesod/Form/Fields.hs -@@ -1,4 +1,3 @@ --{-# LANGUAGE QuasiQuotes #-} - {-# LANGUAGE TypeFamilies #-} - {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE GeneralizedNewtypeDeriving #-} -@@ -18,9 +17,6 @@ module Yesod.Form.Fields - , timeField - , htmlField - , emailField -- , multiEmailField -- , searchField -- , AutoFocus - , urlField - , doubleField - , parseDate -@@ -37,15 +33,11 @@ module Yesod.Form.Fields - , selectFieldList - , radioField - , radioFieldList -- , checkboxesFieldList -- , checkboxesField - , multiSelectField - , multiSelectFieldList - , Option (..) - , OptionList (..) - , mkOptionList -- , optionsPersist -- , optionsPersistKey - , optionsPairs - , optionsEnum - ) where -@@ -72,6 +64,15 @@ import Control.Monad (when, unless) - import Data.Either (partitionEithers) - 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) -@@ -91,15 +92,12 @@ import qualified Data.Text as T (drop, dropWhile) - import qualified Data.Text.Read - - import qualified Data.Map as Map --import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery) - 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 - -@@ -111,10 +109,25 @@ 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" step=1 :isReq:required="" value="#{showVal val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJh -+ -> 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\" step=\"1\""); -+ 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where -@@ -128,10 +141,25 @@ 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="number" step=any :isReq:required="" value="#{showVal val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJu -+ -> 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\" step=\"any\""); -+ 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where showVal = either id (pack . show) -@@ -139,10 +167,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_aJJF -+ -> 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\""); -+ 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where showVal = either id (pack . show) -@@ -150,10 +192,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_aJJT -+ -> 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) "\""); -+ 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where -@@ -166,10 +221,23 @@ $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 :isReq:required="" id="#{theId}" name="#{name}" *{attrs}>#{showVal val} --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJK4 -+ -> do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea"); -+ condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " id=\""); -+ id (toHtml theId); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ id (toHtml name); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((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) -@@ -197,10 +265,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_aJKe -+ -> 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ id (toHtml (either id unTextarea val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -208,10 +284,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_aJKo -+ -> 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -219,20 +304,53 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\""); -+ condH -+ [(isReq, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ (asWidgetT . toWidget) (toHtml (either id id val)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (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_aJKH -+ -> 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\""); -+ 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -304,10 +422,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_aJLq -+ -> 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\""); -+ 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 ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -322,10 +454,25 @@ multiEmailField = Field - in case partitionEithers addrs of - ([], good) -> Right good - (bad, _) -> Left $ MsgInvalidEmail $ cat bad -- , fieldView = \theId name attrs val isReq -> toWidget [hamlet| --$newline never --<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}"> --|] -+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJMd -+ -> 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\" multiple"); -+ condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ id (toHtml (either id cat val)); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ id ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - where -@@ -341,20 +488,75 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\""); -+ condH -+ [(isReq, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))] -+ Nothing; -+ condH -+ [(autoFocus, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ (asWidgetT . toWidget) (toHtml (either id id val)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('"); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "').focus();}</script>") } -+ -+ toWidget $ \ _render_aJMx -+ -> (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 = (Prelude.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 - } - -@@ -365,7 +567,28 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\""); -+ condH -+ [(isReq, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\""); -+ (asWidgetT . toWidget) (toHtml (either id id val)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -378,18 +601,54 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) inside; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }) -+ -- outside -+ (\_theId _name isSel -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<option value=\"none\""); -+ condH -+ [(isSel, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ ((Control.Monad.liftM (toHtml .) getMessageRender) -+ >>= -+ (\ urender_aJMX -+ -> (asWidgetT . toWidget) (urender_aJMX MsgSelectNone))); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) -+ -- onOpt -+ (\_theId _name _attrs value isSel text -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); -+ (asWidgetT . toWidget) (toHtml value); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ condH -+ [(isSel, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) (toHtml text); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) -+ -- inside - - multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) - => [(msg, a)] -@@ -412,11 +671,45 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ condH -+ [(isReq, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " multiple"); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ Data.Foldable.mapM_ -+ (\ (opt_aJNs, optsel_aJNt) -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\""); -+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_aJNs)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ condH -+ [(optsel_aJNt, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_aJNs)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") }) -+ selOpts; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") } -+ - where - optselected (Left _) _ = False - optselected (Right vals) opt = (optionInternalValue opt) `elem` vals -@@ -439,54 +732,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) - 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} -- |] -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<span id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ Data.Foldable.mapM_ -+ (\ opt_aJNI -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<label><input type=\"checkbox\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_aJNI)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ condH -+ [(optselected val opt_aJNI, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_aJNI)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }) -+ opts; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") } -+ - } - - 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) inside; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ -+ (\theId name isSel -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<label class=\"radio\" for=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-none\"><div><input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-none\" type=\"radio\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\""); -+ condH -+ [(isSel, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ ((Control.Monad.liftM (toHtml .) getMessageRender) -+ >>= -+ (\ urender_aJNY -+ -> (asWidgetT . toWidget) (urender_aJNY MsgSelectNone))); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") }) -+ -+ (\theId name attrs value isSel text -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<label class=\"radio\" for=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "-"); -+ (asWidgetT . toWidget) (toHtml value); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\"><div><input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "-"); -+ (asWidgetT . toWidget) (toHtml value); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" type=\"radio\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ (asWidgetT . toWidget) (toHtml value); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ condH -+ [(isSel, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ (asWidgetT . toWidget) (toHtml text); -+ (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 { condH -+ [(not isReq, -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-none\" type=\"radio\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" value=\"none\" checked"); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "-none\">"); -+ ((Control.Monad.liftM (toHtml .) getMessageRender) -+ >>= -+ (\ urender_aJOn -+ -> (asWidgetT . toWidget) (urender_aJOn MsgSelectNone))); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-yes\" type=\"radio\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\""); -+ condH -+ [(showVal id val, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">"); -+ ((Control.Monad.liftM (toHtml .) getMessageRender) -+ >>= -+ (\ urender_aJOo -+ -> (asWidgetT . toWidget) (urender_aJOo MsgBoolYes))); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "</label><input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "-no\" type=\"radio\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\""); -+ condH -+ [(showVal not val, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "-no\">"); -+ ((Control.Monad.liftM (toHtml .) getMessageRender) -+ >>= -+ (\ urender_aJOp -+ -> (asWidgetT . toWidget) (urender_aJOp MsgBoolNo))); -+ (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 -@@ -512,10 +947,24 @@ $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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\""); -+ (asWidgetT . toWidget) (toHtml theId); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\" type=\"checkbox\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\""); -+ condH -+ [(showVal id val, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))] -+ Nothing; -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = UrlEncoded - } - -@@ -559,69 +1008,6 @@ 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] - --#if MIN_VERSION_persistent(2, 0, 0) --optionsPersist :: ( YesodPersist site, PersistEntity a -- , PersistQuery (PersistEntityBackend a) -- , PathPiece (Key a) -- , RenderMessage site msg -- , YesodPersistBackend site ~ PersistEntityBackend a -- ) --#else --optionsPersist :: ( YesodPersist site, PersistEntity a -- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) -- , PathPiece (Key a) -- , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO)) -- , RenderMessage site msg -- ) --#endif -- => [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 --#if MIN_VERSION_persistent(2, 0, 0) --optionsPersistKey -- :: (YesodPersist site -- , PersistEntity a -- , PersistQuery (PersistEntityBackend a) -- , PathPiece (Key a) -- , RenderMessage site msg -- , YesodPersistBackend site ~ PersistEntityBackend a -- ) --#else --optionsPersistKey -- :: (YesodPersist site -- , PersistEntity a -- , PersistQuery (YesodPersistBackend site (HandlerT site IO)) -- , PathPiece (Key a) -- , RenderMessage site msg -- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)) --#endif -- => [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) -@@ -665,9 +1051,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_aJPt -+ -> 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\""); -+ condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ id ((attrsToHtml . toAttributes) attrs); -+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fieldEnctype = Multipart - } - -@@ -694,10 +1092,19 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"file\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\""); -+ (asWidgetT . toWidget) (toHtml id'); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) (fsAttrs fs)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fvErrors = errs - , fvRequired = True - } -@@ -726,10 +1133,19 @@ 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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"file\" name=\""); -+ (asWidgetT . toWidget) (toHtml name); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\""); -+ (asWidgetT . toWidget) (toHtml id'); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\""); -+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) (fsAttrs fs)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">") } -+ - , fvErrors = errs - , fvRequired = False - } -diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs -index 9e6abaf..0c2a0ce 100644 ---- a/Yesod/Form/Functions.hs -+++ b/Yesod/Form/Functions.hs -@@ -60,12 +60,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 -@@ -217,7 +221,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 -@@ -297,7 +308,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 -@@ -332,10 +348,15 @@ identifyForm - identifyForm identVal form = \fragment -> do - -- Create hidden <input>. - let fragment' = -- [shamlet| -- <input type=hidden name=#{identifyFormKey} value=#{identVal}> -- #{fragment} -- |] -+ do { id -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<input type=\"hidden\" name=\""); -+ id (toHtml identifyFormKey); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\""); -+ id (toHtml identVal); -+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ id (toHtml fragment) } -+ - - -- Check if we got its value back. - mp <- askParams -@@ -365,22 +386,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a - renderTable aform fragment = do - (res, views') <- aFormToForm aform - let views = views' [] -- let widget = [whamlet| --$newline never --$if null views -- \#{fragment} --$forall (isFirst, view) <- addIsFirst views -- <tr :fvRequired view:.required :not $ fvRequired view:.optional> -- <td> -- $if isFirst -- \#{fragment} -- <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 { Text.Hamlet.condH -+ [(null views, (asWidgetT . toWidget) (toHtml fragment))] Nothing; -+ Data.Foldable.mapM_ -+ (\ (isFirst_ab5u, view_ab5v) -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<tr"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_ab5v, not (fvRequired view_ab5v)], -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_ab5v, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_ab5v), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "><td>"); -+ Text.Hamlet.condH -+ [(isFirst_ab5u, (asWidgetT . toWidget) (toHtml fragment))] Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_ab5v)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5v)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>"); -+ Text.Hamlet.maybeH -+ (fvTooltip view_ab5v) -+ (\ tt_ab5w -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_ab5w); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>"); -+ (asWidgetT . toWidget) (fvInput view_ab5v); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>"); -+ Text.Hamlet.maybeH -+ (fvErrors view_ab5v) -+ (\ err_ab5x -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<td class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_ab5x); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") }) -+ (addIsFirst views) } -+ - return (res, widget) - where - addIsFirst [] = [] -@@ -396,19 +465,66 @@ 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 { (asWidgetT . toWidget) (toHtml fragment); -+ Data.Foldable.mapM_ -+ (\ view_ab5K -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<div"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_ab5K, not (fvRequired view_ab5K)], -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_ab5K, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_ab5K), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) ">"); -+ Text.Hamlet.condH -+ [(withLabels, -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_ab5K)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5K)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })] -+ Nothing; -+ Text.Hamlet.maybeH -+ (fvTooltip view_ab5K) -+ (\ tt_ab5L -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_ab5L); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ Nothing; -+ (asWidgetT . toWidget) (fvInput view_ab5K); -+ Text.Hamlet.maybeH -+ (fvErrors view_ab5K) -+ (\ err_ab5M -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_ab5M); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) -+ views } -+ - return (res, widget) - - -- | Render a form using Bootstrap v2-friendly shamlet syntax. -@@ -436,19 +552,62 @@ renderBootstrap2 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 { (asWidgetT . toWidget) (toHtml fragment); -+ Data.Foldable.mapM_ -+ (\ view_ab5Y -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<div class=\"control-group clearfix "); -+ Text.Hamlet.condH -+ [(fvRequired view_ab5Y, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_ab5Y), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "optional "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(has (fvErrors view_ab5Y), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "error"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "\"><label class=\"control-label\" for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_ab5Y)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5Y)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "</label><div class=\"controls input\">"); -+ (asWidgetT . toWidget) (fvInput view_ab5Y); -+ Text.Hamlet.maybeH -+ (fvTooltip view_ab5Y) -+ (\ tt_ab5Z -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml tt_ab5Z); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) -+ Nothing; -+ Text.Hamlet.maybeH -+ (fvErrors view_ab5Y) -+ (\ err_ab60 -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) -+ "<span class=\"help-block\">"); -+ (asWidgetT . toWidget) (toHtml err_ab60); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") }) -+ views } -+ - return (res, widget) - - -- | Deprecated synonym for 'renderBootstrap2'. -diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs -index 362eb8a..1df9966 100644 ---- a/Yesod/Form/Jquery.hs -+++ b/Yesod/Form/Jquery.hs -@@ -17,11 +17,23 @@ 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) - -+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 -+ - -- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme. - googleHostedJqueryUiCss :: Text -> Text - googleHostedJqueryUiCss theme = mconcat -@@ -61,27 +73,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_a2l4S -+ -> 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 -@@ -108,16 +152,52 @@ jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site) - jqueryAutocompleteField' minLen 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:#{toJSON minLen}})}); --|] -+ toWidget $ Text.Julius.asJavascriptUrl -+ (\ _render_a2l58 -+ -> 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_a2l58 src [])), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\",minLength:"), -+ Text.Julius.toJavascript (toJSON minLen), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "})});")]) -+ - , fieldEnctype = UrlEncoded - } - -diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs -index a2b434d..75eb484 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 (checkBoxField) -@@ -70,16 +80,27 @@ inputList label fixXml single mdef = formToAForm $ do - { fvLabel = label - , fvTooltip = Nothing - , fvId = theId -- , fvInput = [whamlet| --$newline never --^{fixXml views} --<p> -- $forall xml <- xmls -- ^{xml} -- <input .count type=hidden name=#{countName} value=#{count}> -- <input type=checkbox name=#{addName}> -- Add another row --|] -+ , fvInput = do { (asWidgetT . toWidget) (fixXml views); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>"); -+ Data.Foldable.mapM_ -+ (\ xml_a1yM1 -> (asWidgetT . toWidget) xml_a1yM1) xmls; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<input class=\"count\" type=\"hidden\" name=\""); -+ (asWidgetT . toWidget) (toHtml countName); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\" value=\""); -+ (asWidgetT . toWidget) (toHtml count); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\"><input type=\"checkbox\" name=\""); -+ (asWidgetT . toWidget) (toHtml addName); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\">Add another row</p>") } -+ - , fvErrors = Nothing - , fvRequired = False - }]) -@@ -92,10 +113,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 { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<input type=\"hidden\" name=\""); -+ (asWidgetT . toWidget) (toHtml deleteName); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\" value=\"yes\">") } -+ - _ -> do - (_, xml2) <- aFormToForm $ areq checkBoxField FieldSettings - { fsLabel = SomeMessage MsgDelete -@@ -121,32 +146,149 @@ 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_a1yMm -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<fieldset>"); -+ Data.Foldable.mapM_ -+ (\ view_a1yMn -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_a1yMn, not (fvRequired view_a1yMn)], -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_a1yMn, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_a1yMn), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "optional"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\"") })] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "><label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_a1yMn)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_a1yMn)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); -+ Text.Hamlet.maybeH -+ (fvTooltip view_a1yMn) -+ (\ tt_a1yMo -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_a1yMo); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</div>") }) -+ Nothing; -+ (asWidgetT . toWidget) (fvInput view_a1yMn); -+ Text.Hamlet.maybeH -+ (fvErrors view_a1yMn) -+ (\ err_a1yMp -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<div class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_a1yMp); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</div>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") }) -+ views_a1yMm; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</fieldset>") }) -+ viewss -+ -+ -+massTable viewss = Data.Foldable.mapM_ -+ (\ views_a1yMv -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<fieldset><table>"); -+ Data.Foldable.mapM_ -+ (\ view_a1yMw -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr"); -+ Text.Hamlet.condH -+ [(or [fvRequired view_a1yMw, not (fvRequired view_a1yMw)], -+ do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ " class=\""); -+ Text.Hamlet.condH -+ [(fvRequired view_a1yMw, -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "required "))] -+ Nothing; -+ Text.Hamlet.condH -+ [(not (fvRequired view_a1yMw), -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "optional"))] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "\"") })] -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "><td><label for=\""); -+ (asWidgetT . toWidget) (toHtml (fvId view_a1yMw)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">"); -+ (asWidgetT . toWidget) (toHtml (fvLabel view_a1yMw)); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>"); -+ Text.Hamlet.maybeH -+ (fvTooltip view_a1yMw) -+ (\ tt_a1yMx -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<div class=\"tooltip\">"); -+ (asWidgetT . toWidget) (toHtml tt_a1yMx); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</div>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</td><td>"); -+ (asWidgetT . toWidget) (fvInput view_a1yMw); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>"); -+ Text.Hamlet.maybeH -+ (fvErrors view_a1yMw) -+ (\ err_a1yMy -+ -> do { (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "<td class=\"errors\">"); -+ (asWidgetT . toWidget) (toHtml err_a1yMy); -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) -+ "</td>") }) -+ Nothing; -+ (asWidgetT . toWidget) -+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") }) -+ views_a1yMv; -+ (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 7e4af07..b59745a 100644 ---- a/Yesod/Form/Nic.hs -+++ b/Yesod/Form/Nic.hs -@@ -9,11 +9,22 @@ 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.Julius ( rawJS) - import Text.Blaze.Html.Renderer.String (renderHtml) - import Data.Text (Text, pack) - import Data.Maybe (listToMaybe) -@@ -27,20 +38,52 @@ 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}" :isReq:required .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) "\""); -+ Text.Hamlet.condH -+ [(isReq, -+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))] -+ Nothing; -+ 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_a2rMh -+ -> Data.Monoid.mconcat -+ [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""), -+ Text.Julius.toJavascript (rawJS theId), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\")});")]) -+ -+ _ -> Text.Julius.asJavascriptUrl -+ (\ _render_a2rMm -+ -> Data.Monoid.mconcat -+ [Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""), -+ Text.Julius.toJavascript (rawJS theId), -+ Text.Julius.Javascript -+ ((Data.Text.Lazy.Builder.fromText -+ . Text.Shakespeare.pack') -+ "\")})();")]) -+ - , fieldEnctype = UrlEncoded - } - where --- -2.1.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 deleted file mode 100644 index 76aad4e340..0000000000 --- a/standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch +++ /dev/null @@ -1,33 +0,0 @@ -From e82ed4e6fd7b5ea6dbe474b5de2755ec5794161c Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:23:50 +0000 -Subject: [PATCH] stub out - ---- - yesod-persistent.cabal | 10 ---------- - 1 file changed, 10 deletions(-) - -diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal -index b116f3a..017b184 100644 ---- a/yesod-persistent.cabal -+++ b/yesod-persistent.cabal -@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod. - - library - build-depends: base >= 4 && < 5 -- , yesod-core >= 1.2.2 && < 1.3 -- , persistent >= 1.2 && < 2.1 -- , persistent-template >= 1.2 && < 2.1 -- , transformers >= 0.2.2 -- , blaze-builder -- , conduit -- , resourcet >= 0.4.5 -- , resource-pool -- exposed-modules: Yesod.Persist -- Yesod.Persist.Core - ghc-options: -Wall - - test-suite test --- -2.1.1 - diff --git a/standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch b/standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch deleted file mode 100644 index 99d6c9025a..0000000000 --- a/standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch +++ /dev/null @@ -1,170 +0,0 @@ -From 8ba08c0efc035486a65f2fd33916a5da7e5210e7 Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 26 Dec 2013 19:32:55 -0400 -Subject: [PATCH] remove TH - ---- - Yesod/Routes/Parse.hs | 40 +++++----------------------------------- - Yesod/Routes/TH.hs | 16 ++++++++-------- - Yesod/Routes/TH/Types.hs | 16 ---------------- - yesod-routes.cabal | 4 ---- - 4 files changed, 13 insertions(+), 63 deletions(-) - -diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs -index 232982d..7df7750 100644 ---- a/Yesod/Routes/Parse.hs -+++ b/Yesod/Routes/Parse.hs -@@ -2,11 +2,11 @@ - {-# LANGUAGE DeriveDataTypeable #-} - {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter - module Yesod.Routes.Parse -- ( parseRoutes -- , parseRoutesFile -- , parseRoutesNoCheck -- , parseRoutesFileNoCheck -- , parseType -+ --( parseRoutes -+ --, parseRoutesFile -+ --, parseRoutesNoCheck -+ --, parseRoutesFileNoCheck -+ ( parseType - , parseTypeTree - , TypeTree (..) - ) where -@@ -19,42 +19,12 @@ import Yesod.Routes.TH - import Yesod.Routes.Overlap (findOverlapNames) - import Data.List (foldl') - ---- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for ---- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the ---- checking. See documentation site for details on syntax. --parseRoutes :: QuasiQuoter --parseRoutes = QuasiQuoter { quoteExp = x } -- where -- x s = do -- let res = resourcesFromString s -- case findOverlapNames res of -- [] -> lift res -- z -> error $ unlines $ "Overlapping routes: " : map show z -- --parseRoutesFile :: FilePath -> Q Exp --parseRoutesFile = parseRoutesFileWith parseRoutes -- --parseRoutesFileNoCheck :: FilePath -> Q Exp --parseRoutesFileNoCheck = parseRoutesFileWith parseRoutesNoCheck -- --parseRoutesFileWith :: QuasiQuoter -> FilePath -> Q Exp --parseRoutesFileWith qq fp = do -- qAddDependentFile fp -- s <- qRunIO $ readUtf8File fp -- quoteExp qq s -- - readUtf8File :: FilePath -> IO String - readUtf8File fp = do - h <- SIO.openFile fp SIO.ReadMode - SIO.hSetEncoding h SIO.utf8_bom - SIO.hGetContents h - ---- | Same as 'parseRoutes', but performs no overlap checking. --parseRoutesNoCheck :: QuasiQuoter --parseRoutesNoCheck = QuasiQuoter -- { quoteExp = lift . resourcesFromString -- } -- - -- | Convert a multi-line string to a set of resources. See documentation for - -- the format of this string. This is a partial function which calls 'error' on - -- invalid input. -diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs -index 7b2e50b..b05fc57 100644 ---- a/Yesod/Routes/TH.hs -+++ b/Yesod/Routes/TH.hs -@@ -2,15 +2,15 @@ - module Yesod.Routes.TH - ( module Yesod.Routes.TH.Types - -- * Functions -- , module Yesod.Routes.TH.RenderRoute -- , module Yesod.Routes.TH.ParseRoute -- , module Yesod.Routes.TH.RouteAttrs -+ -- , module Yesod.Routes.TH.RenderRoute -+ -- , module Yesod.Routes.TH.ParseRoute -+ -- , module Yesod.Routes.TH.RouteAttrs - -- ** Dispatch -- , module Yesod.Routes.TH.Dispatch -+ -- , module Yesod.Routes.TH.Dispatch - ) where - - import Yesod.Routes.TH.Types --import Yesod.Routes.TH.RenderRoute --import Yesod.Routes.TH.ParseRoute --import Yesod.Routes.TH.RouteAttrs --import Yesod.Routes.TH.Dispatch -+--import Yesod.Routes.TH.RenderRoute -+--import Yesod.Routes.TH.ParseRoute -+--import Yesod.Routes.TH.RouteAttrs -+--import Yesod.Routes.TH.Dispatch -diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs -index d0a0405..3232e99 100644 ---- a/Yesod/Routes/TH/Types.hs -+++ b/Yesod/Routes/TH/Types.hs -@@ -31,10 +31,6 @@ instance Functor ResourceTree where - fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r) - fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c - --instance Lift t => Lift (ResourceTree t) where -- lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|] -- lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|] -- - data Resource typ = Resource - { resourceName :: String - , resourcePieces :: [(CheckOverlap, Piece typ)] -@@ -48,9 +44,6 @@ type CheckOverlap = Bool - instance Functor Resource where - fmap f (Resource a b c d) = Resource a (map (second $ fmap f) b) (fmap f c) d - --instance Lift t => Lift (Resource t) where -- lift (Resource a b c d) = [|Resource a b c d|] -- - data Piece typ = Static String | Dynamic typ - deriving Show - -@@ -58,10 +51,6 @@ instance Functor Piece where - fmap _ (Static s) = (Static s) - fmap f (Dynamic t) = Dynamic (f t) - --instance Lift t => Lift (Piece t) where -- lift (Static s) = [|Static $(lift s)|] -- lift (Dynamic t) = [|Dynamic $(lift t)|] -- - data Dispatch typ = - Methods - { methodsMulti :: Maybe typ -- ^ type of the multi piece at the end -@@ -77,11 +66,6 @@ instance Functor Dispatch where - fmap f (Methods a b) = Methods (fmap f a) b - fmap f (Subsite a b) = Subsite (f a) b - --instance Lift t => Lift (Dispatch t) where -- lift (Methods Nothing b) = [|Methods Nothing $(lift b)|] -- lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|] -- lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|] -- - resourceMulti :: Resource typ -> Maybe typ - resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t - resourceMulti _ = Nothing -diff --git a/yesod-routes.cabal b/yesod-routes.cabal -index 61980d1..33d2380 100644 ---- a/yesod-routes.cabal -+++ b/yesod-routes.cabal -@@ -27,10 +27,6 @@ library - Yesod.Routes.Class - Yesod.Routes.Parse - Yesod.Routes.Overlap -- other-modules: Yesod.Routes.TH.Dispatch -- Yesod.Routes.TH.RenderRoute -- Yesod.Routes.TH.ParseRoute -- Yesod.Routes.TH.RouteAttrs - Yesod.Routes.TH.Types - ghc-options: -Wall - --- -1.7.10.4 - diff --git a/standalone/no-th/haskell-patches/yesod-static_hack.patch b/standalone/no-th/haskell-patches/yesod-static_hack.patch deleted file mode 100644 index 46e4b654c5..0000000000 --- a/standalone/no-th/haskell-patches/yesod-static_hack.patch +++ /dev/null @@ -1,193 +0,0 @@ -From 606c5f4f4b2d476d274907eb2bb8c12b60fc451f Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Wed, 21 May 2014 04:43:30 +0000 -Subject: [PATCH] remove TH - ---- - Yesod/EmbeddedStatic/Generators.hs | 3 +-- - Yesod/Static.hs | 29 ++++++++++++++++++----------- - yesod-static.cabal | 9 --------- - 3 files changed, 19 insertions(+), 22 deletions(-) - -diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs -index 08febb9..e3a6d51 100644 ---- a/Yesod/EmbeddedStatic/Generators.hs -+++ b/Yesod/EmbeddedStatic/Generators.hs -@@ -42,7 +42,6 @@ import Language.Haskell.TH - import Network.Mime (defaultMimeLookup) - import System.Directory (doesDirectoryExist, getDirectoryContents, findExecutable) - import System.FilePath ((</>)) --import Text.Jasmine (minifym) - import qualified Data.ByteString.Lazy as BL - import qualified Data.Conduit.List as C - import Data.Conduit.Binary (sourceHandle) -@@ -162,7 +161,7 @@ concatFilesWith loc process files = do - - -- | 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 -+jasmine ct = return ct - - -- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript. - -- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@ -diff --git a/Yesod/Static.hs b/Yesod/Static.hs -index 725ebf4..33eaffd 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,7 @@ import Prelude hiding (FilePath) - import qualified Prelude - import System.Directory - import Control.Monad --import Data.FileEmbed (embedDir) -+import Data.FileEmbed - - import Control.Monad.Trans.Resource (runResourceT) - import Yesod.Core -@@ -136,6 +136,7 @@ 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. - -- -@@ -150,6 +151,7 @@ staticDevel dir = do - -- 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'). -@@ -215,6 +217,7 @@ 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. - -- -@@ -267,7 +270,7 @@ staticFilesList dir fs = - -- 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 -@@ -310,6 +313,7 @@ cachedETagLookup dir = do - etags <- mkHashMap dir - return $ (\f -> return $ M.lookup f etags) - -+{- - mkStaticFiles :: Prelude.FilePath -> Q [Dec] - mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True - -@@ -357,6 +361,7 @@ mkStaticFilesList fp fs routeConName makeHash = do - [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) [] - ] - ] -+-} - - base64md5File :: Prelude.FilePath -> IO String - base64md5File = fmap (base64 . encode) . hashFile -@@ -395,7 +400,7 @@ base64 = map tr - -- single static file at compile time. - - data CombineType = JS | CSS -- -+{- - combineStatics' :: CombineType - -> CombineSettings - -> [Route Static] -- ^ files to combine -@@ -429,7 +434,7 @@ combineStatics' combineType CombineSettings {..} routes = do - case combineType of - JS -> "js" - CSS -> "css" -- -+-} - -- | Data type for holding all settings for combining files. - -- - -- This data type is a settings type. For more information, see: -@@ -505,6 +510,7 @@ 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 -@@ -551,4 +557,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining - -> Q Exp - combineScripts' development cs con routes - | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |] -- | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |] -+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a -+-} -diff --git a/yesod-static.cabal b/yesod-static.cabal -index 2582a95..5df03b3 100644 ---- a/yesod-static.cabal -+++ b/yesod-static.cabal -@@ -49,7 +49,6 @@ library - , data-default - , shakespeare-css >= 1.0.3 - , mime-types >= 0.1 -- , hjsmin - , filepath >= 1.3 - , resourcet >= 0.4 - , unordered-containers >= 0.2 -@@ -62,13 +61,6 @@ library - , hashable >= 1.1 - - exposed-modules: Yesod.Static -- Yesod.EmbeddedStatic -- Yesod.EmbeddedStatic.Generators -- Yesod.EmbeddedStatic.Types -- Yesod.EmbeddedStatic.Css.AbsoluteUrl -- -- other-modules: Yesod.EmbeddedStatic.Internal -- Yesod.EmbeddedStatic.Css.Util - - ghc-options: -Wall - extensions: TemplateHaskell -@@ -108,7 +100,6 @@ test-suite tests - , data-default - , shakespeare-css - , mime-types -- , hjsmin - , filepath - , resourcet - , unordered-containers --- -2.0.0.rc2 - diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch deleted file mode 100644 index ebf8a786b1..0000000000 --- a/standalone/no-th/haskell-patches/yesod_hack-TH.patch +++ /dev/null @@ -1,199 +0,0 @@ -From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001 -From: dummy <dummy@example.com> -Date: Thu, 16 Oct 2014 02:36:37 +0000 -Subject: [PATCH] hack TH - ---- - Yesod.hs | 19 ++++++++++++-- - Yesod/Default/Main.hs | 31 +---------------------- - Yesod/Default/Util.hs | 69 ++------------------------------------------------- - 3 files changed, 20 insertions(+), 99 deletions(-) - -diff --git a/Yesod.hs b/Yesod.hs -index b367144..fbe309c 100644 ---- 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/Main.hs b/Yesod/Default/Main.hs -index 565ed35..bf46642 100644 ---- a/Yesod/Default/Main.hs -+++ b/Yesod/Default/Main.hs -@@ -1,10 +1,8 @@ - {-# LANGUAGE CPP #-} - {-# LANGUAGE DeriveDataTypeable #-} - {-# LANGUAGE OverloadedStrings #-} --{-# LANGUAGE TemplateHaskell #-} - module Yesod.Default.Main - ( defaultMain -- , defaultMainLog - , defaultRunner - , defaultDevelApp - , LogFunc -@@ -23,7 +21,7 @@ import Control.Monad (when) - import System.Environment (getEnvironment) - import Data.Maybe (fromMaybe) - import Safe (readMay) --import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) -+import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError)) - import System.Log.FastLogger (LogStr, toLogStr) - import Language.Haskell.TH.Syntax (qLocation) - -@@ -55,33 +53,6 @@ defaultMain load getApp = do - - type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () - ---- | Same as @defaultMain@, but gets a logging function back as well as an ---- @Application@ to install Warp exception handlers. ---- ---- Since 1.2.5 --defaultMainLog :: (Show env, Read env) -- => IO (AppConfig env extra) -- -> (AppConfig env extra -> IO (Application, LogFunc)) -- -> IO () --defaultMainLog load getApp = do -- config <- load -- (app, logFunc) <- getApp config -- runSettings defaultSettings -- { settingsPort = appPort config -- , settingsHost = appHost config -- , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc -- $(qLocation >>= liftLoc) -- "yesod" -- LevelError -- (toLogStr $ "Exception from Warp: " ++ show e) -- } app -- where -- shouldLog' = --#if MIN_VERSION_warp(2,1,3) -- Warp.defaultShouldDisplayException --#else -- const True --#endif - - -- | Run your application continously, listening for SIGINT and exiting - -- when received -diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs -index 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 --- -2.1.1 - |