Add -Wmissing-export-lists flag

This commit is contained in:
Ranjeet Kumar Ranjan 2022-02-11 10:57:39 +05:30 committed by Harendra Kumar
parent e65c5db97e
commit f30eafd440
20 changed files with 100 additions and 17 deletions

View File

@ -10,7 +10,59 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Streamly.Benchmark.Prelude where
module Streamly.Benchmark.Prelude
( absTimes
, apDiscardFst
, apDiscardSnd
, apLiftA2
, benchIO
, benchIOSink
, benchIOSrc
, breakAfterSome
, composeN
, concatFoldableWith
, concatForFoldableWith
, concatPairsWith
, concatStreamsWith
, filterAllInM
, filterAllOutM
, filterSome
, fmapN
, mapM
, mapN
, mkAsync
, monadThen
, runToList
, sourceConcatMapId
, sourceFoldMapM
, sourceFoldMapWith
, sourceFoldMapWithM
, sourceFoldMapWithStream
, sourceFracFromThenTo
, sourceFracFromTo
, sourceFromFoldable
, sourceFromFoldableM
, sourceFromList
, sourceFromListM
, sourceIntegerFromStep
, sourceIntFromThenTo
, sourceIntFromTo
, sourceUnfoldr
, sourceUnfoldrAction
, sourceUnfoldrM
, sourceUnfoldrMSerial
, toListM
, toListSome
, toNull
, toNullAp
, toNullM
, toNullM3
, transformComposeMapM
, transformMapM
, transformTeeMapM
, transformZipMapM
)
where
import Control.Applicative (liftA2)
import Control.DeepSeq (NFData(..))
@ -20,6 +72,7 @@ import Data.Functor.Identity (Identity)
import Data.Semigroup (Semigroup((<>)))
#endif
import GHC.Exception (ErrorCall)
import Prelude hiding (mapM)
import System.Random (randomRIO)
import qualified Data.Foldable as F

View File

@ -84,6 +84,7 @@ common compile-options
-Wredundant-constraints
-Wnoncanonical-monad-instances
-Rghc-timing
-Wmissing-export-lists
if flag(has-llvm)
ghc-options: -fllvm

View File

@ -11,12 +11,39 @@
-- Unicode Char stream and then use these parsers on the Char stream.
-- XXX Add explicit export list.
module Streamly.Internal.Unicode.Char.Parser where
module Streamly.Internal.Unicode.Char.Parser
( alpha
, alphaNum
, ascii
, asciiLower
, asciiUpper
, char
, decimal
, digit
, double
, hexadecimal
, hexDigit
, latin1
, letter
, lower
, mark
, number
, octDigit
, print
, punctuation
, separator
, signed
, space
, symbol
, upper
)
where
import Control.Applicative (Alternative(..))
import Control.Monad.Catch (MonadCatch)
import Data.Bits (Bits, (.|.), shiftL)
import Data.Char (ord)
import Prelude hiding (print)
import Streamly.Internal.Data.Parser (Parser)
import qualified Data.Char as Char

View File

@ -251,6 +251,7 @@ common compile-options
-Wincomplete-uni-patterns
-Wredundant-constraints
-Wnoncanonical-monad-instances
-Wmissing-export-lists
-Rghc-timing
if flag(has-llvm)

View File

@ -6,7 +6,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Data.Array where
module Streamly.Test.Data.Array (main) where
#include "Streamly/Test/Data/Array/CommonImports.hs"

View File

@ -6,7 +6,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Data.Array.Prim where
module Streamly.Test.Data.Array.Prim (main) where
#include "Streamly/Test/Data/Array/CommonImports.hs"

View File

@ -6,7 +6,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Data.Array.Prim.Pinned where
module Streamly.Test.Data.Array.Prim.Pinned (main) where
#include "Streamly/Test/Data/Array/CommonImports.hs"

View File

@ -6,7 +6,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Data.SmallArray where
module Streamly.Test.Data.SmallArray (main) where
#include "Streamly/Test/Data/Array/CommonImports.hs"

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.Ahead where
module Streamly.Test.Prelude.Ahead (main) where
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup ((<>))

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.Async where
module Streamly.Test.Prelude.Async (main) where
import Control.Concurrent (threadDelay)
import Data.List (sort)

View File

@ -9,7 +9,7 @@
{-# LANGUAGE OverloadedLists #-}
module Streamly.Test.Prelude.Concurrent where
module Streamly.Test.Prelude.Concurrent (main) where
import Control.Concurrent (MVar, takeMVar, threadDelay, putMVar, newEmptyMVar)
import Control.Exception

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.Fold where
module Streamly.Test.Prelude.Fold (main) where
#ifdef DEVBUILD
import Control.Concurrent (threadDelay)

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.Parallel where
module Streamly.Test.Prelude.Parallel (main) where
import Data.List (sort)
#if !(MIN_VERSION_base(4,11,0))

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.Rate where
module Streamly.Test.Prelude.Rate (main) where
import qualified Streamly.Prelude as S

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.Serial where
module Streamly.Test.Prelude.Serial (checkTakeDropTime, main) where
import Control.Concurrent ( threadDelay )
import Control.Monad ( when, forM_ )

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.WAsync where
module Streamly.Test.Prelude.WAsync (main) where
#ifdef DEVBUILD
import Control.Concurrent ( threadDelay )

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.WSerial where
module Streamly.Test.Prelude.WSerial (main) where
import Data.List (sort)
#if __GLASGOW_HASKELL__ < 808

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.ZipAsync where
module Streamly.Test.Prelude.ZipAsync (main) where
import Test.Hspec.QuickCheck
import Test.Hspec as H

View File

@ -7,7 +7,7 @@
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Prelude.ZipSerial where
module Streamly.Test.Prelude.ZipSerial (main) where
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup ((<>))

View File

@ -67,6 +67,7 @@ common compile-options
-Wincomplete-uni-patterns
-Wredundant-constraints
-Wnoncanonical-monad-instances
-Wmissing-export-lists
-Rghc-timing
if flag(has-llvm)