composewell/streamly
1
1
Fork 0
mirror of https://github.com/composewell/streamly.git synced 2024-07-07 07:46:51 +03:00
Code Issues Packages Projects Releases Wiki Activity

Fix hlint issues for streamly-core

Browse Source
This commit is contained in:
Harendra Kumar 2023-12-18 22:32:21 +05:30
parent dd763fe9ec
commit 98018c8440
20 changed files with 95 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.hlint.ignore
View File

@ -1,4 +1,4 @@
core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs
core/src/Streamly/Internal/Data/StreamK/Type.hs
core/src/Streamly/Internal/Data/Pipe/Type.hs
core/src/Streamly/Internal/Unicode/Stream.hs
src/Streamly/Internal/Data/SmallArray/Type.hs
@ -26,7 +26,6 @@ benchmark/NanoBenchmarks.hs
benchmark/Streamly/Benchmark/Data/Array.hs
benchmark/Streamly/Benchmark/Data/Parser.hs
benchmark/Streamly/Benchmark/Data/ParserK.hs
benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
benchmark/Streamly/Benchmark/Data/Unfold.hs
benchmark/Streamly/Benchmark/FileSystem/Handle.hs

6
.hlint.yaml
View File

@ -9,7 +9,6 @@
# Warnings currently triggered by your code
- suggest: {name: "Unused LANGUAGE pragma"}
- suggest: {name: "Eta reduce"}
- suggest: {name: "Reduce duplication"}
# Warnings currently ignored
- ignore: {name: "Use list literal pattern"}
@ -25,6 +24,8 @@
- ignore: {name: "Redundant $!"}
- ignore: {name: "Use fmap"}
- ignore: {name: "Use ++"}
- ignore: {name: "Replace case with maybe"} # case is more readable
- ignore: {name: "Use mapMaybe"} # does not make any difference
# Warnings ignored in specific places
- ignore: {name: "Use mapM", within: Stream.Transform}
@ -38,9 +39,10 @@
- arguments:
[ --cpp-include=src
, --cpp-include=src/Streamly/Internal/Data/Stream
, --cpp-include=src/Streamly/Internal/Data/Array
, --cpp-include=core/src/Streamly/Internal/Data/Array
, --cpp-include=test
, --cpp-define=CABAL_OS_LINUX
, --cpp-define=linux_HOST_OS
]

2
core/src/Streamly/Internal/Data/Array/Generic.hs
View File

@ -138,7 +138,7 @@ write = create
fromPureStream :: Stream Identity a -> Array a
fromPureStream x =
unsafePerformIO $ fmap (unsafeFreeze) (MArray.fromPureStream x)
unsafePerformIO $ fmap unsafeFreeze (MArray.fromPureStream x)
-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)
-- fromPureStream = fromList . runIdentity . D.toList

2
core/src/Streamly/Internal/Data/Array/Type.hs
View File

@ -897,7 +897,7 @@ fromPureStreamN n x =
-- >>> fromPureStream = Array.fromList . runIdentity . Stream.toList
--
fromPureStream :: Unbox a => Stream Identity a -> Array a
fromPureStream x = unsafePerformIO $ fmap (unsafeFreeze) (MA.fromPureStream x)
fromPureStream x = unsafePerformIO $ fmap unsafeFreeze (MA.fromPureStream x)
-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)
-- fromPureStream = fromList . runIdentity . D.toList

3
core/src/Streamly/Internal/Data/Builder.hs
View File

@ -19,6 +19,7 @@ where
#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Data.Bifunctor (first)
------------------------------------------------------------------------------
-- The Builder type
@ -34,7 +35,7 @@ newtype Builder s m a =
-- | Maps a function on the output of the fold (the type @b@).
instance Functor m => Functor (Builder s m) where
{-# INLINE fmap #-}
fmap f (Builder step1) = Builder (fmap (\ (a, s) -> (f a, s)) . step1)
fmap f (Builder step1) = Builder (fmap (first f) . step1)
{-# INLINE fromPure #-}
fromPure :: Applicative m => b -> Builder s m b

12
core/src/Streamly/Internal/Data/Fold/Combinators.hs
View File

@ -1337,7 +1337,7 @@ notElem a = all (/= a)
--
{-# INLINE and #-}
and :: Monad m => Fold m Bool Bool
and = all (== True)
and = all id
-- | Returns 'True' if any element is 'True', 'False' otherwise
--
@ -1347,7 +1347,7 @@ and = all (== True)
--
{-# INLINE or #-}
or :: Monad m => Fold m Bool Bool
or = any (== True)
or = any id
------------------------------------------------------------------------------
-- Grouping/Splitting
@ -1641,9 +1641,9 @@ takeEndBySeq patArr (Fold fstep finitial fextract ffinal) =
SplitOnSeqKRLoop s _ _ _ -> s
in fex st
extract state = extractFunc fextract state
extract = extractFunc fextract
final state = extractFunc ffinal state
final = extractFunc ffinal
-- | Like 'takeEndBySeq' but discards the matched sequence.
--
@ -1802,9 +1802,9 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract ffinal) =
SplitOnSeqKR s idx rb _ -> consumeRing s idx rb (Ring.startOf rb)
SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh
extract state = extractFunc fextract state
extract = extractFunc fextract
final state = extractFunc ffinal state
final = extractFunc ffinal
------------------------------------------------------------------------------
-- Distributing

2
core/src/Streamly/Internal/Data/MutArray/Generic.hs
View File

@ -301,7 +301,7 @@ putIndexUnsafeWith n _arrContents# x =
putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()
putIndexUnsafe i MutArray {..} x =
assert (i >= 0 && i < arrLen)
putIndexUnsafeWith (i + arrStart) arrContents# x
(putIndexUnsafeWith (i + arrStart) arrContents# x)
invalidIndex :: String -> Int -> a
invalidIndex label i =

72
core/src/Streamly/Internal/Data/MutByteArray.hs
View File

@ -1,5 +1,3 @@
{-# LANGUAGE TemplateHaskell #-}
-- This is required as all the instances in this module are orphan instances.
{-# OPTIONS_GHC -fno-warn-orphans #-}
@ -91,28 +89,25 @@ instance Serialize a => Serialize (Maybe a) where
{-# INLINE addSizeTo #-}
addSizeTo acc x =
case x of
Nothing -> (acc + 1)
Just field0 -> (addSizeTo (acc + 1)) field0
Nothing -> acc + 1
Just field0 -> addSizeTo (acc + 1) field0
{-# INLINE deserializeAt #-}
deserializeAt initialOffset arr endOffset = do
(i0, tag) <- ((deserializeAt initialOffset) arr) endOffset
(i0, tag) <- deserializeAt initialOffset arr endOffset
case tag :: Word8 of
0 -> pure (i0, Nothing)
1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset
1 -> do (i1, a0) <- deserializeAt i0 arr endOffset
pure (i1, Just a0)
_ -> error "Found invalid tag while peeking (Maybe a)"
{-# INLINE serializeAt #-}
serializeAt initialOffset arr val =
case val of
Nothing -> do
i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)
pure i0
Nothing -> serializeAt initialOffset arr (0 :: Word8)
Just field0 -> do
i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)
i1 <- ((serializeAt i0) arr) field0
pure i1
i0 <- serializeAt initialOffset arr (1 :: Word8)
serializeAt i0 arr field0
-- $(Serialize.deriveSerialize ''Either)
instance (Serialize a, Serialize b) => Serialize (Either a b) where
@ -120,16 +115,16 @@ instance (Serialize a, Serialize b) => Serialize (Either a b) where
{-# INLINE addSizeTo #-}
addSizeTo acc x =
case x of
Left field0 -> (addSizeTo (acc + 1)) field0
Right field0 -> (addSizeTo (acc + 1)) field0
Left field0 -> addSizeTo (acc + 1) field0
Right field0 -> addSizeTo (acc + 1) field0
{-# INLINE deserializeAt #-}
deserializeAt initialOffset arr endOffset = do
(i0, tag) <- ((deserializeAt initialOffset) arr) endOffset
(i0, tag) <- deserializeAt initialOffset arr endOffset
case tag :: Word8 of
0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset
0 -> do (i1, a0) <- deserializeAt i0 arr endOffset
pure (i1, Left a0)
1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset
1 -> do (i1, a0) <- deserializeAt i0 arr endOffset
pure (i1, Right a0)
_ -> error "Found invalid tag while peeking (Either a b)"
@ -137,21 +132,19 @@ instance (Serialize a, Serialize b) => Serialize (Either a b) where
serializeAt initialOffset arr val =
case val of
Left field0 -> do
i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)
i1 <- ((serializeAt i0) arr) field0
pure i1
i0 <- serializeAt initialOffset arr (0 :: Word8)
serializeAt i0 arr field0
Right field0 -> do
i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)
i1 <- ((serializeAt i0) arr) field0
pure i1
i0 <- serializeAt initialOffset arr (1 :: Word8)
serializeAt i0 arr field0
instance Serialize (Proxy a) where
{-# INLINE addSizeTo #-}
addSizeTo acc _ = (acc + 1)
addSizeTo acc _ = acc + 1
{-# INLINE deserializeAt #-}
deserializeAt initialOffset _ _ = pure ((initialOffset + 1), Proxy)
deserializeAt initialOffset _ _ = pure (initialOffset + 1, Proxy)
{-# INLINE serializeAt #-}
serializeAt initialOffset _ _ = pure (initialOffset + 1)
@ -171,19 +164,19 @@ instance Serialize LiftedInteger where
{-# INLINE addSizeTo #-}
addSizeTo acc x =
case x of
LIS field0 -> (addSizeTo (acc + 1)) field0
LIP field0 -> (addSizeTo (acc + 1)) field0
LIN field0 -> (addSizeTo (acc + 1)) field0
LIS field0 -> addSizeTo (acc + 1) field0
LIP field0 -> addSizeTo (acc + 1) field0
LIN field0 -> addSizeTo (acc + 1) field0
{-# INLINE deserializeAt #-}
deserializeAt initialOffset arr endOffset = do
(i0, tag) <- ((deserializeAt initialOffset) arr) endOffset
(i0, tag) <- deserializeAt initialOffset arr endOffset
case tag :: Word8 of
0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset
0 -> do (i1, a0) <- deserializeAt i0 arr endOffset
pure (i1, LIS a0)
1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset
1 -> do (i1, a0) <- deserializeAt i0 arr endOffset
pure (i1, LIP a0)
2 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset
2 -> do (i1, a0) <- deserializeAt i0 arr endOffset
pure (i1, LIN a0)
_ -> error "Found invalid tag while peeking (LiftedInteger)"
@ -191,17 +184,14 @@ instance Serialize LiftedInteger where
serializeAt initialOffset arr val =
case val of
LIS field0 -> do
i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)
i1 <- ((serializeAt i0) arr) field0
pure i1
i0 <- serializeAt initialOffset arr (0 :: Word8)
serializeAt i0 arr field0
LIP field0 -> do
i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)
i1 <- ((serializeAt i0) arr) field0
pure i1
i0 <- serializeAt initialOffset arr (1 :: Word8)
serializeAt i0 arr field0
LIN field0 -> do
i0 <- ((serializeAt initialOffset) arr) (2 :: Word8)
i1 <- ((serializeAt i0) arr) field0
pure i1
i0 <- serializeAt initialOffset arr (2 :: Word8)
serializeAt i0 arr field0
#if __GLASGOW_HASKELL__ >= 900

15
core/src/Streamly/Internal/Data/Serialize/TH.hs
View File

@ -172,8 +172,7 @@ mkSizeDec (SerializeConfig {..}) headTy cons = do
cfgRecordSyntaxWithHeader
(typeOfType headTy cons)
pure
( maybe
[]
( foldMap
(\x -> [PragmaD (InlineP 'addSizeTo x FunLike AllPhases)])
cfgInlineSize
++ [FunD 'addSizeTo [Clause [] (NormalB sizeOfMethod) []]]
@ -240,7 +239,7 @@ mkDeserializeExpr False False headTy tyOfTy =
, noBindS
(caseE
(sigE (varE _tag) (conT tagType))
(map peekMatch (zip [0 ..] cons) ++ [peekErr]))
(fmap peekMatch (zip [0 ..] cons) ++ [peekErr]))
]
where
peekMatch (i, con) =
@ -282,8 +281,7 @@ mkDeserializeDec (SerializeConfig {..}) headTy cons = do
headTy
(typeOfType headTy cons)
pure
( maybe
[]
( foldMap
(\x -> [PragmaD (InlineP 'deserializeAt x FunLike AllPhases)])
cfgInlineDeserialize
++
@ -308,7 +306,7 @@ mkSerializeExprTag tagType tagVal =
[|serializeAt
$(varE _initialOffset)
$(varE _arr)
$((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]
$(sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType))|]
mkSerializeExpr :: Bool -> Bool -> TypeOfType -> Q Exp
mkSerializeExpr True False tyOfTy =
@ -365,7 +363,7 @@ mkSerializeExpr False False tyOfTy =
tagType = getTagType lenCons
caseE
(varE _val)
(map (\(tagVal, (SimpleDataCon cname fields)) ->
(fmap (\(tagVal, SimpleDataCon cname fields) ->
matchConstructor
cname
(length fields)
@ -392,8 +390,7 @@ mkSerializeDec (SerializeConfig {..}) headTy cons = do
cfgRecordSyntaxWithHeader
(typeOfType headTy cons)
pure
( maybe
[]
( foldMap
(\x -> [PragmaD (InlineP 'serializeAt x FunLike AllPhases)])
cfgInlineSerialize
++

12
core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs
View File

@ -249,7 +249,7 @@ makeA i = mkName $ "a" ++ show i
openConstructor :: Name -> Int -> Q Pat
openConstructor cname numFields =
conP cname (map varP (map mkFieldName [0 .. (numFields - 1)]))
conP cname (map (varP. mkFieldName) [0 .. (numFields - 1)])
matchConstructor :: Name -> Int -> Q Exp -> Q Match
matchConstructor cname numFields exp0 =
@ -276,9 +276,9 @@ typeOfType :: Type -> [DataCon] -> TypeOfType
typeOfType headTy [] =
error
("Attempting to get size with no constructors (" ++
(pprint headTy) ++ ")")
pprint headTy ++ ")")
typeOfType _ [DataCon cname _ _ []] = UnitType cname
typeOfType _ [con@(DataCon _ _ _ _)] = TheType $ simplifyDataCon con
typeOfType _ [con@DataCon{}] = TheType $ simplifyDataCon con
typeOfType _ cons = MultiType $ map simplifyDataCon cons
isUnitType :: [DataCon] -> Bool
@ -286,7 +286,7 @@ isUnitType [DataCon _ _ _ []] = True
isUnitType _ = False
isRecordSyntax :: SimpleDataCon -> Bool
isRecordSyntax (SimpleDataCon _ fields) = and (isJust . fst <$> fields)
isRecordSyntax (SimpleDataCon _ fields) = all (isJust . fst) fields
--------------------------------------------------------------------------------
-- Type casting
@ -326,7 +326,7 @@ wListToString = fmap (chr . fromIntegral)
shiftAdd :: Bits a => (b -> a) -> [b] -> a
shiftAdd conv xs =
foldl' (.|.) zeroBits $
map (\(j, x) -> shiftL x (j * 8)) $ zip [0 ..] $ map conv xs
fmap (\(j, x) -> shiftL x (j * 8)) $ zip [0 ..] $ map conv xs
-- Note: This only works in little endian machines
-- TODO:
@ -423,7 +423,7 @@ serializeW8List :: Name -> Name -> [Word8] -> Q Exp
serializeW8List off arr w8List = do
[|let $(varP (makeN 0)) = $(varE off)
in $(doE (fmap makeBind [0 .. (lenW8List - 1)] ++
[noBindS ([|pure $(varE (makeN lenW8List))|])]))|]
[noBindS [|pure $(varE (makeN lenW8List))|]]))|]
where

6
core/src/Streamly/Internal/Data/Serialize/TH/Common.hs
View File

@ -40,8 +40,8 @@ mkDeserializeExprOne peeker (SimpleDataCon cname fields) =
[ varE (makeI numFields)
, appsE
(conE cname :
(map (varE . makeA)
[0 .. (numFields - 1)]))
map (varE . makeA)
[0 .. (numFields - 1)])
]))
]
])
@ -60,7 +60,7 @@ mkSerializeExprFields poker fields =
_ ->
doE
(fmap makeBind [0 .. (numFields - 1)] ++
[noBindS ([|pure $(varE (makeI numFields))|])])
[noBindS [|pure $(varE (makeI numFields))|]])
where
numFields = length fields
makeBind i =

18
core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs
View File

@ -105,7 +105,7 @@ instance forall a. Serialize a => Serialize (CompactList a) where
-- {-# INLINE addSizeTo #-}
addSizeTo acc (CompactList xs) =
foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Word8))) xs
foldl' addSizeTo (acc + Unbox.sizeOf (Proxy :: Proxy Word8)) xs
-- Inlining this causes large compilation times for tests
{-# INLINABLE deserializeAt #-}
@ -175,10 +175,10 @@ mkRecSizeOfExpr :: SimpleDataCon -> Q Exp
mkRecSizeOfExpr con = do
n_acc <- newName "acc"
n_x <- newName "x"
(lamE
lamE
[varP n_acc, varP n_x]
[|$(litIntegral hlen) +
$(caseE (varE n_x) [matchCons (varE n_acc) con])|])
$(caseE (varE n_x) [matchCons (varE n_acc) con])|]
where
@ -194,7 +194,7 @@ mkRecSizeOfExpr con = do
headerValue :: SimpleDataCon -> [Word8]
headerValue (SimpleDataCon _ fields) =
int_w8 numFields : concat (fmap lengthPrependedFieldEncoding fields)
int_w8 numFields : concatMap lengthPrependedFieldEncoding fields
where
@ -215,7 +215,7 @@ headerValue (SimpleDataCon _ fields) =
else
errorUnsupported
"Length of any key should be <= 255."
in (int_w8 (length fEnc)) : fEnc
in int_w8 (length fEnc) : fEnc
--------------------------------------------------------------------------------
-- Peek
@ -232,7 +232,7 @@ serializeWithSize off arr val = do
pure off1
mkRecSerializeExpr :: Name -> SimpleDataCon -> Q Exp
mkRecSerializeExpr initialOffset (con@(SimpleDataCon cname fields)) = do
mkRecSerializeExpr initialOffset con@(SimpleDataCon cname fields) = do
afterHLen <- newName "afterHLen"
-- Encoding the header length is required.
-- We first compare the header length encoded and the current header
@ -264,7 +264,7 @@ mkRecSerializeExpr initialOffset (con@(SimpleDataCon cname fields)) = do
{-# INLINE deserializeWithSize #-}
deserializeWithSize ::
Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)
deserializeWithSize off arr endOff = deserializeAt (off + 4) arr endOff
deserializeWithSize off = deserializeAt (off + 4)
conUpdateFuncDec :: Name -> [Field] -> Q [Dec]
conUpdateFuncDec funcName fields = do
@ -274,7 +274,7 @@ conUpdateFuncDec funcName fields = do
arr <- newName "arr"
key <- newName "key"
method <-
(caseE
caseE
(varE key)
(concat
[ map (matchField arr endOff (prevAcc, curOff)) fnames
@ -291,7 +291,7 @@ conUpdateFuncDec funcName fields = do
, valOff + w32_int valLen)|])
[]
]
]))
])
pure
[ PragmaD (InlineP funcName NoInline FunLike AllPhases)
, FunD

5
core/src/Streamly/Internal/Data/Serialize/Type.hs
View File

@ -1,3 +1,4 @@
{- HLINT ignore -}
-- |
-- Module : Streamly.Internal.Data.Serialize.Type
-- Copyright : (c) 2023 Composewell Technologies
@ -190,7 +191,7 @@ deserializeChecked off arr sz =
let next = off + Unbox.sizeOf (Proxy :: Proxy a)
in do
-- Keep likely path in the straight branch.
if (next <= sz)
if next <= sz
then Unbox.peekAt off arr >>= \val -> pure (next, val)
else error
$ "deserializeAt: accessing array at offset = "
@ -241,7 +242,7 @@ instance forall a. Serialize a => Serialize [a] where
-- {-# INLINE addSizeTo #-}
addSizeTo acc xs =
foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs
foldl' addSizeTo (acc + Unbox.sizeOf (Proxy :: Proxy Int)) xs
-- Inlining this causes large compilation times for tests
{-# INLINABLE deserializeAt #-}

6
core/src/Streamly/Internal/Data/Stream/Eliminate.hs
View File

@ -282,7 +282,7 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do
src = Prelude.reverse src0
return (Right b, Nesting.append (fromList src) (Stream step s))
PR.Error err -> do
let src = (Prelude.reverse $ getList buf) ++ x:xs
let src = Prelude.reverse (getList buf) ++ x:xs
return
( Left (ParseError err)
, Nesting.append (fromList src) (Stream step s)
@ -315,7 +315,7 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do
src = Prelude.reverse src0
return (Right b, fromList src)
PR.Error err -> do
let src = (Prelude.reverse $ getList buf) ++ x:xs
let src = Prelude.reverse (getList buf) ++ x:xs
return (Left (ParseError err), fromList src)
-- This is simplified goExtract
@ -441,7 +441,7 @@ elem e (Stream step state) = go SPEC state
{-# INLINE_NORMAL notElem #-}
notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
notElem e s = fmap not (elem e s)
notElem e s = fmap not (e `elem` s)
{-# INLINE_NORMAL all #-}
all :: Monad m => (a -> Bool) -> Stream m a -> m Bool

1
core/src/Streamly/Internal/Data/StreamK.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{- HLINT ignore "Eta reduce" -}
-- |
-- Module : Streamly.Internal.Data.StreamK
-- Copyright : (c) 2017 Composewell Technologies

1
core/src/Streamly/Internal/Data/Unbox.hs
View File

@ -5,6 +5,7 @@
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{- HLINT ignore -}
-- |
-- Module : Streamly.Internal.Data.Unbox

23
core/src/Streamly/Internal/Data/Unbox/TH.hs
View File

@ -21,9 +21,10 @@ module Streamly.Internal.Data.Unbox.TH
-- Imports
--------------------------------------------------------------------------------
import Data.Word (Word16, Word32, Word64, Word8)
import Data.Proxy (Proxy(..))
import Data.Bifunctor (second)
import Data.List (elemIndex)
import Data.Proxy (Proxy(..))
import Data.Word (Word16, Word32, Word64, Word8)
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
@ -62,7 +63,7 @@ elimTV _ptv ktv (KindedTV n k) = ktv n k
-- | Extract the type variable name from a 'TyVarBndr', ignoring the
-- kind signature if one exists.
tvName :: TyVarBndr_ flag -> Name
tvName = elimTV id (\n _ -> n)
tvName = elimTV id const
-- | Get the 'Name' of a 'TyVarBndr'
tyVarBndrName :: TyVarBndr_ flag -> Name
@ -191,7 +192,7 @@ mkOffsetDecls tagSize fields =
[|$(litE (IntegerL (fromIntegral tagSize))) +
$(varE _initialOffset)|])
[])
(map mkOffsetExpr (zip [1 ..] fields)))
(fmap mkOffsetExpr (zip [1 ..] fields)))
where
@ -271,7 +272,7 @@ mkPeekExpr headTy cons =
, noBindS
(caseE
(sigE (varE _tag) (conT tagType))
(map peekMatch (zip [0 ..] cons) ++ [peekErr]))
(fmap peekMatch (zip [0 ..] cons) ++ [peekErr]))
]
where
@ -303,7 +304,7 @@ mkPokeExprTag tagType tagVal = pokeTag
[|pokeAt
$(varE _initialOffset)
$(varE _arr)
$((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]
$(sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType))|]
mkPokeExprFields :: Int -> [Field] -> Q Exp
mkPokeExprFields tagSize fields = do
@ -326,7 +327,7 @@ mkPokeExprFields tagSize fields = do
mkPokeMatch :: Name -> Int -> Q Exp -> Q Match
mkPokeMatch cname numFields exp0 =
match
(conP cname (map varP (map mkFieldName [0 .. (numFields - 1)])))
(conP cname (map (varP . mkFieldName) [0 .. (numFields - 1)]))
(normalB exp0)
[]
@ -339,15 +340,15 @@ mkPokeExpr headTy cons =
$(lift (pprint headTy)) ++ ")")|]
-- XXX We don't gaurentee encoded equivalilty for Unbox. Does it still
-- make sense to encode a default value for unit constructor?
[(DataCon _ _ _ [])] -> [|pure ()|] -- mkPokeExprTag ''Word8 0
[(DataCon cname _ _ fields)] ->
[DataCon _ _ _ []] -> [|pure ()|] -- mkPokeExprTag ''Word8 0
[DataCon cname _ _ fields] ->
caseE
(varE _val)
[mkPokeMatch cname (length fields) (mkPokeExprFields 0 fields)]
_ ->
caseE
(varE _val)
(map (\(tagVal, (DataCon cname _ _ fields)) ->
(fmap (\(tagVal, DataCon cname _ _ fields) ->
mkPokeMatch
cname
(length fields)
@ -466,7 +467,7 @@ deriveUnbox mDecs = do
mapType f v = f v
modifyConVariables f con =
con { dcFields = map (\(a, b) -> (a, mapType f b)) (dcFields con) }
con { dcFields = map (second (mapType f)) (dcFields con) }
mkInst mo preds headTyWC methods =
pure [InstanceD mo preds headTyWC methods]

2
core/src/Streamly/Internal/Data/Unfold.hs
View File

@ -519,7 +519,7 @@ replicateM = Unfold step inject
where
inject seed = pure seed
inject = pure
{-# INLINE_LATE step #-}
step (i, action) =

4
core/src/Streamly/Internal/Unicode/Parser.hs
View File

@ -340,7 +340,7 @@ number = Parser (\s a -> return $ step s a) initial (return . extract)
step SPInitial val =
case val of
'+' -> Continue 0 (SPSign 1)
'-' -> Continue 0 $ (SPSign (-1))
'-' -> Continue 0 (SPSign (-1))
_ -> do
let num = ord val - 48
if num >= 0 && num <= 9
@ -481,7 +481,7 @@ doubleParser = Parser (\s a -> return $ step s a) initial (return . extract)
step DPInitial val =
case val of
'+' -> Continue 0 (DPSign 1)
'-' -> Continue 0 $ (DPSign (-1))
'-' -> Continue 0 (DPSign (-1))
_ -> do
let num = ord val - 48
if num >= 0 && num <= 9

2
core/src/Streamly/Internal/Unicode/String.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE CPP #-}
-- |
-- Module : Streamly.Internal.Unicode.String