diff --git a/protolude.cabal b/protolude.cabal --- a/protolude.cabal +++ b/protolude.cabal @@ -1,5 +1,5 @@ name: protolude -version: 0.2.1 +version: 0.2.2 synopsis: A small prelude. description: A sensible set of defaults for writing custom Preludes. homepage: https://github.com/sdiehl/protolude @@ -7,7 +7,7 @@ license-file: LICENSE author: Stephen Diehl maintainer: stephen.m.diehl@gmail.com -copyright: 2016-2017 Stephen Diehl +copyright: 2016-2018 Stephen Diehl category: Prelude build-type: Simple cabal-version: >=1.10 @@ -24,10 +24,9 @@ GHC == 7.10.2, GHC == 7.10.3, GHC == 8.0.1, - GHC == 8.2.1 + GHC == 8.2.1, + GHC == 8.4.1 -description: - A sensible set of defaults for writing custom Preludes. Source-Repository head type: git location: git@github.com:sdiehl/protolude.git @@ -52,6 +51,7 @@ Protolude.CallStack Protolude.Error Protolude.Panic + Protolude.Safe default-extensions: NoImplicitPrelude @@ -64,10 +64,10 @@ -fwarn-implicit-prelude build-depends: - base >= 4.6 && <4.11, + base >= 4.6 && <4.12, array >= 0.4 && <0.6, ghc-prim >= 0.3 && <0.6, - async >= 2.0 && <2.2, + async >= 2.0 && <2.3, deepseq >= 1.3 && <1.5, containers >= 0.5 && <0.6, hashable >= 1.2 && <1.3, @@ -77,14 +77,7 @@ bytestring >= 0.10 && <0.11, mtl >= 2.1 && <2.3, mtl-compat >= 0.2 && <0.3, - transformers-compat >= 0.4 && <0.6 - - if impl(ghc >= 7.8.0) - build-depends: - safe >= 0.3 && <0.4 - else - build-depends: - safe >= 0.3 && <0.3.10 + transformers-compat >= 0.4 && <0.7 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Debug.hs b/src/Debug.hs --- a/src/Debug.hs +++ b/src/Debug.hs @@ -12,6 +12,7 @@ traceShowId, traceShowM, notImplemented, + witness, ) where import Data.Text (Text, unpack) @@ -63,3 +64,6 @@ {-# WARNING undefined "'undefined' remains in code" #-} undefined :: a undefined = error "Prelude.undefined" + +witness :: a +witness = error "Type witness should not be evaluated" diff --git a/src/Protolude.hs b/src/Protolude.hs --- a/src/Protolude.hs +++ b/src/Protolude.hs @@ -17,7 +17,6 @@ print, throwIO, throwTo, - foreach, (<&>), show, pass, guarded, @@ -65,7 +64,7 @@ import Data.String as X (IsString) -- Maybe'ized version of partial functions -import Safe as X ( +import Protolude.Safe as X ( headMay , headDef , initMay @@ -78,8 +77,11 @@ , lastMay , foldr1May , foldl1May + , foldl1May' , maximumMay , minimumMay + , maximumDef + , minimumDef , atMay , atDef ) @@ -586,16 +588,6 @@ throwTo :: (X.MonadIO m, Exception e) => ThreadId -> e -> m () throwTo tid e = liftIO (Control.Exception.throwTo tid e) - -foreach :: Functor f => f a -> (a -> b) -> f b -foreach = flip fmap - --- | Infix version of foreach. --- --- @<&>@ is to '<$>' what '&' is to '$'. -infixl 4 <&> -(<&>) :: Functor f => f a -> (a -> b) -> f b -(<&>) = foreach -- | Do nothing returning unit inside applicative. pass :: Applicative f => f () diff --git a/src/Protolude/Base.hs b/src/Protolude/Base.hs --- a/src/Protolude/Base.hs +++ b/src/Protolude/Base.hs @@ -96,6 +96,7 @@ , prettyCallStack , withFrozenCallStack ) +#endif #if ( __GLASGOW_HASKELL__ >= 710 ) import GHC.TypeLits as X ( @@ -117,13 +118,13 @@ import GHC.Records as X ( HasField(..) ) +#endif +#if ( __GLASGOW_HASKELL__ >= 800 ) import Data.Kind as X ( type (*) , type Type ) -#endif - #endif -- Default Prelude defines this at the toplevel module, so we do as well. diff --git a/src/Protolude/Functor.hs b/src/Protolude/Functor.hs --- a/src/Protolude/Functor.hs +++ b/src/Protolude/Functor.hs @@ -7,11 +7,18 @@ ($>), (<$>), (<<$>>), + (<&>), void, + foreach, ) where import Data.Function ((.)) +import Data.Function (flip) +#if MIN_VERSION_base(4,11,0) +import Data.Functor ((<&>)) +#endif + #if MIN_VERSION_base(4,7,0) import Data.Functor ( Functor(..) @@ -25,7 +32,6 @@ , (<$>) ) -import Data.Function (flip) infixl 4 $> @@ -40,3 +46,16 @@ (<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) (<<$>>) = fmap . fmap + +foreach :: Functor f => f a -> (a -> b) -> f b +foreach = flip fmap + +#if !MIN_VERSION_base(4,11,0) +-- | Infix version of foreach. +-- +-- @<&>@ is to '<$>' what '&' is to '$'. + +infixl 1 <&> +(<&>) :: Functor f => f a -> (a -> b) -> f b +(<&>) = foreach +#endif diff --git a/src/Protolude/Safe.hs b/src/Protolude/Safe.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Safe.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Safe ( + headMay + , headDef + , initMay + , initDef + , initSafe + , tailMay + , tailDef + , tailSafe + , lastDef + , lastMay + , foldr1May + , foldl1May + , foldl1May' + , maximumMay + , minimumMay + , maximumDef + , minimumDef + , atMay + , atDef +) where + + +import Data.Ord (Ord(..)) +import Data.Int (Int) +import Data.Char (Char) +import Data.Bool (Bool, otherwise) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Either (Either(..)) +import Data.Function ((.)) +import Data.List (null, head, last, tail, init, maximum, minimum, foldr1, foldl1, foldl1', (++)) + +import GHC.Num ((-)) +import GHC.Show (show) + +liftMay :: (a -> Bool) -> (a -> b) -> (a -> Maybe b) +liftMay test f val = if test val then Nothing else Just (f val) + +------------------------------------------------------------------------------- +-- Head +------------------------------------------------------------------------------- + +headMay :: [a] -> Maybe a +headMay = liftMay null head + +headDef :: a -> [a] -> a +headDef def = fromMaybe def . headMay + +------------------------------------------------------------------------------- +-- Init +------------------------------------------------------------------------------- + +initMay :: [a] -> Maybe [a] +initMay = liftMay null init + +initDef :: [a] -> [a] -> [a] +initDef def = fromMaybe def . initMay + +initSafe :: [a] -> [a] +initSafe = initDef [] + +------------------------------------------------------------------------------- +-- Tail +------------------------------------------------------------------------------- + +tailMay :: [a] -> Maybe [a] +tailMay = liftMay null tail + +tailDef :: [a] -> [a] -> [a] +tailDef def = fromMaybe def . tailMay + +tailSafe :: [a] -> [a] +tailSafe = tailDef [] + +------------------------------------------------------------------------------- +-- Last +------------------------------------------------------------------------------- + +lastMay :: [a] -> Maybe a +lastMay = liftMay null last + +lastDef :: a -> [a] -> a +lastDef def = fromMaybe def . lastMay + +------------------------------------------------------------------------------- +-- Maximum +------------------------------------------------------------------------------- + +minimumMay, maximumMay :: Ord a => [a] -> Maybe a +minimumMay = liftMay null minimum +maximumMay = liftMay null maximum + +minimumDef, maximumDef :: Ord a => a -> [a] -> a +minimumDef def = fromMaybe def . minimumMay +maximumDef def = fromMaybe def . maximumMay + +------------------------------------------------------------------------------- +-- Foldr +------------------------------------------------------------------------------- + +foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a +foldr1May = liftMay null . foldr1 + +------------------------------------------------------------------------------- +-- Foldl +------------------------------------------------------------------------------- + +foldl1May = liftMay null . foldl1 +foldl1May' = liftMay null . foldl1' + +------------------------------------------------------------------------------- +-- At +------------------------------------------------------------------------------- + +at_ :: [a] -> Int -> Either [Char] a +at_ ys o + | o < 0 = Left ("index must not be negative, index=" ++ show o) + | otherwise = f o ys + where + f 0 (x:_) = Right x + f i (_:xs) = f (i-1) xs + f i [] = Left ("index too large, index=" ++ show o ++ ", length=" ++ show (o-i)) + +atMay :: [a] -> Int -> Maybe a +atMay xs i = case xs `at_` i of + Left _ -> Nothing + Right val -> Just val + +atDef :: a -> [a] -> Int -> a +atDef def xs i = case xs `at_` i of + Left _ -> def + Right val -> val