Skip to content
Snippets Groups Projects
Commit 45dbe8a5 authored by Teo Camarasu's avatar Teo Camarasu
Browse files

add some patches

parent a9bd5dab
No related branches found
No related tags found
No related merge requests found
Pipeline #37862 failed
diff --git a/src/Data/Algorithm/DiffOutput.hs b/src/Data/Algorithm/DiffOutput.hs
index b9d39c9..a961efd 100644
--- a/src/Data/Algorithm/DiffOutput.hs
+++ b/src/Data/Algorithm/DiffOutput.hs
@@ -14,7 +14,7 @@ module Data.Algorithm.DiffOutput where
import Data.Algorithm.Diff
import Text.PrettyPrint
import Data.Char
-import Data.List
+import Data.List hiding (length)
import Data.Monoid (mappend)
-- | Converts Diffs to DiffOperations
diff --git a/src/ClassyPrelude.hs b/src/ClassyPrelude.hs
index 3373e08..9886c84 100644
--- a/src/ClassyPrelude.hs
+++ b/src/ClassyPrelude.hs
@@ -47,6 +47,7 @@ module ClassyPrelude
, traceShowM
-- ** Time (since 0.6.1)
, module Data.Time
+ , parseTime
-- ** Generics (since 0.8.1)
, Generic
-- ** Transformers (since 0.9.4)
@@ -190,7 +191,6 @@ import Data.Time
, toGregorian
, fromGregorian
, formatTime
- , parseTime
, parseTimeM
, getCurrentTime
, defaultTimeLocale
@@ -222,6 +222,17 @@ import qualified Control.Concurrent
import GHC.Stack (HasCallStack)
#endif
+import qualified Data.Time as Time
+
+{-# DEPRECATED parseTime "use parseTimeM True instead" #-}
+parseTime :: Time.ParseTime t =>
+ Time.TimeLocale -- ^ Time locale.
+ -> String -- ^ Format string.
+ -> String -- ^ Input string.
+ -> Maybe t -- ^ The time value, or 'Nothing' if the input could
+ -- not be parsed using the given format.
+parseTime = parseTimeM True
+
tshow :: Show a => a -> Text
tshow = fromList . Prelude.show
diff --git a/src/System/Log/Formatter.hs b/src/System/Log/Formatter.hs
index c4c437b..ca8ecd1 100644
--- a/src/System/Log/Formatter.hs
+++ b/src/System/Log/Formatter.hs
@@ -23,7 +23,7 @@ module System.Log.Formatter( LogFormatter
, tfLogFormatter
, varFormatter
) where
-import Data.List
+import Data.List hiding (length)
import Control.Applicative ((<$>))
import Control.Concurrent (myThreadId)
#ifndef mingw32_HOST_OS
diff --git a/Imports.hs b/Imports.hs diff --git a/Imports.hs b/Imports.hs
index 407a131..307d9a2 100644 index 407a131..8897517 100644
--- a/Imports.hs --- a/Imports.hs
+++ b/Imports.hs +++ b/Imports.hs
@@ -22,7 +22,7 @@ import Data.Bits hiding (Bits) @@ -22,7 +22,7 @@ import Data.Bits hiding (Bits)
...@@ -7,7 +7,7 @@ index 407a131..307d9a2 100644 ...@@ -7,7 +7,7 @@ index 407a131..307d9a2 100644
import Data.Foldable import Data.Foldable
import Data.Int import Data.Int
-import Data.List -import Data.List
+import Data.List hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl1, foldl', foldr, foldr1, length, maximum, maximumBy, minimum, minimumBy, notElem, null, or, product, sum) +import Data.List (partition,groupBy)
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Ord import Data.Ord
diff --git a/src/Language/JavaScript/Parser/AST.hs b/src/Language/JavaScript/Parser/AST.hs
index 3230272..dbcf787 100644
--- a/src/Language/JavaScript/Parser/AST.hs
+++ b/src/Language/JavaScript/Parser/AST.hs
@@ -45,7 +45,7 @@ module Language.JavaScript.Parser.AST
) where
import Data.Data
-import Data.List
+import Data.List hiding (null)
import Language.JavaScript.Parser.SrcLocation (TokenPosn (..))
import Language.JavaScript.Parser.Token
diff --git a/src/Optics/TH.hs b/src/Optics/TH.hs
index 8844879..40b45c8 100644
--- a/src/Optics/TH.hs
+++ b/src/Optics/TH.hs
@@ -73,7 +73,7 @@ module Optics.TH
, classUnderscoreNoPrefixNamer
, abbreviatedNamer
) where
-
+import Prelude hiding (length, any)
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
diff --git a/src/Optics/TH/Internal/Product.hs b/src/Optics/TH/Internal/Product.hs
index 8dabfe7..0d226ac 100644
--- a/src/Optics/TH/Internal/Product.hs
+++ b/src/Optics/TH/Internal/Product.hs
@@ -19,6 +19,7 @@ module Optics.TH.Internal.Product
, HasFieldClasses
) where
+import Prelude hiding (sum, concat, foldr, foldl, foldl1, foldr1, length, null, all, or, concatMap, elem, any)
import Control.Monad
import Control.Monad.State
import Data.Either
diff --git a/src/Optics/TH/Internal/Sum.hs b/src/Optics/TH/Internal/Sum.hs
index 58d404a..0c3fc59 100644
--- a/src/Optics/TH/Internal/Sum.hs
+++ b/src/Optics/TH/Internal/Sum.hs
@@ -6,6 +6,7 @@ module Optics.TH.Internal.Sum
, makeDecPrisms
) where
+import Prelude hiding (sum, concat, length, null)
import Data.Char
import Data.List
import Data.Maybe
diff --git a/src/Optics/TH/Internal/Utils.hs b/src/Optics/TH/Internal/Utils.hs
index f74303e..7fe3da1 100644
--- a/src/Optics/TH/Internal/Utils.hs
+++ b/src/Optics/TH/Internal/Utils.hs
@@ -15,16 +15,16 @@ import Optics.Core
-- | Apply arguments to a type constructor
appsT :: TypeQ -> [TypeQ] -> TypeQ
-appsT = foldl appT
+appsT = Prelude.foldl appT
-- | Apply arguments to a function
appsE1 :: ExpQ -> [ExpQ] -> ExpQ
-appsE1 = foldl appE
+appsE1 = Prelude.foldl appE
-- | Construct a tuple type given a list of types.
toTupleT :: [TypeQ] -> TypeQ
toTupleT [x] = x
-toTupleT xs = appsT (tupleT (length xs)) xs
+toTupleT xs = appsT (tupleT (Prelude.length xs)) xs
-- | Construct a tuple value given a list of expressions.
toTupleE :: [ExpQ] -> ExpQ
@@ -38,7 +38,7 @@ toTupleP xs = tupP xs
-- | Apply arguments to a type constructor.
conAppsT :: Name -> [Type] -> Type
-conAppsT conName = foldl AppT (ConT conName)
+conAppsT conName = Prelude.foldl AppT (ConT conName)
-- | Generate many new names from a given base name.
newNames :: String {- ^ base name -} -> Int {- ^ count -} -> Q [Name]
@@ -112,7 +112,7 @@ tyVarBndrToType = elimTV VarT (\n k -> SigT (VarT n) k)
requireExtensions :: String -> [[Extension]] -> Q ()
requireExtensions what extLists = do
-- Taken from the persistent library
- required <- filterM (fmap (not . or) . traverse isExtEnabled) extLists
+ required <- filterM (fmap (not . Prelude.or) . traverse isExtEnabled) extLists
case mapMaybe listToMaybe required of
[] -> pure ()
[extension] -> fail $ mconcat
diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs
index 1014702..dc35773 100644
--- a/Database/Persist/TH.hs
+++ b/Database/Persist/TH.hs
@@ -91,7 +91,7 @@ import Data.Either
import qualified Data.HashMap.Strict as HM
import Data.Int (Int64)
import Data.Ix (Ix)
-import Data.List (foldl')
+import Data.Foldable (foldl')
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
@@ -1284,7 +1284,11 @@ mkToPersistFields mps ed = do
go = do
xs <- sequence $ replicate fieldCount $ newName "x"
let name = mkEntityDefName ed
- pat = ConP name $ fmap VarP xs
+ pat = ConP name
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ (fmap VarP xs)
sp <- [|SomePersistField|]
let bod = ListE $ fmap (AppE sp . VarE) xs
return $ normalClause [pat] bod
@@ -1306,7 +1310,12 @@ mkToPersistFields mps ed = do
, [sp `AppE` VarE x]
, after
]
- return $ normalClause [ConP name [VarP x]] body
+ return $ normalClause [ConP name
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ [VarP x]
+ ] body
mkToFieldNames :: [UniqueDef] -> Q Dec
mkToFieldNames pairs = do
@@ -1328,7 +1337,11 @@ mkUniqueToValues pairs = do
go :: UniqueDef -> Q Clause
go (UniqueDef constr _ names _) = do
xs <- mapM (const $ newName "x") names
- let pat = ConP (mkConstraintName constr) $ fmap VarP $ toList xs
+ let pat = ConP (mkConstraintName constr)
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ (fmap VarP $ toList xs)
tpv <- [|toPersistValue|]
let bod = ListE $ fmap (AppE tpv . VarE) $ toList xs
return $ normalClause [pat] bod
@@ -1368,6 +1381,9 @@ mkFromPersistValues mps entDef
mkClauses before (field:after) = do
x <- newName "x"
let null' = ConP 'PersistNull []
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
pat = ListP $ mconcat
[ fmap (const null') before
, [VarP x]
@@ -1404,20 +1420,32 @@ mkLensClauses mps entDef = do
valName <- newName "value"
xName <- newName "x"
let idClause = normalClause
- [ConP (keyIdName entDef) []]
+ [ConP (keyIdName entDef) []
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ ]
(lens' `AppE` getId `AppE` setId)
return $ idClause : if unboundEntitySum entDef
then fmap (toSumClause lens' keyVar valName xName) (getUnboundFieldDefs entDef)
else fmap (toClause lens' getVal dot keyVar valName xName) (getUnboundFieldDefs entDef)
where
toClause lens' getVal dot keyVar valName xName fieldDef = normalClause
- [ConP (filterConName mps entDef fieldDef) []]
+ [ConP (filterConName mps entDef fieldDef)
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ []]
(lens' `AppE` getter `AppE` setter)
where
fieldName = fieldDefToRecordName mps entDef fieldDef
getter = InfixE (Just $ VarE fieldName) dot (Just getVal)
setter = LamE
- [ ConP 'Entity [VarP keyVar, VarP valName]
+ [ ConP 'Entity
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ [VarP keyVar, VarP valName]
, VarP xName
]
$ ConE 'Entity `AppE` VarE keyVar `AppE` RecUpdE
@@ -1425,20 +1453,29 @@ mkLensClauses mps entDef = do
[(fieldName, VarE xName)]
toSumClause lens' keyVar valName xName fieldDef = normalClause
- [ConP (filterConName mps entDef fieldDef) []]
+ [ConP (filterConName mps entDef fieldDef)
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ []
+ ]
(lens' `AppE` getter `AppE` setter)
where
emptyMatch = Match WildP (NormalB $ VarE 'error `AppE` LitE (StringL "Tried to use fieldLens on a Sum type")) []
getter = LamE
- [ ConP 'Entity [WildP, VarP valName]
+ [ ConP 'Entity [] [WildP, VarP valName]
] $ CaseE (VarE valName)
- $ Match (ConP (sumConstrName mps entDef fieldDef) [VarP xName]) (NormalB $ VarE xName) []
+ $ Match (ConP (sumConstrName mps entDef fieldDef) [] [VarP xName]) (NormalB $ VarE xName) []
-- FIXME It would be nice if the types expressed that the Field is
-- a sum type and therefore could result in Maybe.
: if length (getUnboundFieldDefs entDef) > 1 then [emptyMatch] else []
setter = LamE
- [ ConP 'Entity [VarP keyVar, WildP]
+ [ ConP 'Entity
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ [VarP keyVar, WildP]
, VarP xName
]
$ ConE 'Entity `AppE` VarE keyVar `AppE` (ConE (sumConstrName mps entDef fieldDef) `AppE` VarE xName)
@@ -2362,6 +2399,9 @@ mkUniqueKeys def = do
let pcs = fmap (go xs) $ entityUniques $ unboundEntityDef def
let pat = ConP
(mkEntityDefName def)
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
(fmap (VarP . snd) xs)
return $ normalClause [pat] (ListE pcs)
@@ -2549,7 +2589,12 @@ mkField mps entityMap et fieldDef = do
maybeIdType mps entityMap fieldDef Nothing Nothing
bod <- mkLookupEntityField et (unboundFieldNameHS fieldDef)
let cla = normalClause
- [ConP name []]
+ [ConP name
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ []
+ ]
bod
return $ EntityFieldTH con cla
where
@@ -2579,7 +2624,12 @@ mkIdField mps ued = do
[mkEqualP (VarT $ mkName "typ") entityIdType]
$ NormalC name []
, entityFieldTHClause =
- normalClause [ConP name []] clause
+ normalClause [ConP name
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ []
+ ] clause
}
lookupEntityField
@@ -2658,7 +2708,12 @@ mkJSON mps (fixEntityDef -> def) = do
typeInstanceD ''ToJSON (mpsGeneric mps) typ [toJSON']
where
toJSON' = FunD 'toJSON $ return $ normalClause
- [ConP conName $ fmap VarP xs]
+ [ConP conName
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ (fmap VarP xs)
+ ]
(objectE `AppE` ListE pairs)
where
pairs = zipWith toPair fields xs
@@ -2670,7 +2725,12 @@ mkJSON mps (fixEntityDef -> def) = do
typeInstanceD ''FromJSON (mpsGeneric mps) typ [parseJSON']
where
parseJSON' = FunD 'parseJSON
- [ normalClause [ConP 'Object [VarP obj]]
+ [ normalClause [ConP 'Object
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ [VarP obj]
+ ]
(foldl'
(\x y -> InfixE (Just x) apE' (Just y))
(pureE `AppE` ConE conName)
diff --git a/src/Relude/Monoid.hs b/src/Relude/Monoid.hs
index 0456c4a..3844098 100644
--- a/src/Relude/Monoid.hs
+++ b/src/Relude/Monoid.hs
@@ -37,7 +37,7 @@ import Data.Monoid (Ap (..))
#endif
import Data.Monoid (All (..), Alt (..), Any (..), Dual (..), Endo (..), First (..), Last (..),
Monoid (..), Product (..), Sum (..))
-import Data.Semigroup (Option (..), Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1,
+import Data.Semigroup (Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1,
mtimesDefault, stimesIdempotent, stimesIdempotentMonoid, stimesMonoid)
import Relude.Bool.Reexport (Bool (..))
diff --git a/src/Snap/Internal/Parsing.hs b/src/Snap/Internal/Parsing.hs
index a43aeba..530b3b7 100644
--- a/src/Snap/Internal/Parsing.hs
+++ b/src/Snap/Internal/Parsing.hs
@@ -27,7 +27,7 @@ import qualified Data.Map as Map (empty, insertWith, toL
import Data.Maybe (Maybe (..), maybe)
import Data.Monoid (Monoid (mconcat, mempty), (<>))
import Data.Word (Word8)
-import GHC.Exts (Int (I#), uncheckedShiftRL#, word2Int#)
+import GHC.Exts (Int (I#), uncheckedShiftRLWord8#, word2Int#, word8ToWord#)
import GHC.Word (Word8 (..))
import Prelude (Bool (..), Either (..), Enum (fromEnum, toEnum), Eq (..), Num (..), Ord (..), String, and, any, concatMap, elem, error, filter, flip, foldr, fst, id, map, not, otherwise, show, snd, ($), ($!), (&&), (++), (.), (||))
import Snap.Internal.Http.Types (Cookie (Cookie))
@@ -436,7 +436,7 @@ hexd c0 = char8 '%' <> word8 hi <> word8 low
!low = toDigit $ fromEnum $ c .&. 0xf
!hi = toDigit $ (c .&. 0xf0) `shiftr` 4
- shiftr (W8# a#) (I# b#) = I# (word2Int# (uncheckedShiftRL# a# b#))
+ shiftr (W8# a#) (I# b#) = I# (word2Int# (word8ToWord# (uncheckedShiftRLWord8# a# b#)))
------------------------------------------------------------------------------
diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs
index d7b1a5b..f823591 100644
--- a/src/Data/Swagger/Internal.hs
+++ b/src/Data/Swagger/Internal.hs
@@ -978,6 +978,19 @@ instance SwaggerMonoid ParamAnySchema where
-- Simple Generic-based ToJSON instances
-- =======================================================================
+deriveGeneric ''Header
+deriveGeneric ''OAuth2Params
+deriveGeneric ''Operation
+deriveGeneric ''Param
+deriveGeneric ''ParamOtherSchema
+deriveGeneric ''PathItem
+deriveGeneric ''Response
+deriveGeneric ''Responses
+deriveGeneric ''SecurityScheme
+deriveGeneric ''Schema
+deriveGeneric ''ParamSchema
+deriveGeneric ''Swagger
+
instance ToJSON ParamLocation where
toJSON = genericToJSON (jsonPrefix "Param")
@@ -1371,19 +1384,6 @@ instance FromJSON AdditionalProperties where
-- TH splices
-------------------------------------------------------------------------------
-deriveGeneric ''Header
-deriveGeneric ''OAuth2Params
-deriveGeneric ''Operation
-deriveGeneric ''Param
-deriveGeneric ''ParamOtherSchema
-deriveGeneric ''PathItem
-deriveGeneric ''Response
-deriveGeneric ''Responses
-deriveGeneric ''SecurityScheme
-deriveGeneric ''Schema
-deriveGeneric ''ParamSchema
-deriveGeneric ''Swagger
-
instance HasSwaggerAesonOptions Header where
swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
instance HasSwaggerAesonOptions OAuth2Params where
diff --git a/src/Data/Swagger/Operation.hs b/src/Data/Swagger/Operation.hs
index 607dc99..02ee3de 100644
--- a/src/Data/Swagger/Operation.hs
+++ b/src/Data/Swagger/Operation.hs
@@ -35,7 +35,7 @@ import Prelude.Compat
import Control.Lens
import Data.Data.Lens
-import Data.List.Compat
+import Data.List.Compat hiding (elem)
import Data.Maybe (mapMaybe)
import Data.Proxy
import qualified Data.Set as Set
diff --git a/WaiAppStatic/Storage/Embedded/Runtime.hs b/WaiAppStatic/Storage/Embedded/Runtime.hs
index c7df479..ad988b8 100644
--- a/WaiAppStatic/Storage/Embedded/Runtime.hs
+++ b/WaiAppStatic/Storage/Embedded/Runtime.hs
@@ -7,7 +7,7 @@ module WaiAppStatic.Storage.Embedded.Runtime
import WaiAppStatic.Types
import Data.ByteString (ByteString)
import Control.Arrow ((&&&), second)
-import Data.List
+import Data.List (groupBy, sortBy)
import Data.ByteString.Builder (byteString)
import qualified Network.Wai as W
import qualified Data.Map as Map
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
index 00d3cca..230a2b7 100644
--- a/wai-app-static.cabal
+++ b/wai-app-static.cabal
@@ -48,7 +48,7 @@ library
, template-haskell >= 2.7
, zlib >= 0.5
, filepath
- , wai-extra >= 3.0 && < 3.1
+ , wai-extra >= 3.0
, optparse-applicative >= 0.7
, warp >= 3.0.11 && < 3.4
diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs
index a210c5b..ff2dbc8 100644
--- a/src/Codec/Xlsx/Parser.hs
+++ b/src/Codec/Xlsx/Parser.hs
@@ -34,7 +34,7 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy as LB
import Data.ByteString.Lazy.Char8 ()
-import Data.List
+import Data.List hiding (foldr, any)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
index e0d6ae1..b09f5dd 100644
--- a/Yesod/Default/Util.hs
+++ b/Yesod/Default/Util.hs
@@ -113,7 +113,7 @@ combine func file isReload tls = do
, show file
, ", but no templates were found."
]
- exps -> return $ DoE $ map NoBindS exps
+ exps -> return $ DoE Nothing $ map NoBindS exps
where
qmexps :: Q [Maybe Exp]
qmexps = mapM go tls
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment