diff options
Diffstat (limited to 'standalone/no-th')
20 files changed, 1625 insertions, 474 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/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 |