strict-0.5/0000755000000000000000000000000007346545000011057 5ustar0000000000000000strict-0.5/CHANGELOG.md0000644000000000000000000000130007346545000012662 0ustar0000000000000000# 0.5 - Depend on `bifunctor-classes-compat` instead of `bifunctors` See changelog note in `bifunctors-5.6`: https://hackage.haskell.org/package/bifunctors-5.6/changelog This is breaking change, but affects only GHC-8.0 and older users. # 0.4.0.1 - Allow `bytestring-0.11` - Remove duplicate `semigroups` dependency # 0.4 - Add instances for type-classes in current `base`, `binary`, `deepseq` and `hashable` - Add combinators mirroring `Data.Maybe`, `Data.Either` and `Data.Tuple` - Add `Strict lazy strict` type-class with `toStrict` / `toLazy` conversion functions - Modules are explicitly marked `Safe` or `Trustworthy` - Add strict `These` - `:!:` (`Pair` constructor) is non-associative strict-0.5/LICENSE0000644000000000000000000000264707346545000012075 0ustar0000000000000000Copyright (c) Roman Leshchinskiy 2006-2007 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. strict-0.5/Setup.lhs0000644000000000000000000000011407346545000012663 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain strict-0.5/src/Data/0000755000000000000000000000000007346545000012517 5ustar0000000000000000strict-0.5/src/Data/Strict.hs0000644000000000000000000000057607346545000014333 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | Strict versions of some standard Haskell types. module Data.Strict ( module Data.Strict.Classes , module Data.Strict.These , module Data.Strict.Tuple , module Data.Strict.Maybe , module Data.Strict.Either ) where import Data.Strict.Classes import Data.Strict.These import Data.Strict.Tuple import Data.Strict.Maybe import Data.Strict.Either strict-0.5/src/Data/Strict/0000755000000000000000000000000007346545000013767 5ustar0000000000000000strict-0.5/src/Data/Strict/Classes.hs0000644000000000000000000000552307346545000015725 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FunctionalDependencies #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE Safe #-} #else {-# LANGUAGE Trustworthy #-} #endif module Data.Strict.Classes ( Strict (..), ) where import Prelude ((.)) import qualified Prelude as L import qualified Data.These as L import Data.Strict.These import Data.Strict.Tuple import Data.Strict.Maybe import Data.Strict.Either import qualified Control.Monad.ST.Lazy as L import qualified Control.Monad.ST.Strict as S import qualified Control.Monad.Trans.RWS.Lazy as L import qualified Control.Monad.Trans.RWS.Strict as S import qualified Control.Monad.Trans.State.Lazy as L import qualified Control.Monad.Trans.State.Strict as S import qualified Control.Monad.Trans.Writer.Lazy as L import qualified Control.Monad.Trans.Writer.Strict as S import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Lazy as LT -- | Ad hoc conversion between "strict" and "lazy" versions of a structure. -- -- Unfortunately all externally defined instances are doomed to -- be orphans: https://gitlab.haskell.org/ghc/ghc/-/issues/11999 -- See also https://qfpl.io/posts/orphans-and-fundeps/index.html for -- class Strict lazy strict | lazy -> strict, strict -> lazy where toStrict :: lazy -> strict toLazy :: strict -> lazy instance Strict (L.Maybe a) (Maybe a) where toStrict L.Nothing = Nothing toStrict (L.Just x) = Just x toLazy Nothing = L.Nothing toLazy (Just x) = L.Just x instance Strict (a, b) (Pair a b) where toStrict (a, b) = a :!: b toLazy (a :!: b) = (a, b) instance Strict (L.Either a b) (Either a b) where toStrict (L.Left x) = Left x toStrict (L.Right y) = Right y toLazy (Left x) = L.Left x toLazy (Right y) = L.Right y instance Strict (L.These a b) (These a b) where toStrict (L.This x) = This x toStrict (L.That y) = That y toStrict (L.These x y) = These x y toLazy (This x) = L.This x toLazy (That y) = L.That y toLazy (These x y) = L.These x y instance Strict LBS.ByteString BS.ByteString where #if MIN_VERSION_bytestring(0,10,0) toStrict = LBS.toStrict toLazy = LBS.fromStrict #else toStrict = BS.concat . LBS.toChunks toLazy = LBS.fromChunks . L.return {- singleton -} #endif instance Strict LT.Text T.Text where toStrict = LT.toStrict toLazy = LT.fromStrict instance Strict (L.ST s a) (S.ST s a) where toStrict = L.lazyToStrictST toLazy = L.strictToLazyST instance Strict (L.RWST r w s m a) (S.RWST r w s m a) where toStrict = S.RWST . L.runRWST toLazy = L.RWST . S.runRWST instance Strict (L.StateT s m a) (S.StateT s m a) where toStrict = S.StateT . L.runStateT toLazy = L.StateT . S.runStateT instance Strict (L.WriterT w m a) (S.WriterT w m a) where toStrict = S.WriterT . L.runWriterT toLazy = L.WriterT . S.runWriterT strict-0.5/src/Data/Strict/Either.hs0000644000000000000000000002014307346545000015543 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Safe #-} {-# LANGUAGE DeriveGeneric #-} #if MIN_VERSION_base(4,9,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers(0,5,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0) #define LIFTED_FUNCTOR_CLASSES 1 #endif #endif #endif ----------------------------------------------------------------------------- -- | -- -- The strict variant of the standard Haskell 'L.Either' type and the -- corresponding variants of the functions from "Data.Either". -- -- Note that the strict 'Either' type is not an applicative functor, and -- therefore also no monad. The reasons are the same as the ones for the -- strict @Maybe@ type, which are explained in "Data.Maybe.Strict". -- ----------------------------------------------------------------------------- module Data.Strict.Either ( Either(..) , either , isLeft, isRight , fromLeft, fromRight , lefts, rights , partitionEithers ) where -- import parts explicitly, helps with compatibility import Prelude ( Functor (..), Eq (..), Ord (..), Show (..), Read (..), Bool (..), (.), ($) , error, Ordering (..), showParen, showString, lex, return, readParen) import Control.Applicative (pure, (<$>)) import Data.Semigroup (Semigroup (..)) import Data.Foldable (Foldable (..)) import Data.Traversable (Traversable (..)) -- Lazy variants import qualified Prelude as L import Control.DeepSeq (NFData (..)) import Data.Bifoldable (Bifoldable (..)) import Data.Bifunctor (Bifunctor (..)) import Data.Binary (Binary (..)) import Data.Bitraversable (Bitraversable (..)) import Data.Hashable (Hashable(..)) import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..)) import GHC.Generics (Generic) import Data.Data (Data (..), Typeable) #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1 (..), NFData2 (..)) #endif #ifdef MIN_VERSION_assoc import Data.Bifunctor.Assoc (Assoc (..)) import Data.Bifunctor.Swap (Swap (..)) #endif #ifdef LIFTED_FUNCTOR_CLASSES import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..), Show1 (..), Show2 (..)) #else import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) #endif -- | The strict choice type. data Either a b = Left !a | Right !b deriving (Eq, Ord, Read, Show, Typeable, Data, Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif ) toStrict :: L.Either a b -> Either a b toStrict (L.Left x) = Left x toStrict (L.Right y) = Right y toLazy :: Either a b -> L.Either a b toLazy (Left x) = L.Left x toLazy (Right y) = L.Right y -- | Case analysis: if the value is @'Left' a@, apply the first function to @a@; -- if it is @'Right' b@, apply the second function to @b@. either :: (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left x) = f x either _ g (Right y) = g y -- | Yields 'True' iff the argument is of the form @Left _@. -- isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft _ = False -- | Yields 'True' iff the argument is of the form @Right _@. -- isRight :: Either a b -> Bool isRight (Right _) = True isRight _ = False -- | Extracts the element out of a 'Left' and throws an error if the argument -- is a 'Right'. fromLeft :: Either a b -> a fromLeft (Left x) = x fromLeft _ = error "Data.Strict.Either.fromLeft: Right" -- | Extracts the element out of a 'Right' and throws an error if the argument -- is a 'Left'. fromRight :: Either a b -> b fromRight (Right x) = x fromRight _ = error "Data.Strict.Either.fromRight: Left" -- | Analogous to 'L.lefts' in "Data.Either". lefts :: [Either a b] -> [a] lefts x = [a | Left a <- x] -- | Analogous to 'L.rights' in "Data.Either". rights :: [Either a b] -> [b] rights x = [a | Right a <- x] -- | Analogous to 'L.partitionEithers' in "Data.Either". partitionEithers :: [Either a b] -> ([a],[b]) partitionEithers = L.foldr (either left right) ([],[]) where left a ~(l, r) = (a:l, r) right a ~(l, r) = (l, a:r) -- Instances ------------ instance Functor (Either a) where fmap _ (Left x) = Left x fmap f (Right y) = Right (f y) instance Foldable (Either e) where foldr _ y (Left _) = y foldr f y (Right x) = f x y foldl _ y (Left _) = y foldl f y (Right x) = f y x instance Traversable (Either e) where traverse _ (Left x) = pure (Left x) traverse f (Right x) = Right <$> f x instance Semigroup (Either a b) where Left _ <> b = b a <> _ = a -- deepseq instance (NFData a, NFData b) => NFData (Either a b) where rnf = rnf . toLazy #if MIN_VERSION_deepseq(1,4,3) instance (NFData a) => NFData1 (Either a) where liftRnf rnfA = liftRnf rnfA . toLazy instance NFData2 Either where liftRnf2 rnfA rnfB = liftRnf2 rnfA rnfB . toLazy #endif -- binary instance (Binary a, Binary b) => Binary (Either a b) where put = put . toLazy get = toStrict <$> get -- bifunctors instance Bifunctor Either where bimap f _ (Left a) = Left (f a) bimap _ g (Right a) = Right (g a) first f = either (Left . f) Right second g = either Left (Right . g) instance Bifoldable Either where bifold (Left a) = a bifold (Right b) = b bifoldMap = either bifoldr f _ c (Left a) = f a c bifoldr _ g c (Right b) = g b c bifoldl f _ c (Left a) = f c a bifoldl _ g c (Right b) = g c b instance Bitraversable Either where bitraverse f _ (Left a) = fmap Left (f a) bitraverse _ g (Right b) = fmap Right (g b) -- hashable instance (Hashable a, Hashable b) => Hashable (Either a b) where hashWithSalt salt = hashWithSalt salt . toLazy instance (Hashable a) => Hashable1 (Either a) where liftHashWithSalt hashA salt = liftHashWithSalt hashA salt . toLazy instance Hashable2 Either where liftHashWithSalt2 hashA hashB salt = liftHashWithSalt2 hashA hashB salt . toLazy -- assoc #ifdef MIN_VERSION_assoc instance Assoc Either where assoc (Left (Left a)) = Left a assoc (Left (Right b)) = Right (Left b) assoc (Right c) = Right (Right c) unassoc (Left a) = Left (Left a) unassoc (Right (Left b)) = Left (Right b) unassoc (Right (Right c)) = Right c instance Swap Either where swap (Left x) = Right x swap (Right x) = Left x #endif -- Data.Functor.Classes #ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 Either where liftEq2 f _ (Left a) (Left a') = f a a' liftEq2 _ g (Right b) (Right b') = g b b' liftEq2 _ _ _ _ = False instance Eq a => Eq1 (Either a) where liftEq = liftEq2 (==) instance Ord2 Either where liftCompare2 f _ (Left a) (Left a') = f a a' liftCompare2 _ _ (Left _) _ = LT liftCompare2 _ _ _ (Left _) = GT liftCompare2 _ g (Right b) (Right b') = g b b' instance Ord a => Ord1 (Either a) where liftCompare = liftCompare2 compare instance Show a => Show1 (Either a) where liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show2 Either where liftShowsPrec2 sa _ _sb _ d (Left a) = showParen (d > 10) $ showString "Left " . sa 11 a liftShowsPrec2 _sa _ sb _ d (Right b) = showParen (d > 10) $ showString "Right " . sb 11 b instance Read2 Either where liftReadsPrec2 ra _ rb _ d = readParen (d > 10) $ \s -> cons s where cons s0 = do (ident, s1) <- lex s0 case ident of "Left" -> do (a, s2) <- ra 11 s1 return (Left a, s2) "Right" -> do (b, s2) <- rb 11 s1 return (Right b, s2) _ -> [] instance Read a => Read1 (Either a) where liftReadsPrec = liftReadsPrec2 readsPrec readList #else instance Eq a => Eq1 (Either a) where eq1 = (==) instance Ord a => Ord1 (Either a) where compare1 = compare instance Show a => Show1 (Either a) where showsPrec1 = showsPrec instance Read a => Read1 (Either a) where readsPrec1 = readsPrec #endif strict-0.5/src/Data/Strict/Maybe.hs0000644000000000000000000001530507346545000015364 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Safe #-} {-# LANGUAGE DeriveGeneric #-} #if MIN_VERSION_base(4,9,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers(0,5,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0) #define LIFTED_FUNCTOR_CLASSES 1 #endif #endif #endif ----------------------------------------------------------------------------- -- | -- -- The strict variant of the standard Haskell 'L.Maybe' type and the -- corresponding variants of the functions from "Data.Maybe". -- -- Note that in contrast to the standard lazy 'L.Maybe' type, the strict -- 'Maybe' type is not an applicative functor, and therefore also not a monad. -- The problem is the /homomorphism/ law, which states that -- -- @'pure' f '<*>' 'pure' x = 'pure' (f x) -- must hold for all f@ -- -- This law does not hold for the expected applicative functor instance of -- 'Maybe', as this instance does not satisfy @pure f \<*\> pure _|_ = pure (f -- _|_)@ for @f = const@. -- ----------------------------------------------------------------------------- module Data.Strict.Maybe ( Maybe(..) , isJust , isNothing , fromJust , fromMaybe , maybe , listToMaybe , maybeToList , catMaybes , mapMaybe ) where -- import parts explicitly, helps with compatibility import Prelude (Functor (..), Eq (..), Ord (..), Show (..), Read (..), Bool (..), (.) ,error, Ordering (..), ($), showString, showParen, return, lex, readParen) import Control.Applicative (pure, (<$>)) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.Foldable (Foldable (..)) import Data.Traversable (Traversable (..)) -- Lazy variants import qualified Prelude as L import Control.DeepSeq (NFData (..)) import Data.Binary (Binary (..)) import Data.Hashable (Hashable(..)) import Data.Hashable.Lifted (Hashable1 (..)) import GHC.Generics (Generic) import Data.Data (Data (..), Typeable) #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1 (..)) #endif #ifdef LIFTED_FUNCTOR_CLASSES import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) #else import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) #endif -- | The type of strict optional values. data Maybe a = Nothing | Just !a deriving (Eq, Ord, Read, Show, Typeable, Data, Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif ) toStrict :: L.Maybe a -> Maybe a toStrict L.Nothing = Nothing toStrict (L.Just x) = Just x toLazy :: Maybe a -> L.Maybe a toLazy Nothing = L.Nothing toLazy (Just x) = L.Just x -- | Yields 'True' iff the argument is of the form @Just _@. isJust :: Maybe a -> Bool isJust Nothing = False isJust _ = True -- | Yields 'True' iff the argument is 'Nothing'. isNothing :: Maybe a -> Bool isNothing Nothing = True isNothing _ = False -- | Extracts the element out of a 'Just' and throws an error if the argument -- is 'Nothing'. fromJust :: Maybe a -> a fromJust Nothing = error "Data.Strict.Maybe.fromJust: Nothing" fromJust (Just x) = x -- | Given a default value and a 'Maybe', yield the default value if the -- 'Maybe' argument is 'Nothing' and extract the value out of the 'Just' -- otherwise. fromMaybe :: a -> Maybe a -> a fromMaybe x Nothing = x fromMaybe _ (Just y) = y -- | Given a default value, a function and a 'Maybe' value, yields the default -- value if the 'Maybe' value is 'Nothing' and applies the function to the -- value stored in the 'Just' otherwise. maybe :: b -> (a -> b) -> Maybe a -> b maybe x _ Nothing = x maybe _ f (Just y) = f y -- | Analogous to 'L.listToMaybe' in "Data.Maybe". listToMaybe :: [a] -> Maybe a listToMaybe [] = Nothing listToMaybe (a:_) = Just a -- | Analogous to 'L.maybeToList' in "Data.Maybe". maybeToList :: Maybe a -> [a] maybeToList Nothing = [] maybeToList (Just x) = [x] -- | Analogous to 'L.catMaybes' in "Data.Maybe". catMaybes :: [Maybe a] -> [a] catMaybes ls = [x | Just x <- ls] -- | Analogous to 'L.mapMaybe' in "Data.Maybe". mapMaybe :: (a -> Maybe b) -> [a] -> [b] mapMaybe _ [] = [] mapMaybe f (x:xs) = case f x of Nothing -> rs Just r -> r:rs where rs = mapMaybe f xs -- Instances ------------ instance Semigroup a => Semigroup (Maybe a) where Nothing <> m = m m <> Nothing = m Just x1 <> Just x2 = Just (x1 <> x2) #if MIN_VERSION_base(4,11,0) instance Semigroup a => Monoid (Maybe a) where mempty = Nothing #else instance Monoid a => Monoid (Maybe a) where mempty = Nothing Nothing `mappend` m = m m `mappend` Nothing = m Just x1 `mappend` Just x2 = Just (x1 `mappend` x2) #endif instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just x) = Just (f x) instance Foldable Maybe where foldMap _ Nothing = mempty foldMap f (Just x) = f x instance Traversable Maybe where traverse _ Nothing = pure Nothing traverse f (Just x) = Just <$> f x -- deepseq instance NFData a => NFData (Maybe a) where rnf = rnf . toLazy #if MIN_VERSION_deepseq(1,4,3) instance NFData1 Maybe where liftRnf rnfA = liftRnf rnfA . toLazy #endif -- binary instance Binary a => Binary (Maybe a) where put = put . toLazy get = toStrict <$> get -- hashable instance Hashable a => Hashable (Maybe a) where hashWithSalt salt = hashWithSalt salt . toLazy instance Hashable1 Maybe where liftHashWithSalt hashA salt = liftHashWithSalt hashA salt . toLazy -- Data.Functor.Classes #ifdef LIFTED_FUNCTOR_CLASSES instance Eq1 Maybe where liftEq f (Just a) (Just a') = f a a' liftEq _ Nothing Nothing = True liftEq _ _ _ = False instance Ord1 Maybe where liftCompare _ Nothing Nothing = EQ liftCompare _ Nothing (Just _) = LT liftCompare _ (Just _) Nothing = GT liftCompare f (Just a) (Just a') = f a a' instance Show1 Maybe where liftShowsPrec _ _ _ Nothing = showString "Nothing" liftShowsPrec sa _ d (Just a) = showParen (d > 10) $ showString "Just " . sa 11 a instance Read1 Maybe where liftReadsPrec ra _ d = readParen (d > 10) cons where cons s0 = do (ident, s1) <- lex s0 case ident of "Nothing" -> return (Nothing, s1) "Just" -> do (a, s2) <- ra 11 s1 return (Just a, s2) _ -> [] #else instance Eq1 Maybe where eq1 = (==) instance Ord1 Maybe where compare1 = compare instance Show1 Maybe where showsPrec1 = showsPrec instance Read1 Maybe where readsPrec1 = readsPrec #endif strict-0.5/src/Data/Strict/These.hs0000644000000000000000000003512307346545000015377 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} #if MIN_VERSION_base(4,9,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers(0,5,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0) #define LIFTED_FUNCTOR_CLASSES 1 #endif #endif #endif module Data.Strict.These ( These(..) -- * Functions to get rid of 'These' , these , fromThese , mergeThese , mergeTheseWith -- * Partition , partitionThese , partitionHereThere , partitionEithersNE -- * Distributivity -- -- | This distributivity combinators aren't isomorphisms! , distrThesePair , undistrThesePair , distrPairThese , undistrPairThese ) where import Control.Applicative (Applicative (..), (<$>)) import Control.DeepSeq (NFData (..)) import Data.Bifoldable (Bifoldable (..)) import Data.Bifunctor (Bifunctor (..)) import Data.Binary (Binary (..)) import Data.Bitraversable (Bitraversable (..)) import Data.Data (Data, Typeable) import Data.Either (partitionEithers) import Data.Foldable (Foldable (..)) import Data.Hashable (Hashable (..)) import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.Traversable (Traversable (..)) import GHC.Generics (Generic) import Prelude (Bool (..), Either (..), Eq (..), Functor (..), Int, Monad (..), Ord (..), Ordering (..), Read (..), Show (..), id, lex, readParen, seq, showParen, showString, ($), (&&), (.)) import qualified Data.These as L #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1 (..), NFData2 (..)) #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif #ifdef MIN_VERSION_assoc import Data.Bifunctor.Assoc (Assoc (..)) import Data.Bifunctor.Swap (Swap (..)) #endif #ifdef LIFTED_FUNCTOR_CLASSES import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..), Show1 (..), Show2 (..)) #else import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) #endif -- $setup -- >>> import Prelude (map) -- | The strict these type. data These a b = This !a | That !b | These !a !b deriving (Eq, Ord, Read, Show, Typeable, Data, Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif ) toStrict :: L.These a b -> These a b toStrict (L.This x) = This x toStrict (L.That y) = That y toStrict (L.These x y) = These x y toLazy :: These a b -> L.These a b toLazy (This x) = L.This x toLazy (That y) = L.That y toLazy (These x y) = L.These x y ------------------------------------------------------------------------------- -- Eliminators ------------------------------------------------------------------------------- -- | Case analysis for the 'These' type. these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c these l _ _ (This a) = l a these _ r _ (That x) = r x these _ _ lr (These a x) = lr a x -- | Takes two default values and produces a tuple. fromThese :: a -> b -> These a b -> (a, b) fromThese x y = these (`pair` y) (x `pair`) pair where pair = (,) -- | Coalesce with the provided operation. mergeThese :: (a -> a -> a) -> These a a -> a mergeThese = these id id -- | 'bimap' and coalesce results with the provided operation. mergeTheseWith :: (a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c mergeTheseWith f g op t = mergeThese op $ bimap f g t ------------------------------------------------------------------------------- -- Partitioning ------------------------------------------------------------------------------- -- | Select each constructor and partition them into separate lists. partitionThese :: [These a b] -> ([a], [b], [(a, b)]) partitionThese [] = ([], [], []) partitionThese (t:ts) = case t of This x -> (x : xs, ys, xys) That y -> ( xs, y : ys, xys) These x y -> ( xs, ys, (x,y) : xys) where ~(xs,ys,xys) = partitionThese ts -- | Select 'here' and 'there' elements and partition them into separate lists. -- partitionHereThere :: [These a b] -> ([a], [b]) partitionHereThere [] = ([], []) partitionHereThere (t:ts) = case t of This x -> (x : xs, ys) That y -> ( xs, y : ys) These x y -> (x : xs, y : ys) where ~(xs,ys) = partitionHereThere ts -- | Like 'partitionEithers' but for 'NonEmpty' types. -- -- * either all are 'Left' -- * either all are 'Right' -- * or there is both 'Left' and 'Right' stuff -- -- /Note:/ this is not online algorithm. In the worst case it will traverse -- the whole list before deciding the result constructor. -- -- >>> partitionEithersNE $ Left 'x' :| [Right 'y'] -- These ('x' :| "") ('y' :| "") -- -- >>> partitionEithersNE $ Left 'x' :| map Left "yz" -- This ('x' :| "yz") -- partitionEithersNE :: NonEmpty (Either a b) -> These (NonEmpty a) (NonEmpty b) partitionEithersNE (x :| xs) = case (x, ls, rs) of (Left y, ys, []) -> This (y :| ys) (Left y, ys, z:zs) -> These (y :| ys) (z :| zs) (Right z, [], zs) -> That (z :| zs) (Right z, y:ys, zs) -> These (y :| ys) (z :| zs) where (ls, rs) = partitionEithers xs ------------------------------------------------------------------------------- -- Distributivity ------------------------------------------------------------------------------- distrThesePair :: These (a, b) c -> (These a c, These b c) distrThesePair (This (a, b)) = (This a, This b) distrThesePair (That c) = (That c, That c) distrThesePair (These (a, b) c) = (These a c, These b c) undistrThesePair :: (These a c, These b c) -> These (a, b) c undistrThesePair (This a, This b) = This (a, b) undistrThesePair (That c, That _) = That c undistrThesePair (These a c, These b _) = These (a, b) c undistrThesePair (This _, That c) = That c undistrThesePair (This a, These b c) = These (a, b) c undistrThesePair (That c, This _) = That c undistrThesePair (That c, These _ _) = That c undistrThesePair (These a c, This b) = These (a, b) c undistrThesePair (These _ c, That _) = That c distrPairThese :: (These a b, c) -> These (a, c) (b, c) distrPairThese (This a, c) = This (a, c) distrPairThese (That b, c) = That (b, c) distrPairThese (These a b, c) = These (a, c) (b, c) undistrPairThese :: These (a, c) (b, c) -> (These a b, c) undistrPairThese (This (a, c)) = (This a, c) undistrPairThese (That (b, c)) = (That b, c) undistrPairThese (These (a, c) (b, _)) = (These a b, c) ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- instance (Semigroup a, Semigroup b) => Semigroup (These a b) where This a <> This b = This (a <> b) This a <> That y = These a y This a <> These b y = These (a <> b) y That x <> This b = These b x That x <> That y = That (x <> y) That x <> These b y = These b (x <> y) These a x <> This b = These (a <> b) x These a x <> That y = These a (x <> y) These a x <> These b y = These (a <> b) (x <> y) instance Functor (These a) where fmap _ (This x) = This x fmap f (That y) = That (f y) fmap f (These x y) = These x (f y) instance Foldable (These a) where foldr _ z (This _) = z foldr f z (That x) = f x z foldr f z (These _ x) = f x z instance Traversable (These a) where traverse _ (This a) = pure $ This a traverse f (That x) = That <$> f x traverse f (These a x) = These a <$> f x sequenceA (This a) = pure $ This a sequenceA (That x) = That <$> x sequenceA (These a x) = These a <$> x instance Bifunctor These where bimap f _ (This a ) = This (f a) bimap _ g (That x) = That (g x) bimap f g (These a x) = These (f a) (g x) instance Bifoldable These where bifold = these id id mappend bifoldr f g z = these (`f` z) (`g` z) (\x y -> x `f` (y `g` z)) bifoldl f g z = these (z `f`) (z `g`) (\x y -> (z `f` x) `g` y) instance Bitraversable These where bitraverse f _ (This x) = This <$> f x bitraverse _ g (That x) = That <$> g x bitraverse f g (These x y) = These <$> f x <*> g y instance (Semigroup a) => Applicative (These a) where pure = That This a <*> _ = This a That _ <*> This b = This b That f <*> That x = That (f x) That f <*> These b x = These b (f x) These a _ <*> This b = This (a <> b) These a f <*> That x = These a (f x) These a f <*> These b x = These (a <> b) (f x) instance (Semigroup a) => Monad (These a) where return = pure This a >>= _ = This a That x >>= k = k x These a x >>= k = case k x of This b -> This (a <> b) That y -> These a y These b y -> These (a <> b) y ------------------------------------------------------------------------------- -- Data.Functor.Classes ------------------------------------------------------------------------------- #ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 These where liftEq2 f _ (This a) (This a') = f a a' liftEq2 _ g (That b) (That b') = g b b' liftEq2 f g (These a b) (These a' b') = f a a' && g b b' liftEq2 _ _ _ _ = False instance Eq a => Eq1 (These a) where liftEq = liftEq2 (==) instance Ord2 These where liftCompare2 f _ (This a) (This a') = f a a' liftCompare2 _ _ (This _) _ = LT liftCompare2 _ _ _ (This _) = GT liftCompare2 _ g (That b) (That b') = g b b' liftCompare2 _ _ (That _) _ = LT liftCompare2 _ _ _ (That _) = GT liftCompare2 f g (These a b) (These a' b') = f a a' `mappend` g b b' instance Ord a => Ord1 (These a) where liftCompare = liftCompare2 compare instance Show a => Show1 (These a) where liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show2 These where liftShowsPrec2 sa _ _sb _ d (This a) = showParen (d > 10) $ showString "This " . sa 11 a liftShowsPrec2 _sa _ sb _ d (That b) = showParen (d > 10) $ showString "That " . sb 11 b liftShowsPrec2 sa _ sb _ d (These a b) = showParen (d > 10) $ showString "These " . sa 11 a . showString " " . sb 11 b instance Read2 These where liftReadsPrec2 ra _ rb _ d = readParen (d > 10) $ \s -> cons s where cons s0 = do (ident, s1) <- lex s0 case ident of "This" -> do (a, s2) <- ra 11 s1 return (This a, s2) "That" -> do (b, s2) <- rb 11 s1 return (That b, s2) "These" -> do (a, s2) <- ra 11 s1 (b, s3) <- rb 11 s2 return (These a b, s3) _ -> [] instance Read a => Read1 (These a) where liftReadsPrec = liftReadsPrec2 readsPrec readList #else instance Eq a => Eq1 (These a) where eq1 = (==) instance Ord a => Ord1 (These a) where compare1 = compare instance Show a => Show1 (These a) where showsPrec1 = showsPrec instance Read a => Read1 (These a) where readsPrec1 = readsPrec #endif ------------------------------------------------------------------------------- -- assoc ------------------------------------------------------------------------------- #ifdef MIN_VERSION_assoc instance Swap These where swap (This a) = That a swap (That b) = This b swap (These a b) = These b a instance Assoc These where assoc (This (This a)) = This a assoc (This (That b)) = That (This b) assoc (That c) = That (That c) assoc (These (That b) c) = That (These b c) assoc (This (These a b)) = These a (This b) assoc (These (This a) c) = These a (That c) assoc (These (These a b) c) = These a (These b c) unassoc (This a) = This (This a) unassoc (That (This b)) = This (That b) unassoc (That (That c)) = That c unassoc (That (These b c)) = These (That b) c unassoc (These a (This b)) = This (These a b) unassoc (These a (That c)) = These (This a) c unassoc (These a (These b c)) = These (These a b) c #endif ------------------------------------------------------------------------------- -- deepseq ------------------------------------------------------------------------------- instance (NFData a, NFData b) => NFData (These a b) where rnf (This a) = rnf a rnf (That b) = rnf b rnf (These a b) = rnf a `seq` rnf b #if MIN_VERSION_deepseq(1,4,3) instance NFData a => NFData1 (These a) where liftRnf _rnfB (This a) = rnf a liftRnf rnfB (That b) = rnfB b liftRnf rnfB (These a b) = rnf a `seq` rnfB b instance NFData2 These where liftRnf2 rnfA _rnfB (This a) = rnfA a liftRnf2 _rnfA rnfB (That b) = rnfB b liftRnf2 rnfA rnfB (These a b) = rnfA a `seq` rnfB b #endif ------------------------------------------------------------------------------- -- binary ------------------------------------------------------------------------------- instance (Binary a, Binary b) => Binary (These a b) where put = put . toLazy get = toStrict <$> get ------------------------------------------------------------------------------- -- hashable ------------------------------------------------------------------------------- instance (Hashable a, Hashable b) => Hashable (These a b) where hashWithSalt salt (This a) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` a hashWithSalt salt (That b) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` b hashWithSalt salt (These a b) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` a `hashWithSalt` b instance Hashable a => Hashable1 (These a) where liftHashWithSalt _hashB salt (This a) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` a liftHashWithSalt hashB salt (That b) = (salt `hashWithSalt` (1 :: Int)) `hashB` b liftHashWithSalt hashB salt (These a b) = (salt `hashWithSalt` (2 :: Int) `hashWithSalt` a) `hashB` b instance Hashable2 These where liftHashWithSalt2 hashA _hashB salt (This a) = (salt `hashWithSalt` (0 :: Int)) `hashA` a liftHashWithSalt2 _hashA hashB salt (That b) = (salt `hashWithSalt` (1 :: Int)) `hashB` b liftHashWithSalt2 hashA hashB salt (These a b) = (salt `hashWithSalt` (2 :: Int)) `hashA` a `hashB` b strict-0.5/src/Data/Strict/Tuple.hs0000644000000000000000000001657007346545000015425 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Safe #-} {-# LANGUAGE DeriveGeneric #-} #ifndef __HADDOCK__ #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE TypeOperators #-} #endif #endif #if MIN_VERSION_base(4,9,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers(0,5,0) #define LIFTED_FUNCTOR_CLASSES 1 #else #if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0) #define LIFTED_FUNCTOR_CLASSES 1 #endif #endif #endif ----------------------------------------------------------------------------- -- | -- -- The strict variant of the standard Haskell pairs and the corresponding -- variants of the functions from "Data.Tuple". -- -- Note that unlike regular Haskell pairs, @(x :!: _|_) = (_|_ :!: y) = _|_@ -- ----------------------------------------------------------------------------- module Data.Strict.Tuple ( Pair(..) #ifndef __HADDOCK__ #ifdef __GLASGOW_HASKELL__ , (:!:) #endif #endif , fst , snd , curry , uncurry , Data.Strict.Tuple.swap -- disambiguate , zip , unzip ) where -- import parts explicitly, helps with compatibility import Prelude (Functor (..), Eq (..), Ord (..), Show (..), Read (..), (.), Bounded, map, ($) , (&&), showParen, showString, readParen, lex, return) import Control.Applicative ((<$>), (<*>)) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.Foldable (Foldable (..)) import Data.Traversable (Traversable (..)) -- Lazy variants import qualified Prelude as L import Control.DeepSeq (NFData (..)) import Data.Bifoldable (Bifoldable (..)) import Data.Bifunctor (Bifunctor (..)) import Data.Binary (Binary (..)) import Data.Bitraversable (Bitraversable (..)) import Data.Hashable (Hashable(..)) import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..)) import Data.Ix (Ix (..)) import GHC.Generics (Generic) import Data.Data (Data (..), Typeable) #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1 (..), NFData2 (..)) #endif #ifdef MIN_VERSION_assoc import Data.Bifunctor.Assoc (Assoc (..)) import Data.Bifunctor.Swap (Swap (..)) #endif #ifdef LIFTED_FUNCTOR_CLASSES import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..), Show1 (..), Show2 (..)) #else import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) #endif #if __HADDOCK__ import Data.Tuple () #endif -- $setup -- >>> import Prelude (Char, String) -- >>> import Data.Functor.Classes (readsPrec2) infix 2 :!: -- | The type of strict pairs. data Pair a b = !a :!: !b deriving (Eq, Ord, Read, Show, Typeable, Data, Generic, Bounded, Ix #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif ) #ifndef __HADDOCK__ #ifdef __GLASGOW_HASKELL__ -- This gives a nicer syntax for the type but only works in GHC for now. type (:!:) = Pair #endif #endif toStrict :: (a, b) -> Pair a b toStrict (a, b) = a :!: b toLazy :: Pair a b -> (a, b) toLazy (a :!: b) = (a, b) -- | Extract the first component of a strict pair. fst :: Pair a b -> a fst (x :!: _) = x -- | Extract the second component of a strict pair. snd :: Pair a b -> b snd (_ :!: y) = y -- | Curry a function on strict pairs. curry :: (Pair a b -> c) -> a -> b -> c curry f x y = f (x :!: y) -- | Convert a curried function to a function on strict pairs. uncurry :: (a -> b -> c) -> Pair a b -> c uncurry f (x :!: y) = f x y -- | Analogous to 'L.swap' from "Data.Tuple" swap :: Pair a b -> Pair b a swap (a :!: b) = b :!: a -- | Zip for strict pairs (defined with zipWith). zip :: [a] -> [b] -> [Pair a b] zip x y = L.zipWith (:!:) x y -- | Unzip for stict pairs into a (lazy) pair of lists. unzip :: [Pair a b] -> ([a], [b]) unzip x = ( map fst x , map snd x ) -- Instances ------------ instance Functor (Pair e) where fmap f = toStrict . fmap f . toLazy instance Foldable (Pair e) where foldMap f (_ :!: x) = f x instance Traversable (Pair e) where traverse f (e :!: x) = (:!:) e <$> f x instance (Semigroup a, Semigroup b) => Semigroup (Pair a b) where (x1 :!: y1) <> (x2 :!: y2) = (x1 <> x2) :!: (y1 <> y2) instance (Monoid a, Monoid b) => Monoid (Pair a b) where mempty = mempty :!: mempty (x1 :!: y1) `mappend` (x2 :!: y2) = (x1 `mappend` x2) :!: (y1 `mappend` y2) -- deepseq instance (NFData a, NFData b) => NFData (Pair a b) where rnf = rnf . toLazy #if MIN_VERSION_deepseq(1,4,3) instance (NFData a) => NFData1 (Pair a) where liftRnf rnfA = liftRnf rnfA . toLazy instance NFData2 Pair where liftRnf2 rnfA rnfB = liftRnf2 rnfA rnfB . toLazy #endif -- binary instance (Binary a, Binary b) => Binary (Pair a b) where put = put . toLazy get = toStrict <$> get -- bifunctors instance Bifunctor Pair where bimap f g (a :!: b) = f a :!: g b first f (a :!: b) = f a :!: b second g (a :!: b) = a :!: g b instance Bifoldable Pair where bifold (a :!: b) = a `mappend` b bifoldMap f g (a :!: b) = f a `mappend` g b bifoldr f g c (a :!: b) = g b (f a c) bifoldl f g c (a :!: b) = g (f c a) b instance Bitraversable Pair where bitraverse f g (a :!: b) = (:!:) <$> f a <*> g b -- hashable instance (Hashable a, Hashable b) => Hashable (Pair a b) where hashWithSalt salt = hashWithSalt salt . toLazy instance (Hashable a) => Hashable1 (Pair a) where liftHashWithSalt hashA salt = liftHashWithSalt hashA salt . toLazy instance Hashable2 Pair where liftHashWithSalt2 hashA hashB salt = liftHashWithSalt2 hashA hashB salt . toLazy -- assoc #ifdef MIN_VERSION_assoc instance Assoc Pair where assoc ((a :!: b) :!: c) = (a :!: (b :!: c)) unassoc (a :!: (b :!: c)) = ((a :!: b) :!: c) instance Swap Pair where swap = Data.Strict.Tuple.swap #endif -- Data.Functor.Classes #ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 Pair where liftEq2 f g (a :!: b) (a' :!: b') = f a a' && g b b' instance Eq a => Eq1 (Pair a) where liftEq = liftEq2 (==) instance Ord2 Pair where liftCompare2 f g (a :!: b) (a' :!: b') = f a a' `mappend` g b b' instance Ord a => Ord1 (Pair a) where liftCompare = liftCompare2 compare instance Show a => Show1 (Pair a) where liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show2 Pair where liftShowsPrec2 sa _ sb _ d (a :!: b) = showParen (d > 3) -- prints extra parens $ sa 3 a . showString " :!: " . sb 3 b -- | -- -- >>> readsPrec2 0 "'a' :!: ('b' :!: 'c')" :: [(Pair Char (Pair Char Char), String)] -- [('a' :!: ('b' :!: 'c'),"")] -- -- >>> readsPrec2 0 "('a' :!: 'b') :!: 'c'" :: [(Pair (Pair Char Char) Char, String)] -- [(('a' :!: 'b') :!: 'c',"")] -- instance Read2 Pair where liftReadsPrec2 ra _ rb _ d = readParen (d > 3) $ \s -> cons s where cons s0 = do (a, s1) <- ra 3 s0 (":!:", s2) <- lex s1 (b, s3) <- rb 3 s2 return (a :!: b, s3) instance Read a => Read1 (Pair a) where liftReadsPrec = liftReadsPrec2 readsPrec readList #else instance Eq a => Eq1 (Pair a) where eq1 = (==) instance Ord a => Ord1 (Pair a) where compare1 = compare instance Show a => Show1 (Pair a) where showsPrec1 = showsPrec instance Read a => Read1 (Pair a) where readsPrec1 = readsPrec #endif strict-0.5/src/System/IO/0000755000000000000000000000000007346545000013441 5ustar0000000000000000strict-0.5/src/System/IO/Strict.hs0000644000000000000000000000465007346545000015252 0ustar0000000000000000{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO.Strict -- Copyright : (c) Don Stewart 2007 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : dons@galois.com -- Stability : stable -- Portability : portable -- -- The standard IO input functions using strict IO. -- ----------------------------------------------------------------------------- module System.IO.Strict ( -- * Strict Handle IO hGetContents, -- :: Handle -> IO [Char] -- * Strict String IO wrappers getContents, -- :: IO String readFile, -- :: FilePath -> IO String interact -- :: (String -> String) -> IO () ) where import Prelude ( String, (>>=), seq, return, (.), (=<<), FilePath, length) import System.IO (IO) import qualified System.IO as IO -- ----------------------------------------------------------------------------- -- Strict hGetContents -- | Computation 'hGetContents' @hdl@ returns the list of characters -- corresponding to the unread portion of the channel or file managed -- by @hdl@, which is immediate closed. -- -- Items are read strictly from the input Handle. -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. hGetContents :: IO.Handle -> IO.IO String hGetContents h = IO.hGetContents h >>= \s -> length s `seq` return s -- ----------------------------------------------------------------------------- -- Standard IO -- | The 'getContents' operation returns all user input as a single string, -- which is read stirctly (same as 'hGetContents' 'stdin'). getContents :: IO String getContents = hGetContents IO.stdin {-# INLINE getContents #-} -- | The 'interact' function takes a function of type @String->String@ -- as its argument. The entire input from the standard input device is -- passed to this function as its argument, and the resulting string is -- output on the standard output device. interact :: (String -> String) -> IO () interact f = IO.putStr . f =<< getContents {-# INLINE interact #-} -- | The 'readFile' function reads a file and -- returns the contents of the file as a string. -- The file is read strictly, as with 'getContents'. readFile :: FilePath -> IO String readFile name = IO.openFile name IO.ReadMode >>= hGetContents {-# INLINE readFile #-} strict-0.5/strict.cabal0000644000000000000000000000775207346545000013366 0ustar0000000000000000Name: strict Version: 0.5 Synopsis: Strict data types and String IO. Category: Data, System Description: This package provides strict versions of some standard Haskell data types (pairs, Maybe and Either). It also contains strict IO operations. . It is common knowledge that lazy datastructures can lead to space-leaks. This problem is particularly prominent, when using lazy datastructures to store the state of a long-running application in memory. One common solution to this problem is to use @seq@ and its variants in every piece of code that updates your state. However a much easier solution is to use fully strict types to store such state values. By \"fully strict types\" we mean types for whose values it holds that, if they are in weak-head normal form, then they are also in normal form. Intuitively, this means that values of fully strict types cannot contain unevaluated thunks. . To define a fully strict datatype, one typically uses the following recipe. . 1. Make all fields of every constructor strict; i.e., add a bang to all fields. . 2. Use only strict types for the fields of the constructors. . The second requirement is problematic as it rules out the use of the standard Haskell 'Maybe', 'Either', and pair types. This library solves this problem by providing strict variants of these types and their corresponding standard support functions and type-class instances. . Note that this library does currently not provide fully strict lists. They can be added if they are really required. However, in many cases one probably wants to use unboxed or strict boxed vectors from the 'vector' library () instead of strict lists. Moreover, instead of @String@s one probably wants to use strict @Text@ values from the @text@ library (). . This library comes with batteries included; i.e., mirror functions and instances of the lazy versions in @base@. It also includes instances for type-classes from the @deepseq@, @binary@, and @hashable@ packages. License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Simon Meier Maintainer: Don Stewart , Bas van Dijk , Oleg Grenrus , Simon Meier , Ximin Luo Copyright: (c) 2006-2008 by Roman Leshchinskiy (c) 2013-2014 by Simon Meier Homepage: https://github.com/haskell-strict/strict Cabal-Version: >= 1.10 Build-type: Simple extra-source-files: CHANGELOG.md tested-with: GHC ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2 library default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall build-depends: base >= 4.5.0.0 && < 5 , assoc >= 1.1 && < 1.2 , binary >= 0.5.1.0 && < 0.9 , bytestring >= 0.9.2.1 && < 0.12 , deepseq >= 1.3.0.0 && < 1.5 , hashable >= 1.2.7.0 && < 1.5 , text >= 1.2.3.0 && < 1.3 || >=2.0 && <2.1 , these >= 1.2 && < 1.3 , transformers >= 0.3.0.0 && < 0.7 , ghc-prim if !impl(ghc >= 8.0) build-depends: semigroups >= 0.18.5 && < 0.21 , transformers-compat >= 0.6.5 && < 0.8 -- Ensure Data.Functor.Classes is always available if impl(ghc >= 7.10) build-depends: transformers >= 0.4.2.0 if !impl(ghc >= 8.2) build-depends: bifunctor-classes-compat >= 0.1 && < 0.2 exposed-modules: Data.Strict Data.Strict.Classes Data.Strict.These Data.Strict.Tuple Data.Strict.Maybe Data.Strict.Either System.IO.Strict