[#177] Walk through all modules and think carefully about SPECIALIZE/…

…INLINABLE/INLINE pragmas

Resolves #177

.gitignore

@@ -1,20 +1,56 @@
-*.sw[pon]
-.stack-work
+### Haskell
 dist
-dist-newstyle/
-.cabal-sandbox
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+*.prof
+*.aux
+*.hp
+*.eventlog
+.virtualenv
+.hsenv
+.hpc
+.cabal-sandbox/
 cabal.sandbox.config
+cabal.config
+cabal.project.local
 .ghc.environment.*
+.HTF/
+# Stack
+.stack-work/
+stack.yaml.lock
+# Nix
+result
 
-*.hi
-*.o
-TAGS
-
+### IDE/support
+# Vim
+[._]*.s[a-v][a-z]
+[._]*.sw[a-p]
+[._]s[a-v][a-z]
+[._]sw[a-p]
 *~
+tags
 
-.dir-locals.el
-*.html
+# IntellijIDEA
+.idea/
+.ideaHaskellLib/
+*.iml
+
+# Atom
+.haskell-ghc-mod.json
+
+# VS
+.vscode/
 
-*.liquid
+# Emacs
+*#
+.dir-locals.el
+TAGS
 
+# other
 .DS_Store

CHANGELOG.md

@@ -3,12 +3,15 @@
 `relude` uses [PVP Versioning][1].
 The changelog is available [on GitHub][2].
 
-## Unreleased: 0.6.0
+## Unreleased: 0.6.0.0
+
 * [#155](https://github.com/kowainik/relude/issues/155):
  Implement `Relude.Extra.Foldable` module.
 * Re-export `GHC.Float.atan2`.
 * [#172](https://github.com/kowainik/relude/issues/172):
  Add `Monoid` and `Semigroup` instances for `Validation` type
+* [#177](https://github.com/kowainik/relude/issues/177):
+ Improve usage of performance pragmas.
 * [#178](https://github.com/kowainik/relude/issues/178):
  Made `die` be polymorphic in its return type.
 

relude.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name: relude
-version: 0.5.0
+version: 0.6.0.0
 synopsis: Custom prelude from Kowainik
 description:
  == Goals
@@ -79,7 +79,8 @@ common common-options
  ghc-options: -fhide-source-paths
 
  default-language: Haskell2010
- default-extensions: NoImplicitPrelude
+ default-extensions: InstanceSigs
+ NoImplicitPrelude
  OverloadedStrings
  ScopedTypeVariables
  TypeApplications
@@ -169,9 +170,9 @@ test-suite relude-test
  build-depends: relude
  , bytestring
  , text
- , hedgehog >= 0.6
+ , hedgehog ^>= 1.0
  , tasty
- , tasty-hedgehog
+ , tasty-hedgehog ^>= 1.0
 
  ghc-options: -threaded
 

src/Relude/Applicative.hs

@@ -31,6 +31,7 @@ import Control.Applicative (Alternative (..), Applicative (..), Const (..), ZipL
 -- Just ()
 pass :: Applicative f => f ()
 pass = pure ()
+{-# INLINE pass #-}
 
 {- | For chaining applicative operations in forward applications using '(&)'
 Named version of the '<**>' operator, which is '<*>' but flipped

src/Relude/Base.hs

@@ -64,7 +64,7 @@ import Data.Proxy (Proxy (..))
 import Data.Typeable (Typeable)
 import Data.Void (Void, absurd, vacuous)
 
-import GHC.Base (String, asTypeOf, ord, seq, ($!))
+import GHC.Base (asTypeOf, ord, seq, ($!))
 import GHC.Enum (Bounded (..), Enum (..), boundedEnumFrom, boundedEnumFromThen)
 import GHC.Generics (Generic)
 import GHC.Show (Show)

src/Relude/Bool/Guard.hs

@@ -17,9 +17,10 @@ module Relude.Bool.Guard
  , (||^)
  ) where
 
+import Relude.Applicative (Applicative (..))
 import Relude.Bool.Reexport (Bool (..), guard, unless, when)
 import Relude.Function (flip)
-import Relude.Monad (Monad, MonadPlus, return, (>>=))
+import Relude.Monad (Monad, MonadPlus, (>>=))
 
 -- $setup
 -- >>> import Relude.Applicative (pure)
@@ -82,13 +83,13 @@ guardM f = f >>= guard
 -- >>> Just False &&^ error "Shouldn't be evaluated"
 -- Just False
 (&&^) :: Monad m => m Bool -> m Bool -> m Bool
-(&&^) e1 e2 = ifM e1 e2 (return False)
+(&&^) e1 e2 = ifM e1 e2 (pure False)
 {-# INLINE (&&^) #-}
 
 -- | Monadic version of 'Data.Bool.(||)' operator.
 --
 -- >>> Just True ||^ error "Shouldn't be evaluated"
 -- Just True
 (||^) :: Monad m => m Bool -> m Bool -> m Bool
-(||^) e1 e2 = ifM e1 (return True) e2
+(||^) e1 e2 = ifM e1 (pure True) e2
 {-# INLINE (||^) #-}

src/Relude/Container/One.hs

@@ -69,6 +69,7 @@ this container)
 class One x where
  -- | Type of single element of the structure.
  type OneItem x
+
  -- | Create a list, map, 'Text', etc from a single element.
  one :: OneItem x -> x
 
@@ -84,6 +85,8 @@ prop> length (one @[Int] x) == 1
 -}
 instance One [a] where
  type OneItem [a] = a
+
+ one :: a -> [a]
  one = (:[])
  {-# INLINE one #-}
 
@@ -97,6 +100,8 @@ prop> length (one @(NonEmpty Int) x) == 1
 -}
 instance One (NE.NonEmpty a) where
  type OneItem (NE.NonEmpty a) = a
+
+ one :: a -> NE.NonEmpty a
  one = (NE.:|[])
  {-# INLINE one #-}
 
@@ -109,6 +114,8 @@ prop> length (one @(Seq Int) x) == 1
 -}
 instance One (SEQ.Seq a) where
  type OneItem (SEQ.Seq a) = a
+
+ one :: a -> SEQ.Seq a
  one = SEQ.singleton
  {-# INLINE one #-}
 
@@ -123,6 +130,8 @@ prop> Text.length (one x) == 1
 -}
 instance One T.Text where
  type OneItem T.Text = Char
+
+ one :: Char -> T.Text
  one = T.singleton
  {-# INLINE one #-}
 
@@ -135,6 +144,8 @@ prop> LText.length (one x) == 1
 -}
 instance One TL.Text where
  type OneItem TL.Text = Char
+
+ one :: Char -> TL.Text
  one = TL.singleton
  {-# INLINE one #-}
 
@@ -147,6 +158,8 @@ prop> ByteString.length (one x) == 1
 -}
 instance One BS.ByteString where
  type OneItem BS.ByteString = Word8
+
+ one :: Word8 -> BS.ByteString
  one = BS.singleton
  {-# INLINE one #-}
 
@@ -159,6 +172,8 @@ prop> LByteString.length (one x) == 1
 -}
 instance One BSL.ByteString where
  type OneItem BSL.ByteString = Word8
+
+ one :: Word8 -> BSL.ByteString
  one = BSL.singleton
  {-# INLINE one #-}
 
@@ -173,6 +188,8 @@ prop> length (one @(Map Int String) x) == 1
 -}
 instance One (Map k v) where
  type OneItem (Map k v) = (k, v)
+
+ one :: (k, v) -> Map k v
  one = uncurry M.singleton
  {-# INLINE one #-}
 
@@ -185,6 +202,8 @@ prop> length (one @(HashMap Int String) x) == 1
 -}
 instance Hashable k => One (HashMap k v) where
  type OneItem (HashMap k v) = (k, v)
+
+ one :: (k, v) -> HashMap k v
  one = uncurry HM.singleton
  {-# INLINE one #-}
 
@@ -197,6 +216,8 @@ prop> length (one @(IntMap String) x) == 1
 -}
 instance One (IntMap v) where
  type OneItem (IntMap v) = (Int, v)
+
+ one :: (Int, v) -> IntMap v
  one = uncurry IM.singleton
  {-# INLINE one #-}
 
@@ -209,8 +230,10 @@ fromList [42]
 
 prop> length (one @(Set Int) x) == 1
 -}
-instance One (Set v) where
- type OneItem (Set v) = v
+instance One (Set a) where
+ type OneItem (Set a) = a
+
+ one :: a -> Set a
  one = Set.singleton
  {-# INLINE one #-}
 
@@ -221,8 +244,10 @@ fromList [42]
 
 prop> length (one @(HashSet Int) x) == 1
 -}
-instance Hashable v => One (HashSet v) where
- type OneItem (HashSet v) = v
+instance Hashable a => One (HashSet a) where
+ type OneItem (HashSet a) = a
+
+ one :: a -> HashSet a
  one = HashSet.singleton
  {-# INLINE one #-}
 
@@ -235,5 +260,7 @@ prop> IntSet.size (one x) == 1
 -}
 instance One IntSet where
  type OneItem IntSet = Int
+
+ one :: Int -> IntSet
  one = IS.singleton
  {-# INLINE one #-}

src/Relude/Debug.hs

@@ -41,8 +41,8 @@ import Data.Data (Data)
 import GHC.Exts (RuntimeRep, TYPE)
 
 import Relude.Applicative (Applicative)
-import Relude.Base (Bounded, Enum, Eq, Generic, HasCallStack, Ord, Show, String, Typeable)
-import Relude.String (Read, Text, toString)
+import Relude.Base (Bounded, Enum, Eq, Generic, HasCallStack, Ord, Show, Typeable)
+import Relude.String (Read, String, Text, toString)
 
 import qualified Debug.Trace as Debug
 import qualified Prelude

src/Relude/DeepSeq.hs

@@ -20,25 +20,34 @@ module Relude.DeepSeq
 
 import Control.DeepSeq (NFData (..), deepseq, force, ($!!))
 
-import Relude.Base (seq)
+import Relude.Base (IO, seq)
 import Relude.Function ((.))
 import Relude.Monad (MonadIO, liftIO, (<$!>))
 
 import qualified Control.Exception.Base (evaluate)
 
+
 -- | Lifted alias for 'Control.Exception.Base.evaluate' with clearer name.
 evaluateWHNF :: MonadIO m => a -> m a
 evaluateWHNF = liftIO . Control.Exception.Base.evaluate
+{-# INLINE evaluateWHNF #-}
+{-# SPECIALIZE evaluateWHNF :: a -> IO a #-}
 
 -- | Like 'evaluateWNHF' but discards value.
 evaluateWHNF_ :: MonadIO m => a -> m ()
 evaluateWHNF_ what = (`seq` ()) <$!> evaluateWHNF what
+{-# INLINE evaluateWHNF_ #-}
+{-# SPECIALIZE evaluateWHNF_ :: a -> IO () #-}
 
 -- | Alias for @evaluateWHNF . force@ with clearer name.
 evaluateNF :: (NFData a, MonadIO m) => a -> m a
 evaluateNF = evaluateWHNF . force
+{-# INLINE evaluateNF #-}
+{-# SPECIALIZE evaluateNF :: NFData a => a -> IO a #-}
 
 -- | Alias for @evaluateWHNF . rnf@. Similar to 'evaluateNF'
 -- but discards resulting value.
 evaluateNF_ :: (NFData a, MonadIO m) => a -> m ()
 evaluateNF_ = evaluateWHNF . rnf
+{-# INLINE evaluateNF_ #-}
+{-# SPECIALIZE evaluateNF_ :: NFData a => a -> IO () #-}

src/Relude/Exception.hs

@@ -32,8 +32,10 @@ import Relude.Monad (Maybe (..))
 
 import qualified Control.Exception as E (displayException, throw, toException)
 
--- | Type that represents exceptions used in cases when a particular codepath
--- is not meant to be ever executed, but happens to be executed anyway.
+
+{- | Type that represents exceptions used in cases when a particular codepath is
+not meant to be ever executed, but happens to be executed anyway.
+-}
 data Bug = Bug SomeException CallStack
  deriving (Show)
 

src/Relude/Extra/Bifunctor.hs

@@ -23,13 +23,15 @@ module Relude.Extra.Bifunctor
 
 import Relude
 
+
 {- | Fmaps functions for nested bifunctor. Short for @fmap (bimap f g)@.
 
 >>> bimapF not length $ Just (False, ['a', 'b'])
 Just (True,2)
 -}
 bimapF :: (Functor f, Bifunctor p) => (a -> c) -> (b -> d) -> f (p a b) -> f (p c d)
 bimapF f g = fmap (bimap f g)
+{-# INLINE bimapF #-}
 
 {- | Short for @fmap . first@.
 
@@ -38,6 +40,7 @@ Just (True,"ab")
 -}
 firstF :: (Functor f, Bifunctor p) => (a -> c) -> f (p a b) -> f (p c b)
 firstF = fmap . first
+{-# INLINE firstF #-}
 
 {- | Short for @fmap . second@.
 
@@ -46,3 +49,4 @@ Just (False,2)
 -}
 secondF :: (Functor f, Bifunctor p) => (b -> d) -> f (p a b) -> f (p a d)
 secondF = fmap . second
+{-# INLINE secondF #-}