diff --git a/protolude.cabal b/protolude.cabal --- a/protolude.cabal +++ b/protolude.cabal @@ -1,5 +1,5 @@ name: protolude -version: 0.1.5 +version: 0.1.6 synopsis: A sensible set of defaults for writing custom Preludes. description: A sensible set of defaults for writing custom Preludes. homepage: https://github.com/sdiehl/protolude @@ -34,8 +34,6 @@ exposed-modules: Protolude Unsafe - - other-modules: Base Applicative Bool @@ -43,11 +41,15 @@ List Monad Show + Conv Either Functor Semiring Bifunctor + Panic + other-modules: + default-extensions: NoImplicitPrelude OverloadedStrings @@ -63,13 +65,12 @@ ghc-prim >= 0.3 && <0.6, safe >= 0.3 && <0.4, async >= 2.1 && <2.2, - deepseq >= 1.3 && <= 1.5, + deepseq >= 1.3 && <1.5, containers >= 0.5 && <0.6, mtl >= 2.1 && <2.3, - transformers >= 0.4 && < 0.6, + transformers >= 0.4 && <0.6, text >= 1.2 && <1.3, stm >= 2.4 && <2.5, - string-conv >= 0.1 && <0.2, bytestring >= 0.10 && <0.11 hs-source-dirs: src diff --git a/src/Base.hs b/src/Base.hs --- a/src/Base.hs +++ b/src/Base.hs @@ -9,7 +9,7 @@ ($!), ) where --- Glorious Glashgow Haskell Compiler +-- Glorious Glasgow Haskell Compiler #if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 ) -- Base GHC types @@ -60,6 +60,23 @@ IsLabel(..) ) +import GHC.ExecutionStack as X ( + Location(..) + , SrcLoc(..) + , getStackTrace + , showStackTrace + ) + +import GHC.Stack as X ( + CallStack + , HasCallStack + , callStack + , prettySrcLoc + , currentCallStack + , getCallStack + , prettyCallStack + ) + {- import GHC.Records as X ( HasField(..) @@ -76,15 +93,5 @@ ($!) :: (a -> b) -> a -> b f $! x = let !vx = x in f vx - -#endif - - --- Simple Haskell Compiler -#if defined(__SHC_HASKELL__) - -import SHC.Prim as X -import SHC.Types as X -import SHC.Classes as X #endif diff --git a/src/Conv.hs b/src/Conv.hs new file mode 100644 --- /dev/null +++ b/src/Conv.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Conv ( + StringConv (..) +, toS +, toSL +, Leniency (..) +) where + +import Data.ByteString.Char8 as B +import Data.ByteString.Lazy.Char8 as LB +import Data.Text as T +import Data.Text.Encoding as T +import Data.Text.Encoding.Error as T +import Data.Text.Lazy as LT +import Data.Text.Lazy.Encoding as LT + +import Base +import Data.Eq (Eq(..)) +import Data.Ord (Ord(..)) +import Data.Function ((.), id) +import Data.String (String) +import Control.Applicative (pure) + +data Leniency = Lenient | Strict + deriving (Eq,Show,Ord,Enum,Bounded) + +class StringConv a b where + strConv :: Leniency -> a -> b + +toS :: StringConv a b => a -> b +toS = strConv Strict + +toSL :: StringConv a b => a -> b +toSL = strConv Lenient + +instance StringConv String String where strConv _ = id +instance StringConv String B.ByteString where strConv _ = B.pack +instance StringConv String LB.ByteString where strConv _ = LB.pack +instance StringConv String T.Text where strConv _ = T.pack +instance StringConv String LT.Text where strConv _ = LT.pack + +instance StringConv B.ByteString String where strConv _ = B.unpack +instance StringConv B.ByteString B.ByteString where strConv _ = id +instance StringConv B.ByteString LB.ByteString where strConv _ = LB.fromChunks . pure +instance StringConv B.ByteString T.Text where strConv = decodeUtf8T +instance StringConv B.ByteString LT.Text where strConv l = strConv l . LB.fromChunks . pure + +instance StringConv LB.ByteString String where strConv _ = LB.unpack +instance StringConv LB.ByteString B.ByteString where strConv _ = B.concat . LB.toChunks +instance StringConv LB.ByteString LB.ByteString where strConv _ = id +instance StringConv LB.ByteString T.Text where strConv l = decodeUtf8T l . strConv l +instance StringConv LB.ByteString LT.Text where strConv = decodeUtf8LT + +instance StringConv T.Text String where strConv _ = T.unpack +instance StringConv T.Text B.ByteString where strConv _ = T.encodeUtf8 +instance StringConv T.Text LB.ByteString where strConv l = strConv l . T.encodeUtf8 +instance StringConv T.Text LT.Text where strConv _ = LT.fromStrict +instance StringConv T.Text T.Text where strConv _ = id + +instance StringConv LT.Text String where strConv _ = LT.unpack +instance StringConv LT.Text T.Text where strConv _ = LT.toStrict +instance StringConv LT.Text LT.Text where strConv _ = id +instance StringConv LT.Text LB.ByteString where strConv _ = LT.encodeUtf8 +instance StringConv LT.Text B.ByteString where strConv l = strConv l . LT.encodeUtf8 + +decodeUtf8T :: Leniency -> B.ByteString -> T.Text +decodeUtf8T Lenient = T.decodeUtf8With T.lenientDecode +decodeUtf8T Strict = T.decodeUtf8With T.strictDecode + +decodeUtf8LT :: Leniency -> LB.ByteString -> LT.Text +decodeUtf8LT Lenient = LT.decodeUtf8With T.lenientDecode +decodeUtf8LT Strict = LT.decodeUtf8With T.strictDecode diff --git a/src/Debug.hs b/src/Debug.hs --- a/src/Debug.hs +++ b/src/Debug.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Unsafe #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} module Debug ( @@ -12,23 +12,19 @@ notImplemented, ) where -import Data.String (String) +import Data.Text (Text, unpack) import Control.Monad (Monad, return) import qualified Base as P import qualified Debug.Trace as T -{-# WARNING undefined "'undefined' remains in code" #-} -undefined :: a -undefined = P.undefined - {-# WARNING error "'error' remains in code" #-} -error :: String -> a -error = P.error +error :: Text -> a +error s = P.error (unpack s) {-# WARNING trace "'trace' remains in code" #-} -trace :: String -> a -> a -trace = T.trace +trace :: Text -> a -> a +trace s = T.trace (unpack s) {-# WARNING traceShow "'traceShow' remains in code" #-} traceShow :: P.Show a => a -> b -> b @@ -36,16 +32,18 @@ {-# WARNING traceShowM "'traceShowM' remains in code" #-} traceShowM :: (P.Show a, Monad m) => a -> m () -traceShowM a = traceM (P.show a) +traceShowM a = T.trace (P.show a) (return ()) {-# WARNING traceM "'traceM' remains in code" #-} -traceM :: (Monad m) => String -> m () -traceM s = T.trace s (return ()) +traceM :: (Monad m) => Text -> m () +traceM s = T.trace (unpack s) (return ()) {-# WARNING traceIO "'traceIO' remains in code" #-} -traceIO :: String -> P.IO () -traceIO = T.traceIO +traceIO :: Text -> P.IO () +traceIO s = T.traceIO (unpack s) -{-# WARNING notImplemented "'notImplemented' remains in code" #-} notImplemented :: a notImplemented = P.error "Not implemented" + +undefined :: a +undefined = P.undefined diff --git a/src/Functor.hs b/src/Functor.hs --- a/src/Functor.hs +++ b/src/Functor.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE NoImplicitPrelude #-} module Functor ( diff --git a/src/Panic.hs b/src/Panic.hs new file mode 100644 --- /dev/null +++ b/src/Panic.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Panic ( + FatalError(..), + panic, +) where + +import Base (Show) +import Data.Text (Text) +import Data.Typeable (Typeable) +import Control.Exception as X + +-- | Uncatchable exceptions thrown and never caught. +data FatalError = FatalError { msg :: Text } + deriving (Show, Typeable) + +instance Exception FatalError + +panic :: Text -> a +panic a = throw (FatalError a) diff --git a/src/Protolude.hs b/src/Protolude.hs --- a/src/Protolude.hs +++ b/src/Protolude.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ExplicitNamespaces #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} @@ -11,6 +12,7 @@ map, (&), uncons, + unsnoc, applyN, print, show, @@ -27,19 +29,27 @@ import Functor as X import Either as X import Applicative as X +import Conv as X +import Panic as X import Base as Base hiding ( - putStr - , putStrLn - , print - , show - , error - , undefined + putStr -- Overriden by Show.putStr + , putStrLn -- Overriden by Show.putStrLn + , print -- Overriden by Protolude.print + , error -- Overriden by Debug.error + , undefined -- Overriden by Debug.undefined + , show -- Overriden by Protolude.show + , showFloat -- Custom Show instances deprecated. + , showList -- Custom Show instances deprecated. + , showSigned -- Custom Show instances deprecated. + , showSignedFloat -- Custom Show instances deprecated. + , showsPrec -- Custom Show instances deprecated. ) import qualified Base as PBase --- Used for 'show' +-- Used for 'show', not exported. import Data.String (String) +import Data.String as X (IsString) -- Maybe'ized version of partial functions import Safe as X ( @@ -226,7 +236,10 @@ -- Base types import Data.Int as X -import Data.Bits as X +import Data.Bits as X hiding ( + unsafeShiftL + , unsafeShiftR + ) import Data.Word as X import Data.Either as X import Data.Complex as X @@ -272,41 +285,51 @@ -- Text import Data.Text as X (Text) import qualified Data.Text.Lazy -import qualified Data.Text.IO -import Data.Text.Lazy ( - toStrict - , fromStrict +import Data.Text.IO as X ( + getLine + , getContents + , interact + , readFile + , writeFile + , appendFile ) -import Data.String.Conv as X ( - strConv - , toS - , toSL - , Leniency(..) - , StringConv +import Data.Text.Lazy as X ( + toStrict + , fromStrict ) -import Data.String as X (IsString) - --- Printf -import Text.Printf as X ( - PrintfArg - , printf - , hPrintf +import Data.Text.Encoding as X ( + encodeUtf8 + , decodeUtf8 + , decodeUtf8' + , decodeUtf8With ) -- IO import System.Exit as X ---import System.Info as X import System.Environment as X (getArgs) -import System.IO as X (Handle) +import System.IO as X ( + Handle + , FilePath + , IOMode(..) + , stdin + , stdout + , stderr + , withFile + , openFile + ) -- ST import Control.Monad.ST as X -- Concurrency and Parallelism -import Control.Exception as X +import Control.Exception as X hiding ( + throw + , assert + , displayException + ) import Control.Monad.STM as X import Control.Concurrent as X import Control.Concurrent.Async as X @@ -340,6 +363,13 @@ uncons [] = Nothing uncons (x:xs) = Just (x, xs) +unsnoc :: [x] -> Maybe ([x],x) +unsnoc = foldr go Nothing + where + go x mxs = Just (case mxs of + Nothing -> ([], x) + Just (xs, e) -> (x:xs, e)) + applyN :: Int -> (a -> a) -> a -> a applyN n f = X.foldr (.) identity (X.replicate n f) @@ -348,6 +378,8 @@ show :: (Show a, StringConv String b) => a -> b show x = toS (PBase.show x) -{-# SPECIALIZE show :: Show a => a -> String #-} {-# SPECIALIZE show :: Show a => a -> Text #-} {-# SPECIALIZE show :: Show a => a -> LText #-} +{-# SPECIALIZE show :: Show a => a -> ByteString #-} +{-# SPECIALIZE show :: Show a => a -> LByteString #-} +{-# SPECIALIZE show :: Show a => a -> String #-} diff --git a/src/Unsafe.hs b/src/Unsafe.hs --- a/src/Unsafe.hs +++ b/src/Unsafe.hs @@ -6,13 +6,15 @@ unsafeTail, unsafeInit, unsafeLast, - fromJust, + unsafeFromJust, unsafeIndex, + unsafeThrow, ) where import Base (Int) import qualified Data.List as List import qualified Data.Maybe as Maybe +import qualified Control.Exception as Exc unsafeHead :: [a] -> a unsafeHead = List.head @@ -26,8 +28,11 @@ unsafeLast :: [a] -> a unsafeLast = List.last -fromJust :: Maybe.Maybe a -> a -fromJust = Maybe.fromJust +unsafeFromJust :: Maybe.Maybe a -> a +unsafeFromJust = Maybe.fromJust unsafeIndex :: [a] -> Int -> a unsafeIndex = (List.!!) + +unsafeThrow :: Exc.Exception e => e -> a +unsafeThrow = Exc.throw