Rework Safe Module (#83)

* Initial fork on minimal safe submodule

* Add new Safe module

Signed-off-by: Stephen Diehl <stephen.m.diehl@gmail.com>

* Refactor Safe module

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
 ====
 

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

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"

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
   )

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