diff --git a/CHANGES.md b/CHANGES.md index 04185c86c..d16824fd2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,13 @@ +0.2.2 +===== + +* Add explicit `witness` function for use as type witness without warnings. + Makes undefined semantically distinguishable from type witnesses. +* Backwards compatible `Protolude.Safe` module for explicit handling of partial + list operations. +* Export `minimumDef`, `maximumDef`. +* Looser lower-bound on Data.Kind export for GHC 8.0.x. + 0.2.1 ==== diff --git a/protolude.cabal b/protolude.cabal index 8cee067c0..e87335c9d 100644 --- a/protolude.cabal +++ b/protolude.cabal @@ -7,7 +7,7 @@ license: MIT 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 @@ -51,6 +51,7 @@ library Protolude.CallStack Protolude.Error Protolude.Panic + Protolude.Safe default-extensions: NoImplicitPrelude @@ -78,12 +79,5 @@ library mtl-compat >= 0.2 && <0.3, transformers-compat >= 0.4 && <0.7 - if impl(ghc >= 7.8.0) - build-depends: - safe >= 0.3 && <0.4 - else - build-depends: - safe >= 0.3 && <0.3.10 - hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Debug.hs b/src/Debug.hs index b0d760380..292adbf9c 100644 --- a/src/Debug.hs +++ b/src/Debug.hs @@ -12,6 +12,7 @@ module Debug ( traceShowId, traceShowM, notImplemented, + witness, ) where import Data.Text (Text, unpack) @@ -63,3 +64,6 @@ notImplemented = error "Not implemented" {-# 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 index 585187c82..a7d040edc 100644 --- a/src/Protolude.hs +++ b/src/Protolude.hs @@ -65,7 +65,7 @@ import Data.String (String) 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 +78,11 @@ import Safe as X ( , lastMay , foldr1May , foldl1May + , foldl1May' , maximumMay , minimumMay + , maximumDef + , minimumDef , atMay , atDef ) diff --git a/src/Protolude/Safe.hs b/src/Protolude/Safe.hs new file mode 100644 index 000000000..a3c2ff2e7 --- /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