diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/src/Data/Either/Strict.hs b/src/Data/Either/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Data/Either/Strict.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | Copyright : (c) 2006-2007 Roman Leshchinskiy +-- (c) 2013 Simon Meier +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Simon Meier +-- Stability : experimental +-- Portability : GHC +-- +-- 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.Either.Strict ( + Either(Left, Right) + , isRight + , isLeft + , either + , lefts + , rights + , partitionEithers +) where + +import Data.Strict.Either (Either (Left, Right), either, isLeft, + isRight) +import Prelude hiding (Either (..), either) +import qualified Prelude as L + +import Control.Applicative ((<$>)) +import Control.DeepSeq (NFData (..)) +import Control.Lens.Iso (Strict (..), iso) +import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Binary (Binary (..)) +import Data.Data (Data (..), Typeable2 (..)) +#if __GLASGOW_HASKELL__ >= 706 +import GHC.Generics (Generic (..)) +#endif +import Test.QuickCheck (Arbitrary (..)) + + +-- Utilities +------------ +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 + + +-- missing instances +-------------------- + +deriving instance (Data a, Data b) => Data (Either a b) +deriving instance Typeable2 Either + +#if __GLASGOW_HASKELL__ >= 706 +deriving instance Generic (Either a b) +#endif + + +-- deepseq +instance (NFData a, NFData b) => NFData (Either a b) where + rnf = rnf . toLazy + +-- binary +instance (Binary a, Binary b) => Binary (Either a b) where + put = put . toLazy + get = toStrict <$> get + +-- aeson +instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where + toJSON = toJSON . toLazy + +instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where + parseJSON val = toStrict <$> parseJSON val + +-- quickcheck +instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where + arbitrary = toStrict <$> arbitrary + shrink = map toStrict . shrink . toLazy + +-- lens +instance Strict (L.Either a b) (Either a b) where + strict = iso toStrict toLazy + +-- missing functions +-------------------- + +-- | 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 = + Prelude.foldr (either left right) ([],[]) + where + left a ~(l, r) = (a:l, r) + right a ~(l, r) = (l, a:r) + + +------------------------------------------------------------------------------ +-- Code required to make this module independent of the 'strict' package +------------------------------------------------------------------------------ + +{- +-- | The strict choice type. +-- +-- Note that this type is not an applicative functor, and therefore also no +-- monad. The reasons are the same as the ones explained in the documentation +-- of the strict 'Data.Strict.Maybe.Maybe' type. +data Either a b = Left !a | Right !b + deriving(Eq, Ord, Read, Show) +-} + +{- +instance Functor (Either a) where + fmap f = toStrict . fmap f . toLazy + +instance Foldable (Either a) 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 + +-- | Analogous to 'L.either' in "Data.Either". +either :: (a -> c) -> (b -> c) -> Either a b -> c +either f g = L.either f g . toLazy +-} + +{- +-- | Analogous to 'L.isLeft' in "Data.Either", which will be included in base +-- \> 4.6. +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft (Right _) = False + +-- | Analogous to 'L.isRight' in "Data.Either", which will be included in base +-- \> 4.6. +isRight :: Either a b -> Bool +isRight (Left _) = False +isRight (Right _) = True +-} diff --git a/src/Data/Maybe/Strict.hs b/src/Data/Maybe/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Strict.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | Copyright : (c) 2006-2007 Roman Leshchinskiy +-- (c) 2013 Simon Meier +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Simon Meier +-- Stability : experimental +-- Portability : GHC +-- +-- 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.Maybe.Strict ( + Maybe(Nothing,Just) + , maybe + + , isJust + , isNothing + , fromJust + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe +) where + +import Prelude hiding (Maybe (..), maybe) +import qualified Prelude as L + +import Control.Applicative ((<$>)) +import Control.DeepSeq (NFData (..)) +import Control.Lens.Iso (Strict (..), iso) +import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Binary (Binary (..)) +import Data.Data (Data (..), Typeable1 (..)) +import Data.Monoid (Monoid (..)) +import Data.Strict.Maybe (Maybe (Nothing, Just), fromJust, + fromMaybe, isJust, isNothing, maybe) +#if __GLASGOW_HASKELL__ >= 706 +import GHC.Generics (Generic (..)) +#endif +import Test.QuickCheck (Arbitrary (..)) + + +-- utilities +------------ + +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 + +deriving instance Data a => Data (Maybe a) +deriving instance Typeable1 Maybe + +#if __GLASGOW_HASKELL__ >= 706 +deriving instance Generic (Maybe a) +#endif + +instance Monoid a => Monoid (Maybe a) where + mempty = Nothing + + Nothing `mappend` _ = Nothing + _ `mappend` Nothing = Nothing + Just x1 `mappend` Just x2 = Just (x1 `mappend` x2) + +-- deepseq +instance NFData a => NFData (Maybe a) where + rnf = rnf . toLazy + +-- binary +instance Binary a => Binary (Maybe a) where + put = put . toLazy + get = toStrict <$> get + +-- aeson +instance ToJSON a => ToJSON (Maybe a) where + toJSON = toJSON . toLazy + +instance FromJSON a => FromJSON (Maybe a) where + parseJSON val = toStrict <$> parseJSON val + +-- quickcheck +instance Arbitrary a => Arbitrary (Maybe a) where + arbitrary = toStrict <$> arbitrary + shrink = map toStrict . shrink . toLazy + +-- lens +instance Strict (L.Maybe a) (Maybe a) where + strict = iso toStrict toLazy + + +-- | 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 + +------------------------------------------------------------------------------ +-- Code required to make this module independent of the 'strict' package +------------------------------------------------------------------------------ + +{- +-- | The type of strict optional values. +-- +-- In contrast to the standard lazy 'L.Maybe' type, this 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@. +data Maybe a = Nothing | Just !a + deriving(Eq, Ord, Show, Read, Data, Typeable, Generic) +-} + +-- instances +------------ + +{- +instance StrictType (Maybe a) where + type LazyVariant (Maybe a) = L.Maybe a + + toStrict L.Nothing = Nothing + toStrict (L.Just x) = Just x + + toLazy Nothing = L.Nothing + toLazy (Just x) = L.Just x + +instance Functor Maybe where + fmap f = toStrict . fmap f . toLazy + +instance Foldable Maybe where + foldr f y = Foldable.foldr f y . toLazy + foldl f y = Foldable.foldl f y . toLazy + +instance Traversable Maybe where + traverse _ Nothing = pure Nothing + traverse f (Just x) = Just <$> f x +-} + +{- +-- | Analogous to 'L.isJust' in "Data.Maybe". +isJust :: Maybe a -> Bool +isJust = L.isJust . toLazy + +-- | Analogous to 'L.isNothing' in "Data.Maybe". +isNothing :: Maybe a -> Bool +isNothing = L.isNothing . toLazy + +-- | Analogous to 'L.fromJust' in "Data.Maybe". +fromJust :: Maybe a -> a +fromJust Nothing = error "Data.Strict.Maybe.fromJust: Nothing" +fromJust (Just x) = x + +-- | Analogous to 'L.fromMaybe' in "Data.Maybe". +fromMaybe :: a -> Maybe a -> a +fromMaybe x = L.fromMaybe x . toLazy + +-- | Analogous to 'L.maybe' in "Data.Maybe". +maybe :: b -> (a -> b) -> Maybe a -> b +maybe x f = L.maybe x f . toLazy +-} diff --git a/src/Data/Tuple/Strict.hs b/src/Data/Tuple/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Data/Tuple/Strict.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +----------------------------------------------------------------------------- +-- | Copyright : (c) 2006-2007 Roman Leshchinskiy +-- (c) 2013 Simon Meier +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Simon Meier +-- Stability : experimental +-- Portability : GHC +-- +-- The strict variant of the standard Haskell pairs and the corresponding +-- variants of the functions from "Data.Tuple". +-- +----------------------------------------------------------------------------- + + +module Data.Tuple.Strict ( + Pair(..) + , fst + , snd + , curry + , uncurry + , zip + , unzip +) where + +import Data.Strict.Tuple (Pair ((:!:)), curry, fst, snd, uncurry) +import Prelude hiding (curry, fst, snd, uncurry, unzip, + zip) +import qualified Prelude as L + +import Control.Applicative ((<$>)) +import Control.DeepSeq (NFData (..)) +import Control.Lens.Iso (Strict (..), iso) +import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Binary (Binary (..)) +import Data.Data (Data (..), Typeable2 (..)) +import Data.Monoid (Monoid (..)) +#if __GLASGOW_HASKELL__ >= 706 +import GHC.Generics (Generic (..)) +#endif +import Test.QuickCheck (Arbitrary (..)) + +-- Utilities +------------ + +toStrict :: (a, b) -> Pair a b +toStrict (a, b) = a :!: b + +toLazy :: Pair a b -> (a, b) +toLazy (a :!: b) = (a, b) + + +-- missing instances +-------------------- + +deriving instance (Data a, Data b) => Data (Pair a b) +deriving instance Typeable2 Pair + +-- fails with compiler panic on GHC 7.4.2 +#if __GLASGOW_HASKELL__ >= 706 +deriving instance Generic (Pair a b) +#endif + +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 + +-- binary +instance (Binary a, Binary b) => Binary (Pair a b) where + put = put . toLazy + get = toStrict <$> get + +-- aeson +instance (ToJSON a, ToJSON b) => ToJSON (Pair a b) where + toJSON = toJSON . toLazy + +instance (FromJSON a, FromJSON b) => FromJSON (Pair a b) where + parseJSON val = toStrict <$> parseJSON val + +-- quickcheck +instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where + arbitrary = toStrict <$> arbitrary + shrink = map toStrict . shrink . toLazy + +-- lens +instance Strict (a, b) (Pair a b) where + strict = iso toStrict toLazy + + + +{- To be added once they make it to base + +instance Foldable (Pair e) where + foldMap f (_,x) = f x + +instance Traversable (Pair e) where + traverse f (e,x) = (,) e <$> f x +-} + + +-- missing functions +-------------------- + +-- | Zip for strict pairs (defined with zipWith). +zip :: [a] -> [b] -> [Pair a b] +zip x y = 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 + ) + +------------------------------------------------------------------------------ +-- Code required to make this module independent of the 'strict' package +------------------------------------------------------------------------------ + +{- +-- | The type of strict pairs. Note that +-- +-- > (x :!: _|_) = (_|_ :!: y) = _|_ +data Pair a b = !a :!: !b + deriving(Eq, Ord, Show, Read, Bounded, Ix, Data, Typeable, Generic) + +instance StrictType (Pair a b) where + type LazyVariant (Pair a b) = (a, b) + + toStrict (a, b) = a :!: b + toLazy (a :!: b) = (a, b) + +instance Functor (Pair e) where + fmap f = toStrict . fmap f . toLazy + +-- | 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 +-} + diff --git a/strict-base-types.cabal b/strict-base-types.cabal new file mode 100644 --- /dev/null +++ b/strict-base-types.cabal @@ -0,0 +1,124 @@ +Name: strict-base-types +Version: 0.1 +Synopsis: Strict variants of the types provided in base. +Category: Data +Description: + 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. The easiest + solution to this problem 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., missing instances + for type-classes from the @deepseq@, @binary@, @aeson@, @QuickCheck@, and + @lens@ packages are included. Of particluar interest is the @Strict@ + type-class provided by the lens library + (). + It is used in the following example to simplify the modification of + strict fields. + . + > (-# LANGUAGE TemplateHaskell #-) -- replace with curly braces, + > (-# LANGUAGE OverloadedStrings #-) -- the Haddock prologues are a P.I.T.A! + > + > import Control.Lens ( (.=), Strict(strict), from, Iso', makeLenses) + > import Control.Monad.State.Strict (State) + > import qualified Data.Map as M + > import qualified Data.Maybe.Strict as S + > import qualified Data.Text as T + > + > -- | An example of a state record as it could be used in a (very minimal) + > -- role-playing game. + > data GameState = GameState + > ( _gsCooldown :: !(S.Maybe Int) + > , _gsHealth :: !Int + > ) -- replace with curly braces, *grmbl* + > + > makeLenses ''GameState + > + > -- The isomorphism, which converts a strict field to its lazy variant + > lazy :: Strict lazy strict => Iso' strict lazy + > lazy = from strict + > + > type Game = State GameState + > + > cast :: T.Text -> Game () + > cast spell = + > gsCooldown.lazy .= M.lookup spell spellDuration + > -- ... implement remainder of spell-casting ... + > where + > spellDuration = M.fromList [("fireball", 5)] + . + See + + for a gentle introduction to lenses and state manipulation. + . + Note that this package uses the types provided by the 'strict' package + (), but organizes them a bit + differently. More precisely, the @strict-base-types@ package + . + - only provides the fully strict variants of types from 'base', + . + - is in-sync with the current base library (base-4.6), + . + - provides the missing instances for (future) Haskell platform packages, and + . + - conforms to the standard policy that strictness variants of an existing + datatype are identified by suffixing \'Strict\' or \'Lazy\' in the + module hierarchy. + + +License: BSD3 +License-File: LICENSE +Author: Roman Leshchinskiy , + Simon Meier +Maintainer: Simon Meier +Copyright: (c) 2006-2008 by Roman Leshchinskiy + (c) 2013 by Simon Meier +Homepage: https://github.com/meiersi/strict-base-types +Cabal-Version: >= 1.6 +Build-type: Simple + +source-repository head + type: git + location: https://github.com/meiersi/strict-base-types.git + +library + build-depends: + base >= 4.5 && < 5 + , lens >= 3.9 + , QuickCheck >= 2 + , aeson >= 0.6 + , binary >= 0.5 + , deepseq >= 1.3 + , strict == 0.3.* + , ghc-prim + hs-source-dirs: src + exposed-modules: + Data.Tuple.Strict + Data.Maybe.Strict + Data.Either.Strict + ghc-options: -Wall +