From 0e110e8376f60a075b00f8bacd6dbd7280a198fa Mon Sep 17 00:00:00 2001 From: Veronika Romashkina Date: Fri, 20 Jul 2018 17:51:00 +0800 Subject: [PATCH] [#18] Add LazyStrict type class (#33) * [#18] Add LazyStrict type class * Remove map = fmap, reexport from Data.List --- CHANGELOG.md | 3 ++ README.md | 1 - src/Universum/Functor/Fmap.hs | 28 ++++++------------- src/Universum/List/Reexport.hs | 4 +-- src/Universum/String/Conversion.hs | 44 ++++++++++++++++++++++++++---- src/Universum/String/Reexport.hs | 2 -- 6 files changed, 52 insertions(+), 30 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8fc38931..c654b0db 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,9 @@ Change log `whenLeft_` and `whenRight_`, `whenLeftM_` and `whenRightM_`. Add `whenLeft`, `whenRight`, `whenLeftM`, `whenRightM` which return the value. +* [#18](https://github.com/kowainik/universum/issues/18): + Add `LazyStrict` type class for conversions. +* `map` is not `fmap` anymore. Reexport `map` from `Data.List` `universum` uses [PVP Versioning][1]. diff --git a/README.md b/README.md index 30136829..c27890c1 100644 --- a/README.md +++ b/README.md @@ -125,7 +125,6 @@ Gotchas [↑](#structure-of-this-tutorial) * `head`, `tail`, `last`, `init` work with `NonEmpty a` instead of `[a]`. * Safe analogue for `head` function: `safeHead :: [a] -> Maybe a`. * `undefined` triggers a compiler warning, which is probably not what you want. Either use `throwIO`, `Except`, `error` or `bug`. -* `map` is `fmap` now. * Multiple sorting functions are available without imports: + `sortBy :: (a -> a -> Ordering) -> [a] -> [a]`: sorts list using given custom comparator. + `sortWith :: Ord b => (a -> b) -> [a] -> [a]`: sorts a list based on some property of its elements. diff --git a/src/Universum/Functor/Fmap.hs b/src/Universum/Functor/Fmap.hs index 57928afb..479bea07 100644 --- a/src/Universum/Functor/Fmap.hs +++ b/src/Universum/Functor/Fmap.hs @@ -1,33 +1,21 @@ {-# LANGUAGE Safe #-} +{- +Copyright: (c) 2016 Stephen Diehl + (c) 20016-2018 Serokell + (c) 2018 Kowainik +License: MIT +-} + -- | This module contains useful functions to work with 'Functor' type class. module Universum.Functor.Fmap - ( map - , (<<$>>) + ( (<<$>>) ) where import Universum.Function ((.)) import Universum.Functor.Reexport (Functor (..)) --- $setup --- >>> import Universum.Base (negate) --- >>> import Universum.Bool (Bool (..), not) --- >>> import Universum.Lifted (getLine) --- >>> import Universum.Monad (Maybe (..)) --- >>> import Universum.String (toString) - -{- | 'Prelude.map' generalized to 'Functor'. - ->>> map not (Just True) -Just False ->>> map not [True,False,True,True] -[False,True,False,False] - --} -map :: Functor f => (a -> b) -> f a -> f b -map = fmap - -- $setup -- >>> import Universum.Base (negate) -- >>> import Universum.Monad (Maybe (..)) diff --git a/src/Universum/List/Reexport.hs b/src/Universum/List/Reexport.hs index a9ffca30..bf001081 100644 --- a/src/Universum/List/Reexport.hs +++ b/src/Universum/List/Reexport.hs @@ -10,8 +10,8 @@ module Universum.List.Reexport import Data.List (break, cycle, drop, dropWhile, filter, genericDrop, genericLength, genericReplicate, genericSplitAt, genericTake, group, inits, intercalate, - intersperse, isPrefixOf, iterate, permutations, repeat, replicate, reverse, scanl, - scanr, sort, sortBy, sortOn, splitAt, subsequences, tails, take, takeWhile, + intersperse, isPrefixOf, iterate, map, permutations, repeat, replicate, reverse, + scanl, scanr, sort, sortBy, sortOn, splitAt, subsequences, tails, take, takeWhile, transpose, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++)) import Data.List.NonEmpty (NonEmpty (..), head, init, last, nonEmpty, tail) diff --git a/src/Universum/String/Conversion.hs b/src/Universum/String/Conversion.hs index c97dc6a9..1bc2b7ad 100644 --- a/src/Universum/String/Conversion.hs +++ b/src/Universum/String/Conversion.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} {- Copyright: (c) 2016 Stephen Diehl @@ -27,6 +28,9 @@ module Universum.String.Conversion , ToString (..) , ToLText (..) , ToText (..) + , LazyStrict (..) + , fromLazy + , fromStrict -- * Show and read functions , readEither @@ -183,3 +187,33 @@ show x = fromString (Show.show x) {-# SPECIALIZE show :: Show.Show a => a -> ByteString #-} {-# SPECIALIZE show :: Show.Show a => a -> LByteString #-} {-# SPECIALIZE show :: Show.Show a => a -> String #-} + + +-- | Type class for lazy-strict conversions. +class LazyStrict l s | l -> s, s -> l where + toLazy :: s -> l + toStrict :: l -> s + +fromLazy :: LazyStrict l s => l -> s +fromLazy = toStrict +{-# INLINE fromLazy #-} +{-# SPECIALIZE fromLazy :: LByteString -> ByteString #-} +{-# SPECIALIZE fromLazy :: LText -> Text #-} + +fromStrict :: LazyStrict l s => s -> l +fromStrict = toLazy +{-# INLINE fromStrict #-} +{-# SPECIALIZE fromStrict :: ByteString -> LByteString #-} +{-# SPECIALIZE fromStrict :: Text -> LText #-} + +instance LazyStrict LByteString ByteString where + toLazy = LB.fromStrict + {-# INLINE toLazy #-} + toStrict = LB.toStrict + {-# INLINE toStrict #-} + +instance LazyStrict LText Text where + toLazy = LT.fromStrict + {-# INLINE toLazy #-} + toStrict = LT.toStrict + {-# INLINE toStrict #-} diff --git a/src/Universum/String/Reexport.hs b/src/Universum/String/Reexport.hs index a93b21dc..b0b75682 100644 --- a/src/Universum/String/Reexport.hs +++ b/src/Universum/String/Reexport.hs @@ -6,7 +6,6 @@ module Universum.String.Reexport -- * Text , module Data.Text - , module Data.Text.Lazy , module Data.Text.Encoding , module Data.Text.Encoding.Error , module Text.Read @@ -21,5 +20,4 @@ import Data.Text (Text, lines, unlines, unwords, words) import Data.Text.Encoding (decodeUtf8', decodeUtf8With) import Data.Text.Encoding.Error (OnDecodeError, OnError, UnicodeException, lenientDecode, strictDecode) -import Data.Text.Lazy (fromStrict, toStrict) import Text.Read (Read, readMaybe, reads)