strict-base-types 0.1 → 0.2
raw patch · 4 files changed
+112/−16 lines, 4 filesdep +bifunctorsdep ~basedep ~lens
Dependencies added: bifunctors
Dependency ranges changed: base, lens
Files
- src/Data/Either/Strict.hs +53/−13
- src/Data/Maybe/Strict.hs +11/−0
- src/Data/Tuple/Strict.hs +46/−2
- strict-base-types.cabal +2/−1
src/Data/Either/Strict.hs view
@@ -31,6 +31,8 @@ , lefts , rights , partitionEithers+ , _Left+ , _Right ) where import Data.Strict.Either (Either (Left, Right), either, isLeft,@@ -38,11 +40,17 @@ import Prelude hiding (Either (..), either) import qualified Prelude as L -import Control.Applicative ((<$>))+import Control.Applicative (pure, (<$>)) import Control.DeepSeq (NFData (..))-import Control.Lens.Iso (Strict (..), iso)+import Control.Lens.Iso (Strict (..), Swapped (..), iso)+import Control.Lens.Prism (Prism, prism) import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bifunctor (Bifunctor (..)) import Data.Binary (Binary (..))+import Data.Foldable (Foldable (..))+import Data.Traversable (Traversable (..))+import Data.Bitraversable (Bitraversable (..)) import Data.Data (Data (..), Typeable2 (..)) #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic (..))@@ -71,7 +79,18 @@ deriving instance Generic (Either a b) #endif +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++ -- deepseq instance (NFData a, NFData b) => NFData (Either a b) where rnf = rnf . toLazy@@ -93,10 +112,35 @@ arbitrary = toStrict <$> arbitrary shrink = map toStrict . shrink . toLazy +-- 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)+ bisequenceA = either (fmap Left) (fmap Right)+ -- lens instance Strict (L.Either a b) (Either a b) where strict = iso toStrict toLazy +instance Swapped Either where+ swapped = either Right Left `iso` either Right Left+ -- missing functions -------------------- @@ -116,7 +160,14 @@ left a ~(l, r) = (a:l, r) right a ~(l, r) = (l, a:r) +-- | Analogous to 'Control.Lens.Prism._Left' in "Control.Lens.Prism".+_Left :: Prism (Either a c) (Either b c) a b+_Left = prism Left $ either L.Right (L.Left . Right) +-- | Analogous to 'Control.Lens.Prism._Right' in "Control.Lens.Prism".+_Right :: Prism (Either c a) (Either c b) a b+_Right = prism Right $ either (L.Left . Left) L.Right+ ------------------------------------------------------------------------------ -- Code required to make this module independent of the 'strict' package ------------------------------------------------------------------------------@@ -134,17 +185,6 @@ {- 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
src/Data/Maybe/Strict.hs view
@@ -42,6 +42,8 @@ , maybeToList , catMaybes , mapMaybe+ , _Just+ , _Nothing ) where import Prelude hiding (Maybe (..), maybe)@@ -50,6 +52,7 @@ import Control.Applicative ((<$>)) import Control.DeepSeq (NFData (..)) import Control.Lens.Iso (Strict (..), iso)+import Control.Lens.Prism (Prism, Prism', prism, prism') import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Binary (Binary (..)) import Data.Data (Data (..), Typeable1 (..))@@ -135,6 +138,14 @@ Just r -> r:rs where rs = mapMaybe f xs++-- | Analogous to 'Control.Lens.Prism._Just' in "Control.Lens.Prism"+_Just :: Prism (Maybe a) (Maybe b) a b+_Just = prism Just $ maybe (Left Nothing) Right++-- | Analogous to 'Control.Lens.Prism._Nothing' in "Control.Lens.Prism"+_Nothing :: Prism' (Maybe a) ()+_Nothing = prism' (const Nothing) $ maybe (L.Just ()) (const L.Nothing) ------------------------------------------------------------------------------ -- Code required to make this module independent of the 'strict' package
src/Data/Tuple/Strict.hs view
@@ -1,8 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -----------------------------------------------------------------------------@@ -26,6 +29,7 @@ , snd , curry , uncurry+ , swap , zip , unzip ) where@@ -35,13 +39,21 @@ zip) import qualified Prelude as L -import Control.Applicative ((<$>))+import Control.Applicative (Applicative ((<*>)), (<$>)) import Control.DeepSeq (NFData (..))-import Control.Lens.Iso (Strict (..), iso)+import Control.Lens.Each (Index, Each(..))+import Control.Lens.Iso (Strict (..), Swapped (..), iso)+import Control.Lens.Indexed (indexed)+import Control.Lens.Operators ((<&>))+import Control.Lens.Tuple (Field1 (..), Field2 (..)) import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bifunctor (Bifunctor (..))+import Data.Bitraversable (Bitraversable (..)) import Data.Binary (Binary (..)) import Data.Data (Data (..), Typeable2 (..)) import Data.Monoid (Monoid (..))+import qualified Data.Tuple as L () -- just for haddocks. Is there a better way? #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic (..)) #endif@@ -93,12 +105,40 @@ arbitrary = toStrict <$> arbitrary shrink = map toStrict . shrink . toLazy +-- 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+ bisequenceA (a :!: b) = (:!:) <$> a <*> b+ -- lens instance Strict (a, b) (Pair a b) where strict = iso toStrict toLazy +instance Field1 (Pair a b) (Pair a' b) a a' where+ _1 k (a :!: b) = indexed k (0 :: Int) a <&> \a' -> (a' :!: b) +instance Field2 (Pair a b) (Pair a b') b b' where+ _2 k (a :!: b) = indexed k (1 :: Int) b <&> \b' -> (a :!: b') +instance Swapped Pair where+ swapped = iso swap swap++type instance Index (Pair a b) = Int++instance (Applicative f, a~a', b~b') => Each f (Pair a a') (Pair b b') a b where+ each f (a :!: b) = (:!:) <$> indexed f (0::Int) a <*> indexed f (1::Int) b+ {- To be added once they make it to base instance Foldable (Pair e) where@@ -111,6 +151,10 @@ -- missing functions --------------------++-- | Analagous 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]
strict-base-types.cabal view
@@ -1,5 +1,5 @@ Name: strict-base-types-Version: 0.1+Version: 0.2 Synopsis: Strict variants of the types provided in base. Category: Data Description:@@ -114,6 +114,7 @@ , binary >= 0.5 , deepseq >= 1.3 , strict == 0.3.*+ , bifunctors < 3.3 , ghc-prim hs-source-dirs: src exposed-modules: