aboutsummaryrefslogtreecommitdiff
path: root/standalone/no-th
diff options
context:
space:
mode:
authorGravatar androidbuilder <androidbuilder@example.com>2015-08-02 19:48:36 +0000
committerGravatar androidbuilder <androidbuilder@example.com>2015-08-02 19:48:36 +0000
commitd03dd472b7f987695489f01d52cedb8b16e5b6c1 (patch)
treec5f5d0bd8a6a68476fc4cc6616170e8545d51791 /standalone/no-th
parentf37922856e7ac2ad535f8da11dc291f485e22b98 (diff)
reverted updates to new lib versions that broke android build
I ran into several evilsplicer problems with the new lib versions, most notably including a problem with encoding of embedded binary files
Diffstat (limited to 'standalone/no-th')
-rw-r--r--standalone/no-th/haskell-patches/DAV_build-without-TH.patch12
-rw-r--r--standalone/no-th/haskell-patches/aeson_remove-TH.patch40
-rw-r--r--standalone/no-th/haskell-patches/file-embed_remove-TH.patch132
-rw-r--r--standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch394
-rw-r--r--standalone/no-th/haskell-patches/lens_no-TH.patch92
-rw-r--r--standalone/no-th/haskell-patches/monad-logger_remove-TH.patch27
-rw-r--r--standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch33
-rw-r--r--standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch41
-rw-r--r--standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch26
-rw-r--r--standalone/no-th/haskell-patches/reflection_remove-TH.patch59
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch366
-rw-r--r--standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch316
-rw-r--r--standalone/no-th/haskell-patches/shakespeare_remove-TH.patch1283
-rw-r--r--standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch26
-rw-r--r--standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch49
-rw-r--r--standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch24
-rw-r--r--standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch108
-rw-r--r--standalone/no-th/haskell-patches/yesod-core_expand_TH.patch93
-rw-r--r--standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch676
-rw-r--r--standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch16
-rw-r--r--standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch170
-rw-r--r--standalone/no-th/haskell-patches/yesod-static_hack.patch34
-rw-r--r--standalone/no-th/haskell-patches/yesod_hack-TH.patch47
23 files changed, 2320 insertions, 1744 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
index 8009d92f9..6d17d634e 100644
--- a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch
+++ b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch
@@ -1,6 +1,6 @@
-From 6d4a7c63d737c9215ee55996715250c89f14c398 Mon Sep 17 00:00:00 2001
+From e54cfacbb9fb24f75d3d93cd8ee6da67b161574f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 01:36:31 +0000
+Date: Thu, 16 Oct 2014 02:51:28 +0000
Subject: [PATCH] remove TH
---
@@ -10,7 +10,7 @@ Subject: [PATCH] remove TH
3 files changed, 306 insertions(+), 46 deletions(-)
diff --git a/DAV.cabal b/DAV.cabal
-index f78c2e5..1ec4d80 100644
+index 95fffd8..5669c51 100644
--- a/DAV.cabal
+++ b/DAV.cabal
@@ -47,33 +47,7 @@ library
@@ -27,7 +27,7 @@ index f78c2e5..1ec4d80 100644
- , containers
- , data-default
- , either >= 4.3
-- , errors < 2.0
+- , errors
- , exceptions
- , http-client >= 0.2
- , http-client-tls >= 0.2
@@ -49,7 +49,7 @@ index f78c2e5..1ec4d80 100644
source-repository head
type: git
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
-index 5d5d6fd..7265d42 100644
+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
@@ -416,5 +416,5 @@ index 0ecd476..1653bf6 100644
+ Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg))
+{-# INLINE userAgent #-}
--
-2.1.4
+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
new file mode 100644
index 000000000..dc40de79e
--- /dev/null
+++ b/standalone/no-th/haskell-patches/aeson_remove-TH.patch
@@ -0,0 +1,40 @@
+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
new file mode 100644
index 000000000..12e344504
--- /dev/null
+++ b/standalone/no-th/haskell-patches/file-embed_remove-TH.patch
@@ -0,0 +1,132 @@
+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
new file mode 100644
index 000000000..83c8ffd2a
--- /dev/null
+++ b/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch
@@ -0,0 +1,394 @@
+From 9a41401d903f160e11d56fff35c24eb59d97885d Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Tue, 17 Dec 2013 19:04:40 +0000
+Subject: [PATCH] remove TH
+
+---
+ src/Generics/Deriving/TH.hs | 354 --------------------------------------------
+ 1 file changed, 354 deletions(-)
+
+diff --git a/src/Generics/Deriving/TH.hs b/src/Generics/Deriving/TH.hs
+index 783cb65..9aab713 100644
+--- a/src/Generics/Deriving/TH.hs
++++ b/src/Generics/Deriving/TH.hs
+@@ -19,18 +19,6 @@
+
+ -- Adapted from Generics.Regular.TH
+ module Generics.Deriving.TH (
+-
+- deriveMeta
+- , deriveData
+- , deriveConstructors
+- , deriveSelectors
+-
+-#if __GLASGOW_HASKELL__ < 701
+- , deriveAll
+- , deriveRepresentable0
+- , deriveRep0
+- , simplInstance
+-#endif
+ ) where
+
+ import Generics.Deriving.Base
+@@ -41,124 +29,6 @@ import Language.Haskell.TH.Syntax (Lift(..))
+ import Data.List (intercalate)
+ import Control.Monad
+
+--- | Given the names of a generic class, a type to instantiate, a function in
+--- the class and the default implementation, generates the code for a basic
+--- generic instance.
+-simplInstance :: Name -> Name -> Name -> Name -> Q [Dec]
+-simplInstance cl ty fn df = do
+- i <- reify (genRepName 0 ty)
+- x <- newName "x"
+- let typ = ForallT [PlainTV x] []
+- ((foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT (genRepName 0 ty))
+- (typeVariables i)) `AppT` (VarT x))
+- fmap (: []) $ instanceD (cxt []) (conT cl `appT` conT ty)
+- [funD fn [clause [] (normalB (varE df `appE`
+- (sigE (global 'undefined) (return typ)))) []]]
+-
+-
+--- | Given the type and the name (as string) for the type to derive,
+--- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
+--- instances, and the 'Representable0' instance.
+-deriveAll :: Name -> Q [Dec]
+-deriveAll n =
+- do a <- deriveMeta n
+- b <- deriveRepresentable0 n
+- return (a ++ b)
+-
+--- | Given the type and the name (as string) for the type to derive,
+--- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'
+--- instances.
+-deriveMeta :: Name -> Q [Dec]
+-deriveMeta n =
+- do a <- deriveData n
+- b <- deriveConstructors n
+- c <- deriveSelectors n
+- return (a ++ b ++ c)
+-
+--- | Given a datatype name, derive a datatype and instance of class 'Datatype'.
+-deriveData :: Name -> Q [Dec]
+-deriveData = dataInstance
+-
+--- | Given a datatype name, derive datatypes and
+--- instances of class 'Constructor'.
+-deriveConstructors :: Name -> Q [Dec]
+-deriveConstructors = constrInstance
+-
+--- | Given a datatype name, derive datatypes and instances of class 'Selector'.
+-deriveSelectors :: Name -> Q [Dec]
+-deriveSelectors = selectInstance
+-
+--- | Given the type and the name (as string) for the Representable0 type
+--- synonym to derive, generate the 'Representable0' instance.
+-deriveRepresentable0 :: Name -> Q [Dec]
+-deriveRepresentable0 n = do
+- rep0 <- deriveRep0 n
+- inst <- deriveInst n
+- return $ rep0 ++ inst
+-
+--- | Derive only the 'Rep0' type synonym. Not needed if 'deriveRepresentable0'
+--- is used.
+-deriveRep0 :: Name -> Q [Dec]
+-deriveRep0 n = do
+- i <- reify n
+- fmap (:[]) $ tySynD (genRepName 0 n) (typeVariables i) (rep0Type n)
+-
+-deriveInst :: Name -> Q [Dec]
+-deriveInst t = do
+- i <- reify t
+- let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q)
+- (typeVariables i)
+-#if __GLASGOW_HASKELL__ >= 707
+- let tyIns = TySynInstD ''Rep (TySynEqn [typ t] (typ (genRepName 0 t)))
+-#else
+- let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))
+-#endif
+- fcs <- mkFrom t 1 0 t
+- tcs <- mkTo t 1 0 t
+- liftM (:[]) $
+- instanceD (cxt []) (conT ''Generic `appT` return (typ t))
+- [return tyIns, funD 'from fcs, funD 'to tcs]
+-
+-
+-dataInstance :: Name -> Q [Dec]
+-dataInstance n = do
+- i <- reify n
+- case i of
+- TyConI (DataD _ n _ _ _) -> mkInstance n
+- TyConI (NewtypeD _ n _ _ _) -> mkInstance n
+- _ -> return []
+- where
+- mkInstance n = do
+- ds <- mkDataData n
+- is <- mkDataInstance n
+- return $ [ds,is]
+-
+-constrInstance :: Name -> Q [Dec]
+-constrInstance n = do
+- i <- reify n
+- case i of
+- TyConI (DataD _ n _ cs _) -> mkInstance n cs
+- TyConI (NewtypeD _ n _ c _) -> mkInstance n [c]
+- _ -> return []
+- where
+- mkInstance n cs = do
+- ds <- mapM (mkConstrData n) cs
+- is <- mapM (mkConstrInstance n) cs
+- return $ ds ++ is
+-
+-selectInstance :: Name -> Q [Dec]
+-selectInstance n = do
+- i <- reify n
+- case i of
+- TyConI (DataD _ n _ cs _) -> mkInstance n cs
+- TyConI (NewtypeD _ n _ c _) -> mkInstance n [c]
+- _ -> return []
+- where
+- mkInstance n cs = do
+- ds <- mapM (mkSelectData n) cs
+- is <- mapM (mkSelectInstance n) cs
+- return $ concat (ds ++ is)
+-
+ typeVariables :: Info -> [TyVarBndr]
+ typeVariables (TyConI (DataD _ _ tv _ _)) = tv
+ typeVariables (TyConI (NewtypeD _ _ tv _ _)) = tv
+@@ -179,233 +49,9 @@ genName = mkName . (++"_") . intercalate "_" . map nameBase
+ genRepName :: Int -> Name -> Name
+ genRepName n = mkName . (++"_") . (("Rep" ++ show n) ++) . nameBase
+
+-mkDataData :: Name -> Q Dec
+-mkDataData n = dataD (cxt []) (genName [n]) [] [] []
+-
+-mkConstrData :: Name -> Con -> Q Dec
+-mkConstrData dt (NormalC n _) =
+- dataD (cxt []) (genName [dt, n]) [] [] []
+-mkConstrData dt r@(RecC _ _) =
+- mkConstrData dt (stripRecordNames r)
+-mkConstrData dt (InfixC t1 n t2) =
+- mkConstrData dt (NormalC n [t1,t2])
+-
+-mkSelectData :: Name -> Con -> Q [Dec]
+-mkSelectData dt r@(RecC n fs) = return (map one fs)
+- where one (f, _, _) = DataD [] (genName [dt, n, f]) [] [] []
+-mkSelectData dt _ = return []
+-
+-
+-mkDataInstance :: Name -> Q Dec
+-mkDataInstance n =
+- instanceD (cxt []) (appT (conT ''Datatype) (conT $ genName [n]))
+- [funD 'datatypeName [clause [wildP] (normalB (stringE (nameBase n))) []]
+- ,funD 'moduleName [clause [wildP] (normalB (stringE name)) []]]
+- where
+- name = maybe (error "Cannot fetch module name!") id (nameModule n)
+-
+-instance Lift Fixity where
+- lift Prefix = conE 'Prefix
+- lift (Infix a n) = conE 'Infix `appE` [| a |] `appE` [| n |]
+-
+-instance Lift Associativity where
+- lift LeftAssociative = conE 'LeftAssociative
+- lift RightAssociative = conE 'RightAssociative
+- lift NotAssociative = conE 'NotAssociative
+-
+-mkConstrInstance :: Name -> Con -> Q Dec
+-mkConstrInstance dt (NormalC n _) = mkConstrInstanceWith dt n []
+-mkConstrInstance dt (RecC n _) = mkConstrInstanceWith dt n
+- [ funD 'conIsRecord [clause [wildP] (normalB (conE 'True)) []]]
+-mkConstrInstance dt (InfixC t1 n t2) =
+- do
+- i <- reify n
+- let fi = case i of
+- DataConI _ _ _ f -> convertFixity f
+- _ -> Prefix
+- instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
+- [funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []],
+- funD 'conFixity [clause [wildP] (normalB [| fi |]) []]]
+- where
+- convertFixity (Fixity n d) = Infix (convertDirection d) n
+- convertDirection InfixL = LeftAssociative
+- convertDirection InfixR = RightAssociative
+- convertDirection InfixN = NotAssociative
+-
+-mkConstrInstanceWith :: Name -> Name -> [Q Dec] -> Q Dec
+-mkConstrInstanceWith dt n extra =
+- instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
+- (funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)
+-
+-mkSelectInstance :: Name -> Con -> Q [Dec]
+-mkSelectInstance dt r@(RecC n fs) = return (map one fs) where
+- one (f, _, _) =
+- InstanceD ([]) (AppT (ConT ''Selector) (ConT $ genName [dt, n, f]))
+- [FunD 'selName [Clause [WildP]
+- (NormalB (LitE (StringL (nameBase f)))) []]]
+-mkSelectInstance _ _ = return []
+-
+-rep0Type :: Name -> Q Type
+-rep0Type n =
+- do
+- -- runIO $ putStrLn $ "processing " ++ show n
+- i <- reify n
+- let b = case i of
+- TyConI (DataD _ dt vs cs _) ->
+- (conT ''D1) `appT` (conT $ genName [dt]) `appT`
+- (foldr1' sum (conT ''V1)
+- (map (rep0Con (dt, map tyVarBndrToName vs)) cs))
+- TyConI (NewtypeD _ dt vs c _) ->
+- (conT ''D1) `appT` (conT $ genName [dt]) `appT`
+- (rep0Con (dt, map tyVarBndrToName vs) c)
+- TyConI (TySynD t _ _) -> error "type synonym?"
+- _ -> error "unknown construct"
+- --appT b (conT $ mkName (nameBase n))
+- b where
+- sum :: Q Type -> Q Type -> Q Type
+- sum a b = conT ''(:+:) `appT` a `appT` b
+-
+-
+-rep0Con :: (Name, [Name]) -> Con -> Q Type
+-rep0Con (dt, vs) (NormalC n []) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
+- (conT ''S1 `appT` conT ''NoSelector `appT` conT ''U1)
+-rep0Con (dt, vs) (NormalC n fs) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
+- (foldr1 prod (map (repField (dt, vs) . snd) fs)) where
+- prod :: Q Type -> Q Type -> Q Type
+- prod a b = conT ''(:*:) `appT` a `appT` b
+-rep0Con (dt, vs) r@(RecC n []) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT` conT ''U1
+-rep0Con (dt, vs) r@(RecC n fs) =
+- conT ''C1 `appT` (conT $ genName [dt, n]) `appT`
+- (foldr1 prod (map (repField' (dt, vs) n) fs)) where
+- prod :: Q Type -> Q Type -> Q Type
+- prod a b = conT ''(:*:) `appT` a `appT` b
+-
+-rep0Con d (InfixC t1 n t2) = rep0Con d (NormalC n [t1,t2])
+-
+---dataDeclToType :: (Name, [Name]) -> Type
+---dataDeclToType (dt, vs) = foldl (\a b -> AppT a (VarT b)) (ConT dt) vs
+-
+-repField :: (Name, [Name]) -> Type -> Q Type
+---repField d t | t == dataDeclToType d = conT ''I
+-repField d t = conT ''S1 `appT` conT ''NoSelector `appT`
+- (conT ''Rec0 `appT` return t)
+-
+-repField' :: (Name, [Name]) -> Name -> (Name, Strict, Type) -> Q Type
+---repField' d ns (_, _, t) | t == dataDeclToType d = conT ''I
+-repField' (dt, vs) ns (f, _, t) = conT ''S1 `appT` conT (genName [dt, ns, f])
+- `appT` (conT ''Rec0 `appT` return t)
+--- Note: we should generate Par0 too, at some point
+-
+-
+-mkFrom :: Name -> Int -> Int -> Name -> Q [Q Clause]
+-mkFrom ns m i n =
+- do
+- -- runIO $ putStrLn $ "processing " ++ show n
+- let wrapE e = lrE m i e
+- i <- reify n
+- let b = case i of
+- TyConI (DataD _ dt vs cs _) ->
+- zipWith (fromCon wrapE ns (dt, map tyVarBndrToName vs)
+- (length cs)) [0..] cs
+- TyConI (NewtypeD _ dt vs c _) ->
+- [fromCon wrapE ns (dt, map tyVarBndrToName vs) 1 0 c]
+- TyConI (TySynD t _ _) -> error "type synonym?"
+- -- [clause [varP (field 0)] (normalB (wrapE $ conE 'K1 `appE` varE (field 0))) []]
+- _ -> error "unknown construct"
+- return b
+-
+-mkTo :: Name -> Int -> Int -> Name -> Q [Q Clause]
+-mkTo ns m i n =
+- do
+- -- runIO $ putStrLn $ "processing " ++ show n
+- let wrapP p = lrP m i p
+- i <- reify n
+- let b = case i of
+- TyConI (DataD _ dt vs cs _) ->
+- zipWith (toCon wrapP ns (dt, map tyVarBndrToName vs)
+- (length cs)) [0..] cs
+- TyConI (NewtypeD _ dt vs c _) ->
+- [toCon wrapP ns (dt, map tyVarBndrToName vs) 1 0 c]
+- TyConI (TySynD t _ _) -> error "type synonym?"
+- -- [clause [wrapP $ conP 'K1 [varP (field 0)]] (normalB $ varE (field 0)) []]
+- _ -> error "unknown construct"
+- return b
+-
+-fromCon :: (Q Exp -> Q Exp) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
+-fromCon wrap ns (dt, vs) m i (NormalC cn []) =
+- clause
+- [conP cn []]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ appE (conE 'M1) $
+- conE 'M1 `appE` (conE 'U1)) []
+-fromCon wrap ns (dt, vs) m i (NormalC cn fs) =
+- -- runIO (putStrLn ("constructor " ++ show ix)) >>
+- clause
+- [conP cn (map (varP . field) [0..length fs - 1])]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE`
+- foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map snd fs))) []
+- where prod x y = conE '(:*:) `appE` x `appE` y
+-fromCon wrap ns (dt, vs) m i r@(RecC cn []) =
+- clause
+- [conP cn []]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` (conE 'U1)) []
+-fromCon wrap ns (dt, vs) m i r@(RecC cn fs) =
+- clause
+- [conP cn (map (varP . field) [0..length fs - 1])]
+- (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE`
+- foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map trd fs))) []
+- where prod x y = conE '(:*:) `appE` x `appE` y
+-fromCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
+- fromCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
+-
+-fromField :: (Name, [Name]) -> Int -> Type -> Q Exp
+---fromField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conE 'I `appE` varE (field nr)
+-fromField (dt, vs) nr t = conE 'M1 `appE` (conE 'K1 `appE` varE (field nr))
+-
+-toCon :: (Q Pat -> Q Pat) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
+-toCon wrap ns (dt, vs) m i (NormalC cn []) =
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'M1 [conP 'U1 []]]]]
+- (normalB $ conE cn) []
+-toCon wrap ns (dt, vs) m i (NormalC cn fs) =
+- -- runIO (putStrLn ("constructor " ++ show ix)) >>
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1
+- [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map snd fs))]]]
+- (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
+- where prod x y = conP '(:*:) [x,y]
+-toCon wrap ns (dt, vs) m i r@(RecC cn []) =
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'U1 []]]]
+- (normalB $ conE cn) []
+-toCon wrap ns (dt, vs) m i r@(RecC cn fs) =
+- clause
+- [wrap $ conP 'M1 [lrP m i $ conP 'M1
+- [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map trd fs))]]]
+- (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
+- where prod x y = conP '(:*:) [x,y]
+-toCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
+- toCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
+-
+-toField :: (Name, [Name]) -> Int -> Type -> Q Pat
+---toField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conP 'I [varP (field nr)]
+-toField (dt, vs) nr t = conP 'M1 [conP 'K1 [varP (field nr)]]
+-
+-
+ field :: Int -> Name
+ field n = mkName $ "f" ++ show n
+
+-lrP :: Int -> Int -> (Q Pat -> Q Pat)
+-lrP 1 0 p = p
+-lrP m 0 p = conP 'L1 [p]
+-lrP m i p = conP 'R1 [lrP (m-1) (i-1) p]
+-
+-lrE :: Int -> Int -> (Q Exp -> Q Exp)
+-lrE 1 0 e = e
+-lrE m 0 e = conE 'L1 `appE` e
+-lrE m i e = conE 'R1 `appE` lrE (m-1) (i-1) e
+
+ trd (_,_,c) = c
+
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch
index 9b15c0448..bc453bfa1 100644
--- a/standalone/no-th/haskell-patches/lens_no-TH.patch
+++ b/standalone/no-th/haskell-patches/lens_no-TH.patch
@@ -1,20 +1,20 @@
-From 88ff2174944daf90530a33ee06e2e3f667089b6a Mon Sep 17 00:00:00 2001
+From 10c9ade98b3ac2054947f411d77db2eb28896b9f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 02:06:43 +0000
-Subject: [PATCH] remove TH
+Date: Thu, 16 Oct 2014 01:43:10 +0000
+Subject: [PATCH] avoid TH
---
- lens.cabal | 16 +---------------
- src/Control/Lens.hs | 6 ++----
+ 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(+), 27 deletions(-)
+ 7 files changed, 4 insertions(+), 30 deletions(-)
diff --git a/lens.cabal b/lens.cabal
-index c7f6009..ab206c5 100644
+index 5388301..d7b02b9 100644
--- a/lens.cabal
+++ b/lens.cabal
@@ -10,7 +10,7 @@ stability: provisional
@@ -26,7 +26,15 @@ index c7f6009..ab206c5 100644
-- 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
-@@ -230,8 +230,6 @@ library
+@@ -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
@@ -35,7 +43,7 @@ index c7f6009..ab206c5 100644
Control.Lens.Internal.Fold
Control.Lens.Internal.Getter
Control.Lens.Internal.Indexed
-@@ -243,25 +241,21 @@ library
+@@ -247,25 +244,21 @@ library
Control.Lens.Internal.Reflection
Control.Lens.Internal.Review
Control.Lens.Internal.Setter
@@ -61,7 +69,7 @@ index c7f6009..ab206c5 100644
Control.Monad.Primitive.Lens
Control.Parallel.Strategies.Lens
Control.Seq.Lens
-@@ -287,12 +281,8 @@ library
+@@ -291,12 +284,8 @@ library
Data.Typeable.Lens
Data.Vector.Lens
Data.Vector.Generic.Lens
@@ -74,7 +82,7 @@ index c7f6009..ab206c5 100644
Numeric.Lens
other-modules:
-@@ -395,7 +385,6 @@ test-suite doctests
+@@ -403,7 +392,6 @@ test-suite doctests
deepseq,
doctest >= 0.9.1,
filepath,
@@ -82,7 +90,7 @@ index c7f6009..ab206c5 100644
mtl,
nats,
parallel,
-@@ -433,7 +422,6 @@ benchmark plated
+@@ -441,7 +429,6 @@ benchmark plated
comonad,
criterion,
deepseq,
@@ -90,7 +98,7 @@ index c7f6009..ab206c5 100644
lens,
transformers
-@@ -468,7 +456,6 @@ benchmark unsafe
+@@ -476,7 +463,6 @@ benchmark unsafe
comonads-fd,
criterion,
deepseq,
@@ -98,7 +106,7 @@ index c7f6009..ab206c5 100644
lens,
transformers
-@@ -485,6 +472,5 @@ benchmark zipper
+@@ -493,6 +479,5 @@ benchmark zipper
comonads-fd,
criterion,
deepseq,
@@ -106,10 +114,18 @@ index c7f6009..ab206c5 100644
lens,
transformers
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
-index d879c58..3d6015b 100644
+index 7e15267..433f1fc 100644
--- a/src/Control/Lens.hs
+++ b/src/Control/Lens.hs
-@@ -56,12 +56,11 @@ module Control.Lens
+@@ -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
@@ -123,7 +139,15 @@ index d879c58..3d6015b 100644
, module Control.Lens.TH
#endif
, module Control.Lens.Traversal
-@@ -83,12 +82,11 @@ import Control.Lens.Iso
+@@ -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
@@ -138,12 +162,12 @@ index d879c58..3d6015b 100644
#endif
import Control.Lens.Traversal
diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs
-index 7b35db4..269f307 100644
+index a80e9c8..7d27b80 100644
--- a/src/Control/Lens/Cons.hs
+++ b/src/Control/Lens/Cons.hs
-@@ -56,8 +56,6 @@ import qualified Data.Vector.Unboxed as Unbox
+@@ -55,8 +55,6 @@ import Data.Vector.Unboxed (Unbox)
+ import qualified Data.Vector.Unboxed as Unbox
import Data.Word
- import Prelude
-{-# ANN module "HLint: ignore Eta reduce" #-}
-
@@ -151,12 +175,12 @@ index 7b35db4..269f307 100644
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs
-index 4bbde21..16295f4 100644
+index ab09c6b..43aa905 100644
--- a/src/Control/Lens/Internal/Fold.hs
+++ b/src/Control/Lens/Internal/Fold.hs
-@@ -35,8 +35,6 @@ import Data.Semigroup hiding (Min, getMin, Max, getMax)
+@@ -37,8 +37,6 @@ import Data.Maybe
+ import Data.Semigroup hiding (Min, getMin, Max, getMax)
import Data.Reflection
- import Prelude
-{-# ANN module "HLint: ignore Avoid lambda" #-}
-
@@ -164,10 +188,10 @@ index 4bbde21..16295f4 100644
-- Folding
------------------------------------------------------------------------------
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
-index 302f68e..1625fe5 100644
+index 9992e63..631e8e6 100644
--- a/src/Control/Lens/Operators.hs
+++ b/src/Control/Lens/Operators.hs
-@@ -104,7 +104,7 @@ module Control.Lens.Operators
+@@ -111,7 +111,7 @@ module Control.Lens.Operators
, (<#~)
, (<#=)
-- * "Control.Lens.Plated"
@@ -177,12 +201,12 @@ index 302f68e..1625fe5 100644
, ( # )
-- * "Control.Lens.Setter"
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
-index 36152d6..3af6bd3 100644
+index b75c870..c6c6596 100644
--- a/src/Control/Lens/Prism.hs
+++ b/src/Control/Lens/Prism.hs
-@@ -62,8 +62,6 @@ import Data.Profunctor.Unsafe
+@@ -61,8 +61,6 @@ import Unsafe.Coerce
+ import Data.Profunctor.Unsafe
#endif
- import Prelude
-{-# ANN module "HLint: ignore Use camelCase" #-}
-
@@ -190,17 +214,17 @@ index 36152d6..3af6bd3 100644
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs
-index 8f1ec94..482764a 100644
+index ee942c6..2f37134 100644
--- a/src/Control/Monad/Primitive/Lens.hs
+++ b/src/Control/Monad/Primitive/Lens.hs
-@@ -26,7 +26,6 @@ import Control.Lens
- import Control.Monad.Primitive
+@@ -20,7 +20,6 @@ import Control.Lens
+ import Control.Monad.Primitive (PrimMonad(..))
import GHC.Prim (State#)
-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
- #if MIN_VERSION_primitive(0,6,0)
- prim :: PrimBase m => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
+ prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
+ prim = iso internal primitive
--
-2.1.4
+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
new file mode 100644
index 000000000..c24fa5aa2
--- /dev/null
+++ b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch
@@ -0,0 +1,27 @@
+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
new file mode 100644
index 000000000..1bb843524
--- /dev/null
+++ b/standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch
@@ -0,0 +1,33 @@
+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_1.1.5.1_0001-disable-TH.patch b/standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
new file mode 100644
index 000000000..cd86ccd2d
--- /dev/null
+++ b/standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
@@ -0,0 +1,41 @@
+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/profunctors_3.3-0001-fix-cross-build.patch b/standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch
new file mode 100644
index 000000000..45397f3e5
--- /dev/null
+++ b/standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch
@@ -0,0 +1,26 @@
+From 392602f5ff14c0b5a801397d075ddcbcd890aa83 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Thu, 18 Apr 2013 17:50:59 -0400
+Subject: [PATCH] fix cross build
+
+---
+ src/Data/Profunctor/Unsafe.hs | 3 ---
+ 1 file changed, 3 deletions(-)
+
+diff --git a/src/Data/Profunctor/Unsafe.hs b/src/Data/Profunctor/Unsafe.hs
+index 025c7c4..0249274 100644
+--- a/src/Data/Profunctor/Unsafe.hs
++++ b/src/Data/Profunctor/Unsafe.hs
+@@ -40,9 +40,6 @@ import Data.Tagged
+ import Prelude hiding (id,(.),sequence)
+ import Unsafe.Coerce
+
+-{-# ANN module "Hlint: ignore Redundant lambda" #-}
+-{-# ANN module "Hlint: ignore Collapse lambdas" #-}
+-
+ infixr 9 #.
+ infixl 8 .#
+
+--
+1.8.2.rc3
+
diff --git a/standalone/no-th/haskell-patches/reflection_remove-TH.patch b/standalone/no-th/haskell-patches/reflection_remove-TH.patch
new file mode 100644
index 000000000..4f8b4bc20
--- /dev/null
+++ b/standalone/no-th/haskell-patches/reflection_remove-TH.patch
@@ -0,0 +1,59 @@
+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-css_remove_TH.patch b/standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch
new file mode 100644
index 000000000..82e2c6420
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch
@@ -0,0 +1,366 @@
+From 657fa7135bbcf3d5adb3cc0032e09887dd80a2a7 Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Thu, 16 Oct 2014 02:05:14 +0000
+Subject: [PATCH] hack TH
+
+---
+ Text/Cassius.hs | 23 --------
+ Text/Css.hs | 151 --------------------------------------------------
+ Text/CssCommon.hs | 4 --
+ Text/Lucius.hs | 46 +--------------
+ shakespeare-css.cabal | 2 +-
+ 5 files changed, 3 insertions(+), 223 deletions(-)
+
+diff --git a/Text/Cassius.hs b/Text/Cassius.hs
+index 91fc90f..c515807 100644
+--- a/Text/Cassius.hs
++++ b/Text/Cassius.hs
+@@ -13,10 +13,6 @@ module Text.Cassius
+ , renderCss
+ , renderCssUrl
+ -- * Parsing
+- , cassius
+- , cassiusFile
+- , cassiusFileDebug
+- , cassiusFileReload
+ -- * ToCss instances
+ -- ** Color
+ , Color (..)
+@@ -27,11 +23,8 @@ module Text.Cassius
+ , AbsoluteUnit (..)
+ , AbsoluteSize (..)
+ , absoluteSize
+- , EmSize (..)
+- , ExSize (..)
+ , PercentageSize (..)
+ , percentageSize
+- , PixelSize (..)
+ -- * Internal
+ , cassiusUsedIdentifiers
+ ) where
+@@ -43,25 +36,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+ import Language.Haskell.TH.Syntax
+ import qualified Data.Text.Lazy as TL
+ import Text.CssCommon
+-import Text.Lucius (lucius)
+ import qualified Text.Lucius
+ import Text.IndentToBrace (i2b)
+
+-cassius :: QuasiQuoter
+-cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }
+-
+-cassiusFile :: FilePath -> Q Exp
+-cassiusFile fp = do
+-#ifdef GHC_7_4
+- qAddDependentFile fp
+-#endif
+- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
+- quoteExp cassius contents
+-
+-cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp
+-cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels
+-cassiusFileReload = cassiusFileDebug
+-
+ -- | Determine which identifiers are used by the given template, useful for
+ -- creating systems like yesod devel.
+ cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
+diff --git a/Text/Css.hs b/Text/Css.hs
+index 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..8c40e8c 100644
+--- a/Text/CssCommon.hs
++++ b/Text/CssCommon.hs
+@@ -1,4 +1,3 @@
+-{-# LANGUAGE TemplateHaskell #-}
+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+ {-# LANGUAGE FlexibleInstances #-}
+ {-# LANGUAGE CPP #-}
+@@ -156,6 +155,3 @@ showSize :: Rational -> String -> String
+ showSize value' unit = printf "%f" value ++ unit
+ where value = fromRational value' :: Double
+
+-mkSizeType "EmSize" "em"
+-mkSizeType "ExSize" "ex"
+-mkSizeType "PixelSize" "px"
+diff --git a/Text/Lucius.hs b/Text/Lucius.hs
+index 346883d..f38492b 100644
+--- a/Text/Lucius.hs
++++ b/Text/Lucius.hs
+@@ -8,13 +8,9 @@
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Lucius
+ ( -- * Parsing
+- lucius
+- , luciusFile
+- , luciusFileDebug
+- , luciusFileReload
+ -- ** Mixins
+- , luciusMixin
+- , Mixin
++ -- luciusMixin
++ Mixin
+ -- ** Runtime
+ , luciusRT
+ , luciusRT'
+@@ -40,11 +36,8 @@ module Text.Lucius
+ , AbsoluteUnit (..)
+ , AbsoluteSize (..)
+ , absoluteSize
+- , EmSize (..)
+- , ExSize (..)
+ , PercentageSize (..)
+ , percentageSize
+- , PixelSize (..)
+ -- * Internal
+ , parseTopLevels
+ , luciusUsedIdentifiers
+@@ -67,18 +60,6 @@ import Data.List (isSuffixOf)
+ import Control.Arrow (second)
+ 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 ()
+
+@@ -218,17 +199,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 =
+@@ -377,15 +347,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $
+ -- creating systems like yesod devel.
+ luciusUsedIdentifiers :: String -> [(Deref, VarType)]
+ luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels
+-
+-luciusMixin :: QuasiQuoter
+-luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }
+-
+-luciusMixinFromString :: String -> Q Exp
+-luciusMixinFromString s' = do
+- r <- newName "_render"
+- case fmap compressBlock $ parse parseBlock s s of
+- Left e -> error $ show e
+- Right block -> blockToMixin r [] block
+- where
+- s = concat ["mixin{", s', "}"]
+diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal
+index 2d3b25a..cc0553c 100644
+--- a/shakespeare-css.cabal
++++ b/shakespeare-css.cabal
+@@ -35,8 +35,8 @@ library
+
+ exposed-modules: Text.Cassius
+ Text.Lucius
+- other-modules: Text.MkSizeType
+ Text.Css
++ other-modules: Text.MkSizeType
+ Text.IndentToBrace
+ Text.CssCommon
+ ghc-options: -Wall
+--
+2.1.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch b/standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch
new file mode 100644
index 000000000..905467130
--- /dev/null
+++ b/standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch
@@ -0,0 +1,316 @@
+From 26f7328b0123d3ffa66873b91189ba3bdae3356c Mon Sep 17 00:00:00 2001
+From: dummy <dummy@example.com>
+Date: Thu, 16 Oct 2014 02:07:32 +0000
+Subject: [PATCH] hack TH
+
+---
+ Text/Coffee.hs | 56 ++++-----------------------------------------
+ Text/Julius.hs | 67 +++++++++---------------------------------------------
+ Text/Roy.hs | 51 ++++-------------------------------------
+ Text/TypeScript.hs | 51 ++++-------------------------------------
+ 4 files changed, 24 insertions(+), 201 deletions(-)
+
+diff --git a/Text/Coffee.hs b/Text/Coffee.hs
+index 488c81b..61db85b 100644
+--- a/Text/Coffee.hs
++++ b/Text/Coffee.hs
+@@ -51,13 +51,13 @@ module Text.Coffee
+ -- ** Template-Reading Functions
+ -- | These QuasiQuoter and Template Haskell methods return values of
+ -- type @'JavascriptUrl' url@. See the Yesod book for details.
+- coffee
+- , coffeeFile
+- , coffeeFileReload
+- , coffeeFileDebug
++ -- coffee
++ --, coffeeFile
++ --, coffeeFileReload
++ --, coffeeFileDebug
+
+ #ifdef TEST_EXPORT
+- , coffeeSettings
++ --, coffeeSettings
+ #endif
+ ) where
+
+@@ -65,49 +65,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+ import Language.Haskell.TH.Syntax
+ import Text.Shakespeare
+ import Text.Julius
+-
+-coffeeSettings :: Q ShakespeareSettings
+-coffeeSettings = do
+- jsettings <- javascriptSettings
+- return $ jsettings { varChar = '%'
+- , preConversion = Just PreConvert {
+- preConvert = ReadProcess "coffee" ["-spb"]
+- , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks.
+- , preEscapeIgnoreLine = "#" -- ignore commented lines
+- , wrapInsertion = Just WrapInsertion {
+- wrapInsertionIndent = Just " "
+- , wrapInsertionStartBegin = "("
+- , wrapInsertionSeparator = ", "
+- , wrapInsertionStartClose = ") =>"
+- , wrapInsertionEnd = ""
+- , wrapInsertionAddParens = False
+- }
+- }
+- }
+-
+--- | Read inline, quasiquoted CoffeeScript.
+-coffee :: QuasiQuoter
+-coffee = QuasiQuoter { quoteExp = \s -> do
+- rs <- coffeeSettings
+- quoteExp (shakespeare rs) s
+- }
+-
+--- | Read in a CoffeeScript template file. This function reads the file once, at
+--- compile time.
+-coffeeFile :: FilePath -> Q Exp
+-coffeeFile fp = do
+- rs <- coffeeSettings
+- shakespeareFile rs fp
+-
+--- | Read in a CoffeeScript template file. This impure function uses
+--- unsafePerformIO to re-read the file on every call, allowing for rapid
+--- iteration.
+-coffeeFileReload :: FilePath -> Q Exp
+-coffeeFileReload fp = do
+- rs <- coffeeSettings
+- shakespeareFileReload rs fp
+-
+--- | Deprecated synonym for 'coffeeFileReload'
+-coffeeFileDebug :: FilePath -> Q Exp
+-coffeeFileDebug = coffeeFileReload
+-{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-}
+diff --git a/Text/Julius.hs b/Text/Julius.hs
+index ec30690..5b5a075 100644
+--- a/Text/Julius.hs
++++ b/Text/Julius.hs
+@@ -14,17 +14,17 @@ module Text.Julius
+ -- ** Template-Reading Functions
+ -- | These QuasiQuoter and Template Haskell methods return values of
+ -- type @'JavascriptUrl' url@. See the Yesod book for details.
+- js
+- , julius
+- , juliusFile
+- , jsFile
+- , juliusFileDebug
+- , jsFileDebug
+- , juliusFileReload
+- , jsFileReload
++ -- js
++ -- julius
++ -- juliusFile
++ -- jsFile
++ --, juliusFileDebug
++ --, jsFileDebug
++ --, juliusFileReload
++ --, jsFileReload
+
+ -- * Datatypes
+- , JavascriptUrl
++ JavascriptUrl
+ , Javascript (..)
+ , RawJavascript (..)
+
+@@ -37,9 +37,9 @@ module Text.Julius
+ , renderJavascriptUrl
+
+ -- ** internal, used by 'Text.Coffee'
+- , javascriptSettings
++ --, javascriptSettings
+ -- ** internal
+- , juliusUsedIdentifiers
++ --, juliusUsedIdentifiers
+ , asJavascriptUrl
+ ) where
+
+@@ -102,48 +102,3 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText
+ instance RawJS Builder where rawJS = RawJavascript
+ instance RawJS Bool where rawJS = RawJavascript . unJavascript . toJavascript
+
+-javascriptSettings :: Q ShakespeareSettings
+-javascriptSettings = do
+- toJExp <- [|toJavascript|]
+- wrapExp <- [|Javascript|]
+- unWrapExp <- [|unJavascript|]
+- asJavascriptUrl' <- [|asJavascriptUrl|]
+- return $ defaultShakespeareSettings { toBuilder = toJExp
+- , wrap = wrapExp
+- , unwrap = unWrapExp
+- , modifyFinalValue = Just asJavascriptUrl'
+- }
+-
+-js, julius :: QuasiQuoter
+-js = QuasiQuoter { quoteExp = \s -> do
+- rs <- javascriptSettings
+- quoteExp (shakespeare rs) s
+- }
+-
+-julius = js
+-
+-jsFile, juliusFile :: FilePath -> Q Exp
+-jsFile fp = do
+- rs <- javascriptSettings
+- shakespeareFile rs fp
+-
+-juliusFile = jsFile
+-
+-
+-jsFileReload, juliusFileReload :: FilePath -> Q Exp
+-jsFileReload fp = do
+- rs <- javascriptSettings
+- shakespeareFileReload rs fp
+-
+-juliusFileReload = jsFileReload
+-
+-jsFileDebug, juliusFileDebug :: FilePath -> Q Exp
+-juliusFileDebug = jsFileReload
+-{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-}
+-jsFileDebug = jsFileReload
+-{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-}
+-
+--- | Determine which identifiers are used by the given template, useful for
+--- creating systems like yesod devel.
+-juliusUsedIdentifiers :: String -> [(Deref, VarType)]
+-juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings
+diff --git a/Text/Roy.hs b/Text/Roy.hs
+index 6e5e246..9ab0dbc 100644
+--- a/Text/Roy.hs
++++ b/Text/Roy.hs
+@@ -39,12 +39,12 @@ module Text.Roy
+ -- ** Template-Reading Functions
+ -- | These QuasiQuoter and Template Haskell methods return values of
+ -- type @'JavascriptUrl' url@. See the Yesod book for details.
+- roy
+- , royFile
+- , royFileReload
++ -- roy
++ --, royFile
++ --, royFileReload
+
+ #ifdef TEST_EXPORT
+- , roySettings
++ --, roySettings
+ #endif
+ ) where
+
+@@ -53,46 +53,3 @@ import Language.Haskell.TH.Syntax
+ import Text.Shakespeare
+ import Text.Julius
+
+--- | The Roy language compiles down to Javascript.
+--- We do this compilation once at compile time to avoid needing to do it during the request.
+--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call.
+-roySettings :: Q ShakespeareSettings
+-roySettings = do
+- jsettings <- javascriptSettings
+- return $ jsettings { varChar = '#'
+- , preConversion = Just PreConvert {
+- preConvert = ReadProcess "roy" ["--stdio", "--browser"]
+- , preEscapeIgnoreBalanced = "'\""
+- , preEscapeIgnoreLine = "//"
+- , wrapInsertion = Just WrapInsertion {
+- wrapInsertionIndent = Just " "
+- , wrapInsertionStartBegin = "(\\"
+- , wrapInsertionSeparator = " "
+- , wrapInsertionStartClose = " ->\n"
+- , wrapInsertionEnd = ")"
+- , wrapInsertionAddParens = True
+- }
+- }
+- }
+-
+--- | Read inline, quasiquoted Roy.
+-roy :: QuasiQuoter
+-roy = QuasiQuoter { quoteExp = \s -> do
+- rs <- roySettings
+- quoteExp (shakespeare rs) s
+- }
+-
+--- | Read in a Roy template file. This function reads the file once, at
+--- compile time.
+-royFile :: FilePath -> Q Exp
+-royFile fp = do
+- rs <- roySettings
+- shakespeareFile rs fp
+-
+--- | Read in a Roy template file. This impure function uses
+--- unsafePerformIO to re-read the file on every call, allowing for rapid
+--- iteration.
+-royFileReload :: FilePath -> Q Exp
+-royFileReload fp = do
+- rs <- roySettings
+- shakespeareFileReload rs fp
+diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs
+index 70c8820..5be994a 100644
+--- a/Text/TypeScript.hs
++++ b/Text/TypeScript.hs
+@@ -57,12 +57,12 @@ module Text.TypeScript
+ -- ** Template-Reading Functions
+ -- | These QuasiQuoter and Template Haskell methods return values of
+ -- type @'JavascriptUrl' url@. See the Yesod book for details.
+- tsc
+- , typeScriptFile
+- , typeScriptFileReload
++ -- tsc
++ --, typeScriptFile
++ --, typeScriptFileReload
+
+ #ifdef TEST_EXPORT
+- , typeScriptSettings
++ --, typeScriptSettings
+ #endif
+ ) where
+
+@@ -71,46 +71,3 @@ import Language.Haskell.TH.Syntax
+ import Text.Shakespeare
+ import Text.Julius
+
+--- | The TypeScript language compiles down to Javascript.
+--- We do this compilation once at compile time to avoid needing to do it during the request.
+--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call.
+-typeScriptSettings :: Q ShakespeareSettings
+-typeScriptSettings = do
+- jsettings <- javascriptSettings
+- return $ jsettings { varChar = '#'
+- , preConversion = Just PreConvert {
+- preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"]
+- , preEscapeIgnoreBalanced = "'\""
+- , preEscapeIgnoreLine = "//"
+- , wrapInsertion = Just WrapInsertion {
+- wrapInsertionIndent = Nothing
+- , wrapInsertionStartBegin = ";(function("
+- , wrapInsertionSeparator = ", "
+- , wrapInsertionStartClose = "){"
+- , wrapInsertionEnd = "})"
+- , wrapInsertionAddParens = False
+- }
+- }
+- }
+-
+--- | Read inline, quasiquoted TypeScript
+-tsc :: QuasiQuoter
+-tsc = QuasiQuoter { quoteExp = \s -> do
+- rs <- typeScriptSettings
+- quoteExp (shakespeare rs) s
+- }
+-
+--- | Read in a TypeScript template file. This function reads the file once, at
+--- compile time.
+-typeScriptFile :: FilePath -> Q Exp
+-typeScriptFile fp = do
+- rs <- typeScriptSettings
+- shakespeareFile rs fp
+-
+--- | Read in a Roy template file. This impure function uses
+--- unsafePerformIO to re-read the file on every call, allowing for rapid
+--- iteration.
+-typeScriptFileReload :: FilePath -> Q Exp
+-typeScriptFileReload fp = do
+- rs <- typeScriptSettings
+- shakespeareFileReload rs fp
+--
+2.1.1
+
diff --git a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch
index 68226dcc6..940514756 100644
--- a/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch
+++ b/standalone/no-th/haskell-patches/shakespeare_remove-TH.patch
@@ -1,1039 +1,18 @@
-From 4694f3a7ee4eb15d33ecda9d62712ea236304c1b Mon Sep 17 00:00:00 2001
+From 38a22dae4f7f9726379fdaa3f85d78d75eee9d8e Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Thu, 2 Jul 2015 22:17:29 +0000
+Date: Thu, 16 Oct 2014 02:01:22 +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(-)
+ Text/Shakespeare.hs | 70 ++++++++----------------------------------------
+ Text/Shakespeare/Base.hs | 28 -------------------
+ 2 files changed, 11 insertions(+), 87 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
+index 68e344f..97361a2 100644
--- a/Text/Shakespeare.hs
+++ b/Text/Shakespeare.hs
-@@ -16,12 +16,12 @@ module Text.Shakespeare
+@@ -14,12 +14,12 @@ module Text.Shakespeare
, WrapInsertion (..)
, PreConversion (..)
, defaultShakespeareSettings
@@ -1051,7 +30,7 @@ index 98c0c2d..2f6431b 100644
, RenderUrl
, VarType (..)
, Deref
-@@ -153,38 +153,6 @@ defaultShakespeareSettings = ShakespeareSettings {
+@@ -154,38 +154,6 @@ defaultShakespeareSettings = ShakespeareSettings {
, modifyFinalValue = Nothing
}
@@ -1090,7 +69,7 @@ index 98c0c2d..2f6431b 100644
type QueryParameters = [(TS.Text, TS.Text)]
type RenderUrl url = (url -> QueryParameters -> TS.Text)
-@@ -348,6 +316,7 @@ pack' = TS.pack
+@@ -349,6 +317,7 @@ pack' = TS.pack
{-# NOINLINE pack' #-}
#endif
@@ -1098,7 +77,7 @@ index 98c0c2d..2f6431b 100644
contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
contentsToShakespeare rs a = do
r <- newName "_render"
-@@ -399,16 +368,19 @@ shakespeareFile r fp =
+@@ -400,16 +369,19 @@ shakespeareFile r fp =
qAddDependentFile fp >>
#endif
readFileQ fp >>= shakespeareFromString r
@@ -1118,7 +97,7 @@ index 98c0c2d..2f6431b 100644
data VarExp url = EPlain Builder
| EUrl url
-@@ -417,8 +389,10 @@ data VarExp url = EPlain Builder
+@@ -418,8 +390,10 @@ data VarExp url = EPlain Builder
-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
@@ -1129,7 +108,7 @@ index 98c0c2d..2f6431b 100644
type MTime = UTCTime
-@@ -435,28 +409,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
+@@ -436,28 +410,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
(\reloadMap -> (M.insert fp (mt, content) reloadMap, content))
@@ -1197,242 +176,6 @@ index a0e983c..23b4692 100644
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
+2.1.1
diff --git a/standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch b/standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch
new file mode 100644
index 000000000..7333742b0
--- /dev/null
+++ b/standalone/no-th/haskell-patches/skein_hardcode_little-endian.patch
@@ -0,0 +1,26 @@
+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
new file mode 100644
index 000000000..f89f0d60b
--- /dev/null
+++ b/standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch
@@ -0,0 +1,49 @@
+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
index 76beafd03..93314312f 100644
--- 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
@@ -1,8 +1,12 @@
-From a020dd27eda45263db6ac887df4a94efb6ca86db Mon Sep 17 00:00:00 2001
+From 3aef808eee43c973ae1fbf6e8769d89b7f0d355b Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Thu, 2 Jul 2015 21:36:02 +0000
+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 ++++----
@@ -10,10 +14,10 @@ Subject: [PATCH] deal with TH
3 files changed, 5 insertions(+), 11 deletions(-)
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
-index 228582d..7d72bb0 100644
+index db2b835..b2c1aec 100644
--- a/Network/Wai/Application/Static.hs
+++ b/Network/Wai/Application/Static.hs
-@@ -34,8 +34,6 @@ import Control.Monad.IO.Class (liftIO)
+@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
import Blaze.ByteString.Builder (toByteString)
@@ -22,10 +26,10 @@ index 228582d..7d72bb0 100644
import Data.Text (Text)
import qualified Data.Text as T
-@@ -218,8 +216,6 @@ staticAppPieces _ _ req sendResponse
+@@ -198,8 +196,6 @@ staticAppPieces _ _ req sendResponse
H.status405
[("Content-Type", "text/plain")]
- "Only GET or HEAD is supported"
+ "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
@@ -51,10 +55,10 @@ index daa6e50..9873d4e 100644
-import WaiAppStatic.Storage.Embedded.TH
+--import WaiAppStatic.Storage.Embedded.TH
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
-index 4cca237..3fbfcee 100644
+index ef6f898..9a59d71 100644
--- a/wai-app-static.cabal
+++ b/wai-app-static.cabal
-@@ -35,7 +35,6 @@ library
+@@ -33,7 +33,6 @@ library
, containers >= 0.2
, time >= 1.1.4
, old-locale >= 1.0.0.2
@@ -62,7 +66,7 @@ index 4cca237..3fbfcee 100644
, text >= 0.7
, blaze-builder >= 0.2.1.4
, base64-bytestring >= 0.1
-@@ -63,9 +62,8 @@ library
+@@ -61,9 +60,8 @@ library
WaiAppStatic.Listing
WaiAppStatic.Types
WaiAppStatic.CmdLine
@@ -74,5 +78,5 @@ index 4cca237..3fbfcee 100644
extensions: CPP
--
-2.1.4
+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
new file mode 100644
index 000000000..b6334d31f
--- /dev/null
+++ b/standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch
@@ -0,0 +1,108 @@
+From b53713fbb4f3bb6bdd25b07afcaed4940b32dfa8 Mon Sep 17 00:00:00 2001
+From: Joey Hess <joey@kitenet.net>
+Date: Wed, 18 Dec 2013 03:32:44 +0000
+Subject: [PATCH] remove TH
+
+---
+ Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
+ 1 file changed, 1 insertion(+), 80 deletions(-)
+
+diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
+index f587410..4e830bd 100644
+--- a/Text/Hamlet/XML.hs
++++ b/Text/Hamlet/XML.hs
+@@ -1,9 +1,7 @@
+ {-# LANGUAGE TemplateHaskell #-}
+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}
+ module Text.Hamlet.XML
+- ( xml
+- , xmlFile
+- ) where
++ () where
+
+ import Language.Haskell.TH.Syntax
+ import Language.Haskell.TH.Quote
+@@ -19,80 +17,3 @@ import qualified Data.Foldable as F
+ import Data.Maybe (fromMaybe)
+ import qualified Data.Map as Map
+
+-xml :: QuasiQuoter
+-xml = QuasiQuoter { quoteExp = strToExp }
+-
+-xmlFile :: FilePath -> Q Exp
+-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
+-
+-strToExp :: String -> Q Exp
+-strToExp s =
+- case parseDoc s of
+- Error e -> error e
+- Ok x -> docsToExp [] x
+-
+-docsToExp :: Scope -> [Doc] -> Q Exp
+-docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
+-
+-docToExp :: Scope -> Doc -> Q Exp
+-docToExp scope (DocTag name attrs cs) =
+- [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
+- ] |]
+-docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
+-docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
+-docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
+-docToExp scope (DocForall deref ident@(Ident ident') inside) = do
+- let list' = derefToExp scope deref
+- name <- newName ident'
+- let scope' = (ident, VarE name) : scope
+- inside' <- docsToExp scope' inside
+- let lam = LamE [VarP name] inside'
+- [| F.concatMap $(return lam) $(return list') |]
+-docToExp scope (DocWith [] inside) = docsToExp scope inside
+-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
+- let deref' = derefToExp scope deref
+- name' <- newName name
+- let scope' = (ident, VarE name') : scope
+- inside' <- docToExp scope' (DocWith dis inside)
+- let lam = LamE [VarP name'] inside'
+- return $ lam `AppE` deref'
+-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
+- let deref' = derefToExp scope deref
+- name' <- newName name
+- let scope' = (ident, VarE name') : scope
+- inside' <- docsToExp scope' just
+- let inside'' = LamE [VarP name'] inside'
+- nothing' <-
+- case nothing of
+- Nothing -> [| [] |]
+- Just n -> docsToExp scope n
+- [| maybe $(return nothing') $(return inside'') $(return deref') |]
+-docToExp scope (DocCond conds final) = do
+- unit <- [| () |]
+- body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
+- return $ CaseE unit [Match (TupP []) body []]
+- where
+- go (deref, inside) = do
+- inside' <- docsToExp scope inside
+- return (NormalG $ derefToExp scope deref, inside')
+-
+-mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
+-mkAttrs _ [] = [| Map.empty |]
+-mkAttrs scope ((mderef, name, value):rest) = do
+- rest' <- mkAttrs scope rest
+- this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
+- let with = [| $(return this) $(return rest') |]
+- case mderef of
+- Nothing -> with
+- Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
+- where
+- go (ContentRaw s) = [| pack $(lift s) |]
+- go (ContentVar d) = return $ derefToExp scope d
+- go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
+-
+-liftName :: String -> Q Exp
+-liftName s = do
+- X.Name local mns _ <- return $ fromString s
+- case mns of
+- Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
+- Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
+--
+1.8.5.1
+
diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
index 723ec099a..f58fcb353 100644
--- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
+++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch
@@ -1,6 +1,6 @@
-From bec7dac77cc7fbe9a620c371d7c2cdbcf234eac6 Mon Sep 17 00:00:00 2001
+From f1feea61dcba0b16afed5ce8dd5d2433fe505461 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 00:39:53 +0000
+Date: Thu, 16 Oct 2014 02:15:23 +0000
Subject: [PATCH] hack TH
---
@@ -15,7 +15,7 @@ Subject: [PATCH] hack TH
8 files changed, 213 insertions(+), 288 deletions(-)
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
-index f7436e6..2fa62cc 100644
+index 9b29317..7c0792d 100644
--- a/Yesod/Core.hs
+++ b/Yesod/Core.hs
@@ -31,16 +31,16 @@ module Yesod.Core
@@ -45,7 +45,7 @@ index f7436e6..2fa62cc 100644
-- * Sessions
, SessionBackend (..)
, customizeSessionCookies
-@@ -90,17 +90,15 @@ module Yesod.Core
+@@ -87,17 +87,15 @@ module Yesod.Core
, readIntegral
-- * Shakespeare
-- ** Hamlet
@@ -68,10 +68,10 @@ index f7436e6..2fa62cc 100644
, renderCssUrl
) where
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
-index c2e707a..b594353 100644
+index 8631d27..c40eb10 100644
--- a/Yesod/Core/Class/Yesod.hs
+++ b/Yesod/Core/Class/Yesod.hs
-@@ -5,11 +5,15 @@
+@@ -5,18 +5,22 @@
{-# LANGUAGE CPP #-}
module Yesod.Core.Class.Yesod where
@@ -88,16 +88,15 @@ index c2e707a..b594353 100644
import Blaze.ByteString.Builder (Builder)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
-@@ -18,7 +22,7 @@ import Control.Exception (bracket)
+ import Control.Arrow ((***), second)
import Control.Monad (forM, when, void)
import Control.Monad.IO.Class (MonadIO (liftIO))
- import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
-- LogSource)
-+ LogSource, Loc)
- import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState)
+-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
-@@ -35,7 +39,6 @@ import qualified Data.Text.Encoding.Error as TEE
+@@ -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)
@@ -105,7 +104,7 @@ index c2e707a..b594353 100644
import Network.HTTP.Types (encodePath)
import qualified Network.Wai as W
import Data.Default (def)
-@@ -87,18 +90,26 @@ class RenderRoute site => Yesod site where
+@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where
defaultLayout w = do
p <- widgetToPageContent w
mmsg <- getMessage
@@ -144,7 +143,7 @@ index c2e707a..b594353 100644
-- | 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
-@@ -410,45 +421,103 @@ widgetToPageContent w = do
+@@ -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
@@ -287,7 +286,7 @@ index c2e707a..b594353 100644
return $ PageContent title headAll $
case jsLoader master of
-@@ -478,10 +547,13 @@ defaultErrorHandler NotFound = selectRep $ do
+@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do
r <- waiRequest
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
setTitle "Not Found"
@@ -305,7 +304,7 @@ index c2e707a..b594353 100644
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
-- For API requests.
-@@ -491,10 +563,11 @@ defaultErrorHandler NotFound = selectRep $ do
+@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do
defaultErrorHandler NotAuthenticated = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Not logged in"
@@ -321,7 +320,7 @@ index c2e707a..b594353 100644
provideRep $ do
-- 401 *MUST* include a WWW-Authenticate header
-@@ -516,10 +589,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
+@@ -480,10 +553,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Permission Denied"
@@ -339,7 +338,7 @@ index c2e707a..b594353 100644
provideRep $
return $ object $ [
"message" .= ("Permission Denied. " <> msg)
-@@ -528,30 +604,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
+@@ -492,30 +568,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
provideRep $ defaultLayout $ do
setTitle "Invalid Arguments"
@@ -397,7 +396,7 @@ index c2e707a..b594353 100644
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
asyncHelper :: (url -> [x] -> Text)
-@@ -718,8 +806,4 @@ loadClientSession key getCachedDate sessionName req = load
+@@ -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
@@ -408,7 +407,7 @@ index c2e707a..b594353 100644
- char = show . snd . loc_start
+fileLocationToString loc = "unknown"
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
-index 7e43f74..625a901 100644
+index e0d1f0e..cc23fdd 100644
--- a/Yesod/Core/Dispatch.hs
+++ b/Yesod/Core/Dispatch.hs
@@ -1,4 +1,3 @@
@@ -445,9 +444,9 @@ index 7e43f74..625a901 100644
, PathMultiPiece (..)
, Texts
-- * Convert to WAI
-@@ -141,13 +140,6 @@ toWaiAppLogger logger site = do
+@@ -135,13 +134,6 @@ toWaiAppLogger logger site = do
+ , yreSite = site
, yreSessionBackend = sb
- , yreGen = gen
}
- messageLoggerSource
- site
@@ -459,10 +458,10 @@ index 7e43f74..625a901 100644
middleware <- mkDefaultMiddlewares logger
return $ middleware $ toWaiAppYre yre
-@@ -167,14 +159,7 @@ warp port site = do
- Network.Wai.Handler.Warp.setPort port $
- Network.Wai.Handler.Warp.setServerName serverValue $
- Network.Wai.Handler.Warp.setOnException (\_ e ->
+@@ -170,14 +162,7 @@ warp port site = do
+ ]
+ -}
+ , Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
- when (shouldLog' e) $
- messageLoggerSource
- site
@@ -470,12 +469,12 @@ index 7e43f74..625a901 100644
- $(qLocation >>= liftLoc)
- "yesod-core"
- LevelError
-- (toLogStr $ "Exception from Warp: " ++ show e)) $
-+ when (shouldLog' e) $ error (show e)) $
- Network.Wai.Handler.Warp.defaultSettings)
+- (toLogStr $ "Exception from Warp: " ++ show e)
++ when (shouldLog' e) $ error (show e)
+ }
where
- shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException
-@@ -208,7 +193,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
+ shouldLog' =
+@@ -211,7 +196,6 @@ defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverr
-- | Deprecated synonym for 'warp'.
warpDebug :: YesodDispatch site => Int -> site -> IO ()
warpDebug = warp
@@ -484,10 +483,10 @@ index 7e43f74..625a901 100644
-- | 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 19f4152..c97fb24 100644
+index d2b196b..13cac17 100644
--- a/Yesod/Core/Handler.hs
+++ b/Yesod/Core/Handler.hs
-@@ -178,7 +178,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
+@@ -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
@@ -496,7 +495,7 @@ index 19f4152..c97fb24 100644
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
-@@ -206,6 +206,7 @@ import Control.Exception (throwIO)
+@@ -203,6 +203,7 @@ import Control.Exception (throwIO)
import Blaze.ByteString.Builder (Builder)
import Safe (headMay)
import Data.CaseInsensitive (CI)
@@ -504,7 +503,7 @@ index 19f4152..c97fb24 100644
import qualified Data.Conduit.List as CL
import Control.Monad (unless)
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO
-@@ -848,19 +849,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
-> m a
redirectToPost url = do
urlText <- toTextUrl url
@@ -534,7 +533,7 @@ index 19f4152..c97fb24 100644
-- | 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 651c11c..46e1d2a 100644
+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)
@@ -544,18 +543,18 @@ index 651c11c..46e1d2a 100644
-import Control.Monad.Logger (LogLevel (LevelError), LogSource,
+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource,
liftLoc)
- import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState)
+ import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
import qualified Data.ByteString as S
-@@ -32,7 +32,7 @@ import Data.Text.Encoding (encodeUtf8)
+@@ -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 Data.Time (getCurrentTime, addUTCTime)
-import Language.Haskell.TH.Syntax (Loc, qLocation)
+import Language.Haskell.TH.Syntax (qLocation)
import qualified Network.HTTP.Types as H
import Network.Wai
- import Network.Wai.Internal
-@@ -160,8 +160,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+ #if MIN_VERSION_wai(2, 0, 0)
+@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ErrorResponse
-> YesodApp
safeEh log' er req = do
@@ -684,26 +683,26 @@ index 7e84c1c..a273c29 100644
- ]
- return $ LetE [fun] (VarE helper)
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
-index 5fa5c3d..1646d54 100644
+index 388dfe3..b3fce0f 100644
--- a/Yesod/Core/Types.hs
+++ b/Yesod/Core/Types.hs
-@@ -19,6 +19,7 @@ import Control.Monad.Base (MonadBase (liftBase))
- import Control.Monad.Catch (MonadCatch (..))
+@@ -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 (..))
-@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv
+@@ -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)
- , rheGetMaxExpires :: IO Text
-- ^ 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
@@ -765,5 +764,5 @@ index 481199e..8489fbe 100644
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m))
--
-2.1.4
+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
index b9a84b1ad..84314a8d9 100644
--- a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
+++ b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
@@ -1,27 +1,22 @@
-From 4cf9a045569ea0b51b4ee11df2dadbde330f7813 Mon Sep 17 00:00:00 2001
+From 1b24ece1a40c9365f719472ca6e342c8c4065c25 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 01:06:34 +0000
+Date: Thu, 16 Oct 2014 02:31:20 +0000
Subject: [PATCH] hack TH
-1. EvilSplicer
-2. Add imports
-3. Fix some syntax errors in spliced code
-4. Remove some persistent stuff that doesn't build.
---
- Yesod/Form/Bootstrap3.hs | 189 +++++++++--
- Yesod/Form/Fields.hs | 811 ++++++++++++++++++++++++++++++++++++-----------
- Yesod/Form/Functions.hs | 255 ++++++++++++---
- Yesod/Form/Jquery.hs | 124 ++++++--
+ 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 | 60 +++-
- yesod-form.cabal | 2 +-
- 7 files changed, 1311 insertions(+), 356 deletions(-)
+ 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 8377a68..fa8b7d4 100644
+index 84e85fc..1954fb4 100644
--- a/Yesod/Form/Bootstrap3.hs
+++ b/Yesod/Form/Bootstrap3.hs
-@@ -35,6 +35,9 @@ import Data.String (IsString(..))
+@@ -26,6 +26,9 @@ import Data.String (IsString(..))
import Yesod.Core
import qualified Data.Text as T
@@ -31,7 +26,7 @@ index 8377a68..fa8b7d4 100644
import Yesod.Form.Types
import Yesod.Form.Functions
-@@ -155,44 +158,144 @@ renderBootstrap3 formLayout aform fragment = do
+@@ -152,44 +155,144 @@ renderBootstrap3 formLayout aform fragment = do
let views = views' []
has (Just _) = True
has Nothing = False
@@ -64,22 +59,22 @@ index 8377a68..fa8b7d4 100644
- |]
+ widget = do { (asWidgetT . toWidget) (toHtml fragment);
+ Data.Foldable.mapM_
-+ (\ view_a2d4p
++ (\ view_as0a
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<div class=\"form-group ");
+ Text.Hamlet.condH
-+ [(fvRequired view_a2d4p,
++ [(fvRequired view_as0a,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(not (fvRequired view_a2d4p),
++ [(not (fvRequired view_as0a),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "optional "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(has (fvErrors view_a2d4p),
++ [(has (fvErrors view_as0a),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "has-error"))]
+ Nothing;
@@ -88,66 +83,66 @@ index 8377a68..fa8b7d4 100644
+ case formLayout of {
+ ; BootstrapBasicForm
+ -> do { Text.Hamlet.condH
-+ [((/=) (fvId view_a2d4p) bootstrapSubmitId,
++ [((/=) (fvId view_as0a) bootstrapSubmitId,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<label for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p));
++ (asWidgetT . toWidget) (toHtml (fvId view_as0a));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</label>") })]
+ Nothing;
-+ (asWidgetT . toWidget) (fvInput view_a2d4p);
-+ (asWidgetT . toWidget) (helpWidget view_a2d4p) }
++ (asWidgetT . toWidget) (fvInput view_as0a);
++ (asWidgetT . toWidget) (helpWidget view_as0a) }
+ ; BootstrapInlineForm
+ -> do { Text.Hamlet.condH
-+ [((/=) (fvId view_a2d4p) bootstrapSubmitId,
++ [((/=) (fvId view_as0a) bootstrapSubmitId,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<label class=\"sr-only\" for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p));
++ (asWidgetT . toWidget) (toHtml (fvId view_as0a));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</label>") })]
+ Nothing;
-+ (asWidgetT . toWidget) (fvInput view_a2d4p);
-+ (asWidgetT . toWidget) (helpWidget view_a2d4p) }
-+ ; BootstrapHorizontalForm labelOffset_a2d4q
-+ labelSize_a2d4r
-+ inputOffset_a2d4s
-+ inputSize_a2d4t
++ (asWidgetT . toWidget) (fvInput view_as0a);
++ (asWidgetT . toWidget) (helpWidget view_as0a) }
++ ; BootstrapHorizontalForm labelOffset_as0b
++ labelSize_as0c
++ inputOffset_as0d
++ inputSize_as0e
+ -> Text.Hamlet.condH
-+ [((/=) (fvId view_a2d4p) bootstrapSubmitId,
++ [((/=) (fvId view_as0a) bootstrapSubmitId,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<label class=\"control-label ");
-+ (asWidgetT . toWidget) (toHtml (toOffset labelOffset_a2d4q));
++ (asWidgetT . toWidget) (toHtml (toOffset labelOffset_as0b));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) " ");
-+ (asWidgetT . toWidget) (toHtml (toColumn labelSize_a2d4r));
++ (asWidgetT . toWidget) (toHtml (toColumn labelSize_as0c));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\" for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p));
++ (asWidgetT . toWidget) (toHtml (fvId view_as0a));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_as0a));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</label><div class=\"");
-+ (asWidgetT . toWidget) (toHtml (toOffset inputOffset_a2d4s));
++ (asWidgetT . toWidget) (toHtml (toOffset inputOffset_as0d));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) " ");
-+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_a2d4t));
++ (asWidgetT . toWidget) (toHtml (toColumn inputSize_as0e));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
-+ (asWidgetT . toWidget) (fvInput view_a2d4p);
-+ (asWidgetT . toWidget) (helpWidget view_a2d4p);
++ (asWidgetT . toWidget) (fvInput view_as0a);
++ (asWidgetT . toWidget) (helpWidget view_as0a);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</div>") })]
+ (Just
@@ -158,15 +153,15 @@ index 8377a68..fa8b7d4 100644
+ (toHtml
+ (toOffset
+ (addGO
-+ inputOffset_a2d4s
-+ (addGO labelOffset_a2d4q labelSize_a2d4r))));
++ inputOffset_as0d
++ (addGO labelOffset_as0b labelSize_as0c))));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) " ");
-+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_a2d4t));
++ (asWidgetT . toWidget) (toHtml (toColumn inputSize_as0e));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
-+ (asWidgetT . toWidget) (fvInput view_a2d4p);
-+ (asWidgetT . toWidget) (helpWidget view_a2d4p);
++ (asWidgetT . toWidget) (fvInput view_as0a);
++ (asWidgetT . toWidget) (helpWidget view_as0a);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</div>") })) };
@@ -187,21 +182,21 @@ index 8377a68..fa8b7d4 100644
-|]
+helpWidget view = do { Text.Hamlet.maybeH
+ (fvTooltip view)
-+ (\ tt_a2d5x
++ (\ tt_as0k
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<span class=\"help-block\">");
-+ (asWidgetT . toWidget) (toHtml tt_a2d5x);
++ (asWidgetT . toWidget) (toHtml tt_as0k);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") })
+ Nothing;
+ Text.Hamlet.maybeH
+ (fvErrors view)
-+ (\ err_a2d5y
++ (\ err_as0l
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<span class=\"help-block\">");
-+ (asWidgetT . toWidget) (toHtml err_a2d5y);
++ (asWidgetT . toWidget) (toHtml err_as0l);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") })
+ Nothing }
@@ -209,7 +204,7 @@ index 8377a68..fa8b7d4 100644
-- | How the 'bootstrapSubmit' button should be rendered.
-@@ -247,7 +350,23 @@ mbootstrapSubmit
+@@ -244,7 +347,22 @@ mbootstrapSubmit
=> BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
mbootstrapSubmit (BootstrapSubmit msg classes attrs) =
let res = FormSuccess ()
@@ -226,26 +221,40 @@ index 8377a68..fa8b7d4 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) ">");
+ ((liftM (toHtml .) getMessageRender)
-+ >>=
-+ (\ urender_a2d6f -> (asWidgetT . toWidget) (urender_a2d6f msg)));
++ >>= (\ urender_as0w -> (asWidgetT . toWidget) (urender_as0w msg)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</button>") }
+
fv = FieldView { fvLabel = ""
, fvTooltip = Nothing
, fvId = bootstrapSubmitId
-@@ -314,4 +433,4 @@ bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id"
- -- > <$> areq textField nameSettings Nothing
- -- > where nameSettings = withAutofocus $
- -- > withPlaceholder "First name" $
---- > (bfs ("Name" :: Text))
-\ No newline at end of file
-+-- > (bfs ("Name" :: Text))
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
-index 5fe123e..42fd7d6 100644
+index c6091a9..9e6bd4e 100644
--- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs
-@@ -52,8 +52,6 @@ module Yesod.Form.Fields
+@@ -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
@@ -254,7 +263,7 @@ index 5fe123e..42fd7d6 100644
, optionsPairs
, optionsEnum
) where
-@@ -80,6 +78,15 @@ import Control.Monad (when, unless)
+@@ -72,6 +64,15 @@ import Control.Monad (when, unless)
import Data.Either (partitionEithers)
import Data.Maybe (listToMaybe, fromMaybe)
@@ -270,7 +279,14 @@ index 5fe123e..42fd7d6 100644
import qualified Blaze.ByteString.Builder.Html.Utf8 as B
import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
-@@ -102,8 +109,6 @@ import Control.Applicative ((<$>), (<|>))
+@@ -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)
@@ -279,7 +295,7 @@ index 5fe123e..42fd7d6 100644
defaultFormMessage :: FormMessage -> Text
defaultFormMessage = englishFormMessage
-@@ -115,10 +120,25 @@ intField = Field
+@@ -111,10 +109,25 @@ intField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s
@@ -287,7 +303,7 @@ index 5fe123e..42fd7d6 100644
-$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_a2nCq
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJh
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
@@ -309,7 +325,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
where
-@@ -133,10 +153,25 @@ doubleField = Field
+@@ -128,10 +141,25 @@ doubleField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidNumber s
@@ -317,7 +333,7 @@ index 5fe123e..42fd7d6 100644
-$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_a2nCV
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJu
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
@@ -339,7 +355,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
-@@ -147,10 +182,24 @@ $newline never
+@@ -139,10 +167,24 @@ $newline never
dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day
dayField = Field
{ fieldParse = parseHelper $ parseDate . unpack
@@ -347,7 +363,7 @@ index 5fe123e..42fd7d6 100644
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
-|]
-+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nDh
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJJF
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
@@ -368,22 +384,20 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
-@@ -179,10 +228,25 @@ timeFieldTypeText = timeFieldOfType "text"
- timeFieldOfType :: Monad m => RenderMessage (HandlerSite m) FormMessage => Text -> Field m TimeOfDay
- timeFieldOfType inputType = Field
+@@ -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} type="#{inputType}" :isReq:required="" value="#{showVal val}">
+-<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
-|]
-+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nDN
++ , 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) "\" type=\"");
-+ id (toHtml inputType);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(isReq,
@@ -398,7 +412,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
where
-@@ -196,10 +260,23 @@ $newline never
+@@ -166,10 +221,23 @@ $newline never
htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html
htmlField = Field
{ fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
@@ -406,7 +420,7 @@ index 5fe123e..42fd7d6 100644
-$newline never
-<textarea :isReq:required="" id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
-|]
-+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nEc
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJK4
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea");
+ condH
@@ -426,25 +440,21 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . renderHtml)
-@@ -231,10 +308,22 @@ instance ToHtml Textarea where
+@@ -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|
+- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
-$newline never
--<textarea id="#{theId}" name="#{name}" :isReq:required="" *{attrs}>#{either id unTextarea val}
+-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
-|]
-+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nEL
++ , 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) "\"");
-+ condH
-+ [(isReq,
-+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
-+ Nothing;
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ id (toHtml (either id unTextarea val));
@@ -453,7 +463,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
-@@ -243,10 +332,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
+@@ -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
@@ -461,7 +471,7 @@ index 5fe123e..42fd7d6 100644
-$newline never
-<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">
-|]
-+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_a2nFl
++ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_aJKo
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"hidden\" id=\"");
@@ -477,7 +487,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
-@@ -255,20 +353,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
+@@ -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 ->
@@ -509,7 +519,7 @@ index 5fe123e..42fd7d6 100644
+
, fieldEnctype = UrlEncoded
}
- -- | Creates an input with @type="password"@.
+
passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
passwordField = Field
{ fieldParse = parseHelper $ Right
@@ -517,7 +527,7 @@ index 5fe123e..42fd7d6 100644
-$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_a2nG7
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJKH
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
@@ -539,7 +549,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
-@@ -342,10 +473,24 @@ emailField = Field
+@@ -304,10 +422,24 @@ emailField = Field
case Email.canonicalizeEmail $ encodeUtf8 s of
Just e -> Right $ decodeUtf8With lenientDecode e
Nothing -> Left $ MsgInvalidEmail s
@@ -547,7 +557,7 @@ index 5fe123e..42fd7d6 100644
-$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_a2nKu
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJLq
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
@@ -568,7 +578,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
-@@ -360,10 +505,25 @@ multiEmailField = Field
+@@ -322,10 +454,25 @@ multiEmailField = Field
in case partitionEithers addrs of
([], good) -> Right good
(bad, _) -> Left $ MsgInvalidEmail $ cat bad
@@ -576,7 +586,7 @@ index 5fe123e..42fd7d6 100644
-$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_a2nL5
++ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_aJMd
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
@@ -598,7 +608,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
where
-@@ -380,20 +540,74 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus
+@@ -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
@@ -651,31 +661,32 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "').focus();}</script>") }
+
-+ toWidget $ \ _render_a2nMA
-+ -> (Text.Css.CssNoWhitespace . (foldr ($) []))
++ 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.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.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 [])
@@ -684,8 +695,8 @@ index 5fe123e..42fd7d6 100644
+
, fieldEnctype = UrlEncoded
}
- -- | Creates an input with @type="url"@, validating the URL according to RFC3986.
-@@ -404,7 +618,28 @@ urlField = Field
+
+@@ -365,7 +567,28 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s
, fieldView = \theId name attrs val isReq ->
@@ -715,7 +726,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
-@@ -423,18 +658,54 @@ selectField :: (Eq a, RenderMessage site FormMessage)
+@@ -378,18 +601,54 @@ selectField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a
selectField = selectFieldHelper
@@ -758,8 +769,8 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
-+ (\ urender_a2nOk
-+ -> (asWidgetT . toWidget) (urender_a2nOk MsgSelectNone)));
++ (\ urender_aJMX
++ -> (asWidgetT . toWidget) (urender_aJMX MsgSelectNone)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
+ -- onOpt
@@ -780,9 +791,9 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
+ -- inside
- -- | Creates a @\<select>@ tag for selecting multiple options.
multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
-@@ -459,11 +730,45 @@ multiSelectField ioptlist =
+ => [(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
@@ -810,20 +821,20 @@ index 5fe123e..42fd7d6 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ Data.Foldable.mapM_
-+ (\ (opt_a2nPy, optsel_a2nPz)
++ (\ (opt_aJNs, optsel_aJNt)
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");
-+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_a2nPy));
++ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_aJNs));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
-+ [(optsel_a2nPz,
++ [(optsel_aJNt,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
-+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_a2nPy));
++ (asWidgetT . toWidget) (toHtml (optionDisplay opt_aJNs));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
+ selOpts;
@@ -833,7 +844,7 @@ index 5fe123e..42fd7d6 100644
where
optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
-@@ -489,37 +794,115 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
+@@ -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
@@ -850,25 +861,25 @@ index 5fe123e..42fd7d6 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ Data.Foldable.mapM_
-+ (\ opt_a2nQo
++ (\ 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_a2nQo));
++ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_aJNI));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
-+ [(optselected val opt_a2nQo,
++ [(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_a2nQo));
++ (asWidgetT . toWidget) (toHtml (optionDisplay opt_aJNI));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })
+ opts;
@@ -876,7 +887,7 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }
+
}
- -- | Creates an input with @type="radio"@ for selecting one option.
+
radioField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a
@@ -931,8 +942,8 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
-+ (\ urender_a2nR7
-+ -> (asWidgetT . toWidget) (urender_a2nR7 MsgSelectNone)));
++ (\ urender_aJNY
++ -> (asWidgetT . toWidget) (urender_aJNY MsgSelectNone)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })
+
@@ -972,9 +983,6 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })
+
- -- | Creates a group of radio buttons to answer the question given in the message. Radio buttons are used to allow differentiating between an empty response (@Nothing@) and a no response (@Just False@). Consider using the simpler 'checkBoxField' if you don't need to make this distinction.
- --
-@@ -531,19 +914,83 @@ $newline never
boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
boolField = Field
{ fieldParse = \e _ -> return $ boolParser e
@@ -984,9 +992,6 @@ index 5fe123e..42fd7d6 100644
- <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
- <label for=#{theId}-none>_{MsgSelectNone}
-
--
--<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
--<label for=#{theId}-yes>_{MsgBoolYes}
+ , fieldView = \theId name attrs val isReq -> do { condH
+ [(not isReq,
+ do { (asWidgetT . toWidget)
@@ -1007,8 +1012,8 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) "-none\">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
-+ (\ urender_a2nSk
-+ -> (asWidgetT . toWidget) (urender_a2nSk MsgSelectNone)));
++ (\ urender_aJOn
++ -> (asWidgetT . toWidget) (urender_aJOn MsgSelectNone)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]
+ Nothing;
@@ -1034,8 +1039,8 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
-+ (\ urender_a2nSl
-+ -> (asWidgetT . toWidget) (urender_a2nSl MsgBoolYes)));
++ (\ urender_aJOo
++ -> (asWidgetT . toWidget) (urender_aJOo MsgBoolYes)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "</label><input id=\"");
@@ -1059,18 +1064,21 @@ index 5fe123e..42fd7d6 100644
+ ((Text.Blaze.Internal.preEscapedText . pack) "-no\">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
-+ (\ urender_a2nSm
-+ -> (asWidgetT . toWidget) (urender_a2nSm MsgBoolNo)));
++ (\ 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
-@@ -570,10 +1017,24 @@ $newline never
+@@ -512,10 +947,24 @@ $newline never
checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
checkBoxField = Field
{ fieldParse = \e _ -> return $ checkBoxParser e
@@ -1099,31 +1107,25 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = UrlEncoded
}
-@@ -619,66 +1080,6 @@ optionsPairs opts = do
+@@ -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]
---- | Selects a list of 'Entity's with the given 'Filter' and 'SelectOpt's. The @(a -> msg)@ function is then used to derive the display value for an 'OptionList'. Example usage:
----
---- > Country
---- > name Text
---- > deriving Eq -- Must derive Eq
----
---- > data CountryForm = CountryForm
---- > { country :: Entity Country
---- > }
---- >
---- > countryNameForm :: AForm Handler CountryForm
---- > countryNameForm = CountryForm
---- > <$> areq (selectField countries) "Which country do you live in?" Nothing
---- > where
---- > countries = optionsPersist [] [Asc CountryName] countryName
+-#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)
@@ -1137,10 +1139,11 @@ index 5fe123e..42fd7d6 100644
- , optionExternalValue = toPathPiece key
- }) pairs
-
---- | An alternative to 'optionsPersist' which returns just the 'Key' instead of
---- the entire 'Entity'.
+--- | 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
@@ -1149,6 +1152,15 @@ index 5fe123e..42fd7d6 100644
- , 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)
@@ -1162,18 +1174,17 @@ index 5fe123e..42fd7d6 100644
- , optionInternalValue = key
- , optionExternalValue = toPathPiece key
- }) pairs
--
+
selectFieldHelper
:: (Eq a, RenderMessage site FormMessage)
- => (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ())
-@@ -722,9 +1123,21 @@ fileField = Field
+@@ -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_a2nUV
++ , fieldView = \id' name attrs _ isReq -> toWidget $ \ _render_aJPt
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml id');
@@ -1191,7 +1202,7 @@ index 5fe123e..42fd7d6 100644
, fieldEnctype = Multipart
}
-@@ -751,10 +1164,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
+@@ -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'
@@ -1215,7 +1226,7 @@ index 5fe123e..42fd7d6 100644
, fvErrors = errs
, fvRequired = True
}
-@@ -783,10 +1205,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
+@@ -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'
@@ -1240,26 +1251,28 @@ index 5fe123e..42fd7d6 100644
, fvRequired = False
}
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
-index 0d83b79..61e9b66 100644
+index 9e6abaf..0c2a0ce 100644
--- a/Yesod/Form/Functions.hs
+++ b/Yesod/Form/Functions.hs
-@@ -60,12 +60,14 @@ import Text.Blaze (Markup, toMarkup)
+@@ -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.Hamlet
+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 +219,14 @@ postHelper form env = do
+@@ -217,7 +221,14 @@ postHelper form env = do
let token =
case reqToken req of
Nothing -> mempty
@@ -1275,7 +1288,7 @@ index 0d83b79..61e9b66 100644
m <- getYesod
langs <- languages
((res, xml), enctype) <- runFormGeneric (form token) m langs env
-@@ -298,7 +307,12 @@ getHelper :: MonadHandler m
+@@ -297,7 +308,12 @@ getHelper :: MonadHandler m
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
getHelper form env = do
@@ -1289,7 +1302,7 @@ index 0d83b79..61e9b66 100644
langs <- languages
m <- getYesod
runFormGeneric (form fragment) m langs env
-@@ -333,10 +347,15 @@ identifyForm
+@@ -332,10 +348,15 @@ identifyForm
identifyForm identVal form = \fragment -> do
-- Create hidden <input>.
let fragment' =
@@ -1309,7 +1322,7 @@ index 0d83b79..61e9b66 100644
-- Check if we got its value back.
mp <- askParams
-@@ -366,22 +385,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
+@@ -365,22 +386,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
renderTable aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
@@ -1332,20 +1345,20 @@ index 0d83b79..61e9b66 100644
+ let widget = do { Text.Hamlet.condH
+ [(null views, (asWidgetT . toWidget) (toHtml fragment))] Nothing;
+ Data.Foldable.mapM_
-+ (\ (isFirst_aNqW, view_aNqX)
++ (\ (isFirst_ab5u, view_ab5v)
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<tr");
+ Text.Hamlet.condH
-+ [(or [fvRequired view_aNqX, not (fvRequired view_aNqX)],
++ [(or [fvRequired view_ab5v, not (fvRequired view_ab5v)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");
+ Text.Hamlet.condH
-+ [(fvRequired view_aNqX,
++ [(fvRequired view_ab5v,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(not (fvRequired view_aNqX),
++ [(not (fvRequired view_ab5v),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]
+ Nothing;
@@ -1355,37 +1368,37 @@ index 0d83b79..61e9b66 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "><td>");
+ Text.Hamlet.condH
-+ [(isFirst_aNqW, (asWidgetT . toWidget) (toHtml fragment))] Nothing;
++ [(isFirst_ab5u, (asWidgetT . toWidget) (toHtml fragment))] Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_aNqX));
++ (asWidgetT . toWidget) (toHtml (fvId view_ab5v));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_aNqX));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5v));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>");
+ Text.Hamlet.maybeH
-+ (fvTooltip view_aNqX)
-+ (\ tt_aNqY
++ (fvTooltip view_ab5v)
++ (\ tt_ab5w
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"tooltip\">");
-+ (asWidgetT . toWidget) (toHtml tt_aNqY);
++ (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_aNqX);
++ (asWidgetT . toWidget) (fvInput view_ab5v);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>");
+ Text.Hamlet.maybeH
-+ (fvErrors view_aNqX)
-+ (\ err_aNqZ
++ (fvErrors view_ab5v)
++ (\ err_ab5x
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<td class=\"errors\">");
-+ (asWidgetT . toWidget) (toHtml err_aNqZ);
++ (asWidgetT . toWidget) (toHtml err_ab5x);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>") })
+ Nothing;
@@ -1396,7 +1409,7 @@ index 0d83b79..61e9b66 100644
return (res, widget)
where
addIsFirst [] = []
-@@ -397,19 +464,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
+@@ -396,19 +465,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
renderDivsMaybeLabels withLabels aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
@@ -1415,20 +1428,20 @@ index 0d83b79..61e9b66 100644
-|]
+ let widget = do { (asWidgetT . toWidget) (toHtml fragment);
+ Data.Foldable.mapM_
-+ (\ view_aNsz
++ (\ view_ab5K
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<div");
+ Text.Hamlet.condH
-+ [(or [fvRequired view_aNsz, not (fvRequired view_aNsz)],
++ [(or [fvRequired view_ab5K, not (fvRequired view_ab5K)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");
+ Text.Hamlet.condH
-+ [(fvRequired view_aNsz,
++ [(fvRequired view_ab5K,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(not (fvRequired view_aNsz),
++ [(not (fvRequired view_ab5K),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]
+ Nothing;
@@ -1441,31 +1454,31 @@ index 0d83b79..61e9b66 100644
+ [(withLabels,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_aNsz));
++ (asWidgetT . toWidget) (toHtml (fvId view_ab5K));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_aNsz));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5K));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]
+ Nothing;
+ Text.Hamlet.maybeH
-+ (fvTooltip view_aNsz)
-+ (\ tt_aNsL
++ (fvTooltip view_ab5K)
++ (\ tt_ab5L
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"tooltip\">");
-+ (asWidgetT . toWidget) (toHtml tt_aNsL);
++ (asWidgetT . toWidget) (toHtml tt_ab5L);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+ Nothing;
-+ (asWidgetT . toWidget) (fvInput view_aNsz);
++ (asWidgetT . toWidget) (fvInput view_ab5K);
+ Text.Hamlet.maybeH
-+ (fvErrors view_aNsz)
-+ (\ err_aNsP
++ (fvErrors view_ab5K)
++ (\ err_ab5M
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"errors\">");
-+ (asWidgetT . toWidget) (toHtml err_aNsP);
++ (asWidgetT . toWidget) (toHtml err_ab5M);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+ Nothing;
@@ -1476,7 +1489,7 @@ index 0d83b79..61e9b66 100644
return (res, widget)
-- | Render a form using Bootstrap v2-friendly shamlet syntax.
-@@ -437,19 +551,62 @@ renderBootstrap2 aform fragment = do
+@@ -436,19 +552,62 @@ renderBootstrap2 aform fragment = do
let views = views' []
has (Just _) = True
has Nothing = False
@@ -1495,53 +1508,53 @@ index 0d83b79..61e9b66 100644
- |]
+ let widget = do { (asWidgetT . toWidget) (toHtml fragment);
+ Data.Foldable.mapM_
-+ (\ view_aNw8
++ (\ view_ab5Y
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"control-group clearfix ");
+ Text.Hamlet.condH
-+ [(fvRequired view_aNw8,
++ [(fvRequired view_ab5Y,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(not (fvRequired view_aNw8),
++ [(not (fvRequired view_ab5Y),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(has (fvErrors view_aNw8),
++ [(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_aNw8));
++ (asWidgetT . toWidget) (toHtml (fvId view_ab5Y));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_aNw8));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_ab5Y));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "</label><div class=\"controls input\">");
-+ (asWidgetT . toWidget) (fvInput view_aNw8);
++ (asWidgetT . toWidget) (fvInput view_ab5Y);
+ Text.Hamlet.maybeH
-+ (fvTooltip view_aNw8)
-+ (\ tt_aNw9
++ (fvTooltip view_ab5Y)
++ (\ tt_ab5Z
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<span class=\"help-block\">");
-+ (asWidgetT . toWidget) (toHtml tt_aNw9);
++ (asWidgetT . toWidget) (toHtml tt_ab5Z);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })
+ Nothing;
+ Text.Hamlet.maybeH
-+ (fvErrors view_aNw8)
-+ (\ err_aNwa
++ (fvErrors view_ab5Y)
++ (\ err_ab60
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<span class=\"help-block\">");
-+ (asWidgetT . toWidget) (toHtml err_aNwa);
++ (asWidgetT . toWidget) (toHtml err_ab60);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })
+ Nothing;
@@ -1553,15 +1566,16 @@ index 0d83b79..61e9b66 100644
-- | Deprecated synonym for 'renderBootstrap2'.
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
-index 63e3d57..47503c2 100644
+index 362eb8a..1df9966 100644
--- a/Yesod/Form/Jquery.hs
+++ b/Yesod/Form/Jquery.hs
-@@ -18,11 +18,23 @@ import Yesod.Core
+@@ -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)
@@ -1577,27 +1591,25 @@ index 63e3d57..47503c2 100644
+import qualified Text.Julius
+import qualified Data.Text.Lazy.Builder
+import qualified Text.Shakespeare
-+import qualified Data.Text.Lazy.Builder as Data.Text.Internal.Builder
+
-- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
googleHostedJqueryUiCss :: Text -> Text
googleHostedJqueryUiCss theme = mconcat
-@@ -71,27 +83,54 @@ jqueryDayField' jds inputType = Field
+@@ -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="#{inputType}" :isReq:required="" value="#{showVal val}">
+-<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=\"");
-+ id (toHtml inputType);
-+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
++ id
++ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");
+ Text.Hamlet.condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
@@ -1626,36 +1638,42 @@ index 63e3d57..47503c2 100644
-});
-|]
+ toWidget $ Text.Julius.asJavascriptUrl
-+ (\ _render_a3iGM
++ (\ _render_a2l4S
+ -> mconcat
+ [Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ "\n\n$(function(){\n\n var i = document.getElementById(\""),
++ ((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.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ "\");\n\n if (i.type != \"date\") {\n\n $(i).datepicker({\n\n dateFormat:'yy-mm-dd',\n\n changeMonth:"),
++ ((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.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ ",\n\n changeYear:"),
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
++ ",\n changeYear:"),
+ Text.Julius.toJavascript (jsBool (jdsChangeYear jds)),
+ Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ ",\n\n numberOfMonths:"),
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
++ ",\n numberOfMonths:"),
+ Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds))),
+ Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ ",\n\n yearRange:"),
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
++ ",\n yearRange:"),
+ Text.Julius.toJavascript (toJSON (jdsYearRange jds)),
+ Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ "\n\n });\n\n }\n\n});")])
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
++ "\n });\n }\n});")])
+
, fieldEnctype = UrlEncoded
}
where
-@@ -118,16 +157,47 @@ jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
+@@ -108,16 +152,52 @@ jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
jqueryAutocompleteField' minLen src = Field
{ fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq -> do
@@ -1688,35 +1706,40 @@ index 63e3d57..47503c2 100644
-$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJSON minLen}})});
-|]
+ toWidget $ Text.Julius.asJavascriptUrl
-+ (\ _render_a3iHO
++ (\ _render_a2l58
+ -> mconcat
+ [Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ "\n\n$(function(){$(\"#"),
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
++ "\n$(function(){$(\"#"),
+ Text.Julius.toJavascript (rawJS theId),
+ Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
+ "\").autocomplete({source:\""),
+ Text.Julius.Javascript
-+ (Data.Text.Internal.Builder.fromText (_render_a3iHO src [])),
++ (Data.Text.Lazy.Builder.fromText
++ (_render_a2l58 src [])),
+ Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
+ "\",minLength:"),
+ Text.Julius.toJavascript (toJSON minLen),
+ Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
+ "})});")])
+
, fieldEnctype = UrlEncoded
}
diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs
-index a2b434d..29b45b5 100644
+index a2b434d..75eb484 100644
--- a/Yesod/Form/MassInput.hs
+++ b/Yesod/Form/MassInput.hs
-@@ -22,6 +22,16 @@ import Data.Traversable (sequenceA)
- import qualified Data.Map as Map
- import Data.Maybe (listToMaybe)
+@@ -9,6 +9,16 @@ module Yesod.Form.MassInput
+ , massTable
+ ) where
+import qualified Data.Text
+import qualified Text.Blaze as Text.Blaze.Internal
@@ -1728,9 +1751,9 @@ index a2b434d..29b45b5 100644
+import qualified Data.Foldable
+import qualified Control.Monad
+
- down :: Monad m => Int -> MForm m ()
- down 0 = return ()
- down i | i < 0 = error "called down with a negative number"
+ 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
@@ -1749,7 +1772,7 @@ index a2b434d..29b45b5 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>");
+ Data.Foldable.mapM_
-+ (\ xml_a3hPg -> (asWidgetT . toWidget) xml_a3hPg) xmls;
++ (\ xml_a1yM1 -> (asWidgetT . toWidget) xml_a1yM1) xmls;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<input class=\"count\" type=\"hidden\" name=\"");
@@ -1806,27 +1829,27 @@ index a2b434d..29b45b5 100644
- <div .errors>#{err}
-|]
+massDivs viewss = Data.Foldable.mapM_
-+ (\ views_a3hPz
++ (\ views_a1yMm
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<fieldset>");
+ Data.Foldable.mapM_
-+ (\ view_a3hPA
++ (\ view_a1yMn
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div");
+ Text.Hamlet.condH
-+ [(or [fvRequired view_a3hPA, not (fvRequired view_a3hPA)],
++ [(or [fvRequired view_a1yMn, not (fvRequired view_a1yMn)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ " class=\"");
+ Text.Hamlet.condH
-+ [(fvRequired view_a3hPA,
++ [(fvRequired view_a1yMn,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "required "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(not (fvRequired view_a3hPA),
++ [(not (fvRequired view_a1yMn),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "optional"))]
@@ -1838,38 +1861,38 @@ index a2b434d..29b45b5 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "><label for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_a3hPA));
++ (asWidgetT . toWidget) (toHtml (fvId view_a1yMn));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_a3hPA));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_a1yMn));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");
+ Text.Hamlet.maybeH
-+ (fvTooltip view_a3hPA)
-+ (\ tt_a3hPB
++ (fvTooltip view_a1yMn)
++ (\ tt_a1yMo
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<div class=\"tooltip\">");
-+ (asWidgetT . toWidget) (toHtml tt_a3hPB);
++ (asWidgetT . toWidget) (toHtml tt_a1yMo);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</div>") })
+ Nothing;
-+ (asWidgetT . toWidget) (fvInput view_a3hPA);
++ (asWidgetT . toWidget) (fvInput view_a1yMn);
+ Text.Hamlet.maybeH
-+ (fvErrors view_a3hPA)
-+ (\ err_a3hPC
++ (fvErrors view_a1yMn)
++ (\ err_a1yMp
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<div class=\"errors\">");
-+ (asWidgetT . toWidget) (toHtml err_a3hPC);
++ (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_a3hPz;
++ views_a1yMm;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</fieldset>") })
@@ -1877,27 +1900,27 @@ index a2b434d..29b45b5 100644
+
+
+massTable viewss = Data.Foldable.mapM_
-+ (\ views_a3hPH
++ (\ views_a1yMv
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<fieldset><table>");
+ Data.Foldable.mapM_
-+ (\ view_a3hPI
++ (\ view_a1yMw
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr");
+ Text.Hamlet.condH
-+ [(or [fvRequired view_a3hPI, not (fvRequired view_a3hPI)],
++ [(or [fvRequired view_a1yMw, not (fvRequired view_a1yMw)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ " class=\"");
+ Text.Hamlet.condH
-+ [(fvRequired view_a3hPI,
++ [(fvRequired view_a1yMw,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "required "))]
+ Nothing;
+ Text.Hamlet.condH
-+ [(not (fvRequired view_a3hPI),
++ [(not (fvRequired view_a1yMw),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "optional"))]
@@ -1909,19 +1932,19 @@ index a2b434d..29b45b5 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "><td><label for=\"");
-+ (asWidgetT . toWidget) (toHtml (fvId view_a3hPI));
++ (asWidgetT . toWidget) (toHtml (fvId view_a1yMw));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");
-+ (asWidgetT . toWidget) (toHtml (fvLabel view_a3hPI));
++ (asWidgetT . toWidget) (toHtml (fvLabel view_a1yMw));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");
+ Text.Hamlet.maybeH
-+ (fvTooltip view_a3hPI)
-+ (\ tt_a3hPJ
++ (fvTooltip view_a1yMw)
++ (\ tt_a1yMx
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<div class=\"tooltip\">");
-+ (asWidgetT . toWidget) (toHtml tt_a3hPJ);
++ (asWidgetT . toWidget) (toHtml tt_a1yMx);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</div>") })
@@ -1929,23 +1952,23 @@ index a2b434d..29b45b5 100644
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</td><td>");
-+ (asWidgetT . toWidget) (fvInput view_a3hPI);
++ (asWidgetT . toWidget) (fvInput view_a1yMw);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>");
+ Text.Hamlet.maybeH
-+ (fvErrors view_a3hPI)
-+ (\ err_a3hPK
++ (fvErrors view_a1yMw)
++ (\ err_a1yMy
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<td class=\"errors\">");
-+ (asWidgetT . toWidget) (toHtml err_a3hPK);
++ (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_a3hPH;
++ views_a1yMv;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</table></fieldset>") })
@@ -1967,19 +1990,12 @@ index a2b434d..29b45b5 100644
- <td .errors>#{err}
-|]
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
-index 2862678..a773553 100644
+index 7e4af07..b59745a 100644
--- a/Yesod/Form/Nic.hs
+++ b/Yesod/Form/Nic.hs
-@@ -12,12 +12,24 @@ module Yesod.Form.Nic
- 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)
+@@ -9,11 +9,22 @@ module Yesod.Form.Nic
+ , nicHtmlField
+ ) where
+import qualified Text.Blaze as Text.Blaze.Internal
+import qualified Text.Blaze.Internal
@@ -1991,19 +2007,24 @@ index 2862678..a773553 100644
+import qualified Control.Monad
+import qualified Text.Julius
+import qualified Data.Text.Lazy.Builder
-+import qualified Data.Text.Lazy.Builder as Data.Text.Internal.Builder
+import qualified Text.Shakespeare
+
- class Yesod a => YesodNic a where
- -- | NIC Editor Javascript file.
- urlNicEdit :: a -> Either (Route a) Text
-@@ -27,20 +39,44 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html
+ 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
+ , fieldView = \theId name attrs val isReq -> do
- toWidget [shamlet|
-$newline never
-- <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
+- <textarea id="#{theId}" *{attrs} name="#{name}" :isReq:required .html>#{showVal val}
-|]
+ toWidget $ do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
@@ -2012,6 +2033,10 @@ index 2862678..a773553 100644
+ 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));
@@ -2028,43 +2053,34 @@ index 2862678..a773553 100644
-(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();
-|]
+ BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl
-+ (\ _render_a3hYy
++ (\ _render_a2rMh
+ -> Data.Monoid.mconcat
+ [Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ "\n\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""),
++ ((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.Internal.Builder.fromText . Text.Shakespeare.pack')
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
+ "\")});")])
+
+ _ -> Text.Julius.asJavascriptUrl
-+ (\ _render_a3i1Q
++ (\ _render_a2rMm
+ -> Data.Monoid.mconcat
+ [Text.Julius.Javascript
-+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
-+ "\n\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""),
++ ((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.Internal.Builder.fromText . Text.Shakespeare.pack')
++ ((Data.Text.Lazy.Builder.fromText
++ . Text.Shakespeare.pack')
+ "\")})();")])
+
, fieldEnctype = UrlEncoded
}
where
-diff --git a/yesod-form.cabal b/yesod-form.cabal
-index 7849763..9694fe1 100644
---- a/yesod-form.cabal
-+++ b/yesod-form.cabal
-@@ -23,7 +23,7 @@ library
- , yesod-core >= 1.4 && < 1.5
- , yesod-persistent >= 1.4 && < 1.5
- , time >= 1.1.4
-- , shakespeare >= 2.0
-+ , shakespeare >= 2.0.5
- , persistent
- , template-haskell
- , transformers >= 0.2.2
--
-2.1.4
+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
index 1b850d282..76aad4e34 100644
--- 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
@@ -1,6 +1,6 @@
-From 4d8650bd806f50aa2538270f80fa93261c43d056 Mon Sep 17 00:00:00 2001
+From e82ed4e6fd7b5ea6dbe474b5de2755ec5794161c Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 00:12:02 +0000
+Date: Thu, 16 Oct 2014 02:23:50 +0000
Subject: [PATCH] stub out
---
@@ -8,16 +8,16 @@ Subject: [PATCH] stub out
1 file changed, 10 deletions(-)
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
-index c3bc1bf..1727dba 100644
+index b116f3a..017b184 100644
--- a/yesod-persistent.cabal
+++ b/yesod-persistent.cabal
-@@ -15,16 +15,6 @@ extra-source-files: README.md ChangeLog.md
+@@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod.
library
build-depends: base >= 4 && < 5
-- , yesod-core >= 1.4.0 && < 1.5
-- , persistent >= 2.1 && < 2.2
-- , persistent-template >= 2.1 && < 2.2
+- , 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
@@ -29,5 +29,5 @@ index c3bc1bf..1727dba 100644
test-suite test
--
-2.1.4
+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
new file mode 100644
index 000000000..99d6c9025
--- /dev/null
+++ b/standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch
@@ -0,0 +1,170 @@
+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
index 20e47b5dd..46e4b654c 100644
--- a/standalone/no-th/haskell-patches/yesod-static_hack.patch
+++ b/standalone/no-th/haskell-patches/yesod-static_hack.patch
@@ -1,6 +1,6 @@
-From 09d7340ff4c9b43f7c8c2ad6529a6c60871d265f Mon Sep 17 00:00:00 2001
+From 606c5f4f4b2d476d274907eb2bb8c12b60fc451f Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 01:39:14 +0000
+Date: Wed, 21 May 2014 04:43:30 +0000
Subject: [PATCH] remove TH
---
@@ -31,7 +31,7 @@ index 08febb9..e3a6d51 100644
-- | 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 a18d88e..afb1cda 100644
+index 725ebf4..33eaffd 100644
--- a/Yesod/Static.hs
+++ b/Yesod/Static.hs
@@ -37,8 +37,8 @@ module Yesod.Static
@@ -99,7 +99,7 @@ index a18d88e..afb1cda 100644
@@ -267,7 +270,7 @@ staticFilesList dir fs =
-- see if their copy is up-to-date.
publicFiles :: Prelude.FilePath -> Q [Dec]
- publicFiles dir = mkStaticFiles' dir False
+ publicFiles dir = mkStaticFiles' dir "StaticRoute" False
-
+-}
@@ -111,17 +111,17 @@ index a18d88e..afb1cda 100644
+{-
mkStaticFiles :: Prelude.FilePath -> Q [Dec]
- mkStaticFiles fp = mkStaticFiles' fp True
+ mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
-@@ -354,6 +358,7 @@ mkStaticFilesList fp fs makeHash = do
- [ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) []
+@@ -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
-@@ -392,7 +397,7 @@ base64 = map tr
+@@ -395,7 +400,7 @@ base64 = map tr
-- single static file at compile time.
data CombineType = JS | CSS
@@ -130,7 +130,7 @@ index a18d88e..afb1cda 100644
combineStatics' :: CombineType
-> CombineSettings
-> [Route Static] -- ^ files to combine
-@@ -426,7 +431,7 @@ combineStatics' combineType CombineSettings {..} routes = do
+@@ -429,7 +434,7 @@ combineStatics' combineType CombineSettings {..} routes = do
case combineType of
JS -> "js"
CSS -> "css"
@@ -139,7 +139,7 @@ index a18d88e..afb1cda 100644
-- | Data type for holding all settings for combining files.
--
-- This data type is a settings type. For more information, see:
-@@ -502,6 +507,7 @@ instance Default CombineSettings where
+@@ -505,6 +510,7 @@ instance Default CombineSettings where
errorIntro :: [FilePath] -> [Char] -> [Char]
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
@@ -147,7 +147,7 @@ index a18d88e..afb1cda 100644
liftRoutes :: [Route Static] -> Q Exp
liftRoutes =
fmap ListE . mapM go
-@@ -548,4 +554,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
+@@ -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) |]
@@ -155,18 +155,18 @@ index a18d88e..afb1cda 100644
+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a
+-}
diff --git a/yesod-static.cabal b/yesod-static.cabal
-index 4ccb0d7..8758aaa 100644
+index 2582a95..5df03b3 100644
--- a/yesod-static.cabal
+++ b/yesod-static.cabal
-@@ -50,7 +50,6 @@ library
- , system-fileio >= 0.3
+@@ -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
-@@ -63,13 +62,6 @@ library
+@@ -62,13 +61,6 @@ library
, hashable >= 1.1
exposed-modules: Yesod.Static
@@ -181,13 +181,13 @@ index 4ccb0d7..8758aaa 100644
ghc-options: -Wall
extensions: TemplateHaskell
@@ -108,7 +100,6 @@ test-suite tests
- , system-fileio
, data-default
+ , shakespeare-css
, mime-types
- , hjsmin
, filepath
, resourcet
, unordered-containers
--
-2.1.4
+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
index 1365b277d..ebf8a786b 100644
--- a/standalone/no-th/haskell-patches/yesod_hack-TH.patch
+++ b/standalone/no-th/haskell-patches/yesod_hack-TH.patch
@@ -1,13 +1,13 @@
-From 86e7cf433fcd3386893556d690748781f46d3f03 Mon Sep 17 00:00:00 2001
+From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
-Date: Fri, 3 Jul 2015 01:33:03 +0000
+Date: Thu, 16 Oct 2014 02:36:37 +0000
Subject: [PATCH] hack TH
---
Yesod.hs | 19 ++++++++++++--
- Yesod/Default/Main.hs | 28 +--------------------
- Yesod/Default/Util.hs | 68 ++-------------------------------------------------
- 3 files changed, 20 insertions(+), 95 deletions(-)
+ 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
@@ -41,7 +41,7 @@ index b367144..fbe309c 100644
+insert = undefined
+
diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs
-index 2694825..5a5fbb9 100644
+index 565ed35..bf46642 100644
--- a/Yesod/Default/Main.hs
+++ b/Yesod/Default/Main.hs
@@ -1,10 +1,8 @@
@@ -64,7 +64,7 @@ index 2694825..5a5fbb9 100644
import System.Log.FastLogger (LogStr, toLogStr)
import Language.Haskell.TH.Syntax (qLocation)
-@@ -56,30 +54,6 @@ defaultMain load getApp = do
+@@ -55,33 +53,6 @@ defaultMain load getApp = do
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
@@ -79,24 +79,27 @@ index 2694825..5a5fbb9 100644
-defaultMainLog load getApp = do
- config <- load
- (app, logFunc) <- getApp config
-- runSettings
-- ( setPort (appPort config)
-- $ setHost (appHost config)
-- $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc
+- 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))
-- $ defaultSettings
-- ) app
+- (toLogStr $ "Exception from Warp: " ++ show e)
+- } app
- where
-- shouldLog' = Warp.defaultShouldDisplayException
--
+- 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 488312a..5476b54 100644
+index a10358e..0547424 100644
--- a/Yesod/Default/Util.hs
+++ b/Yesod/Default/Util.hs
@@ -5,10 +5,9 @@
@@ -122,7 +125,7 @@ index 488312a..5476b54 100644
import Text.Hamlet (HamletSettings, defaultHamletSettings)
import Data.Maybe (catMaybes)
import Data.Default (Default (def))
-@@ -69,68 +65,8 @@ data TemplateLanguage = TemplateLanguage
+@@ -69,68 +65,7 @@ data TemplateLanguage = TemplateLanguage
, tlReload :: FilePath -> Q Exp
}
@@ -140,7 +143,7 @@ index 488312a..5476b54 100644
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
, wfsHamletSettings :: HamletSettings
}
-
+-
-instance Default WidgetFileSettings where
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
-
@@ -159,7 +162,7 @@ index 488312a..5476b54 100644
- , func
- , " on "
- , show file
-- , ", but no templates were found."
+- , ", but no template were found."
- ]
- exps -> return $ DoE $ map NoBindS exps
- where
@@ -192,5 +195,5 @@ index 488312a..5476b54 100644
- else return $ Just ex
- else return Nothing
--
-2.1.4
+2.1.1
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-12 09:10:42 +0000