diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,143 @@ +0.3.3 +===== +* GHC 9.4.4 support + +0.3.2 +===== +* GHC 9.2.2 support +* Drop export executable + +0.3.1 +===== +* GHC 9.0.1 and 9.2.1 support +* Add `HasCallStack` to unsafe* functions. +* Banish `String` on `readMaybe` and `readEither`. + +0.3.0 +===== + +* GHC 8.10.1 support +* Use `Protolude.ConvertText` as the default string conversion class. This + removes partial functions when converting to/from ByteStrings. +* Provide `Protolude.Conv` as a compatibility layer for old string conversion + interface. +* Migrated `Debug` and `Unsafe` to `Protolude.Debug` and `Protolude.Unsafe`. +* Export Unicode functions: + - `intToDigit` + - `isAlpha` + - `isAlphaNum` + - `isAscii` + - `isControl` + - `isDigit` + - `isHexDigit` + - `isLetter` + - `isLower` + - `isPrint` + - `isSpace` + - `isUpper` +* Export `MonadFail` class. +* Export `gcast` from Data.Typeable. +* Export `typeOf` from Data.Typeable. +* Export `Handler` from Control.Exception. +* Export `yield` from Control.Concurrency. +* Provide compatibility module `Protolude.Partial` as single export for unsafe + partial functions with the same naming conventions as Prelude. + +0.2.4 +===== + +* GHC 8.8.1 support + +0.2.3 +===== + +* GHC 8.6.1 support +* Export `fromLeft` and `fromRight`. +* Mask `always` and `alwaysSucceeds` from STM export for stm-2.5. + +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 +==== + +* Exposes `throwE` and `catchE`. +* Add `transformers-compat` for old versions of transformers that require + `throwE`, `catchE`. +* Fix `safe` version bounds for new versions. +* Add `mapExceptT and `withExceptT`. +* Export `scanl'` and provide shim for backwards compatibility. +* Add `putErrLn`. +* Expose `RealFloat`. +* Expose `GHC.Records` exports for GHC 8.2 and above. + +0.2 +==== + +* Expose `Symbol` and `Nat` types from `GHC.TypeLits` by default. +* Switch exported `(<>)` to be from `Data.Monoid` instead of Semigroup. +* Expose `putByteString` and `putLByteString` monomorphic versions of `putStrLn` functions +* Export `genericLength` and other generic list return functions. +* Rename `msg` to `fatalErrorMessage`. +* Export `ExceptT`, `ReaderT`, and `StateT` constructors. +* Mask `displayException` from default exports. +* Mask `stToIO` from default exports. +* Export `NonEmpty` type and constructor for Base 4.9 only. +* Export `Data.Semigroup` type and functions for Base 4.9 only. +* Restrict exported symbols from ``async`` to set available in 2.0. +* Add `(&&^)`, `(||^)`, `(<&&>)`, `(<||>)` +* Expose `unzip`. +* Export `maximumMay` and `minimumMay`. +* Mask `Type` export from `Data.Kind`. +* Wrap `die` to take `Text` argument instead of `[Char]`. +* Export constructors `GHC.Generics`: `(:+:)`, `(:*:)`, and `(:.:)`. +* Expose `StablePtr`, `IntPtr` and `WordPtr` types. + +0.1.9 +==== + +* Make `sum` and `product` strict + +0.1.8 +===== + +* ``foreach`` for applicative traversals. +* ``hush`` function for error handling. +* ``tryIO`` function for error handling. +* ``pass`` function for noop applicative branches. +* Mask ``Handler`` typeclass export. +* Mask ``yield`` function export. + +0.1.7 +===== + +* Exports monadic ``(>>)`` operator by default. +* Adds ``traceId`` and ``traceShowId`` functions. +* Exports``reader`` and ``state`` functions by default. +* Export lifted ``throwIO`` and ``throwTo`` functions. + +0.1.6 +===== + +* Adds uncatchable panic exception throwing using Text message. +* Removes ``printf`` +* Removes ``string-conv`` dependency so Stack build works without ``extra-deps``. +* Brings ``Callstack`` machinery in for GHC 8.x. +* Removes ``throw`` and ``assert`` from ``Control.Exception`` exports. +* Removes ``unsafeShiftL`` and ``unsafeShiftR`` from ``Data.Bits`` exports. +* Reexport ``throw`` as ``unsafeThrow`` via Unsafe module. +* Hides all Show class functions. Only the Class itself is exported. Forbids custom instances that are not GHC derived. +* Export`` encodeUtf8`` and ``decodeUtf8`` functions by default. +* Adds ``unsnoc`` function. + +0.1.5 +===== + +* Initial release. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2016, Stephen Diehl +Copyright (c) 2016-2020, Stephen Diehl Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,220 @@ +Protolude +========= + +[![Build Status](https://github.com/protolude/protolude/workflows/Cabal%20CI/badge.svg)](https://github.com/protolude/protolude/actions) +[![Build Status](https://github.com/protolude/protolude/workflows/Stack%20CI/badge.svg)](https://github.com/protolude/protolude/actions) +[![Build Status](https://github.com/protolude/protolude/workflows/Nix%20CI/badge.svg)](https://github.com/protolude/protolude/actions) +[![Hackage](https://img.shields.io/hackage/v/protolude.svg)](https://hackage.haskell.org/package/protolude) + +A sensible starting Prelude for building custom Preludes. + +Design points: + +* Banishes String. +* Banishes partial functions. +* Compiler warning on bottoms. +* Polymorphic string IO functions. +* Polymorphic show. +* Automatic string conversions. +* Types for common data structures in scope. +* Types for all common string types (Text/ByteString) in scope. +* Banishes impure exception throwing outside of IO. +* StateT/ReaderT/ExceptT transformers in scope by default. +* Foldable / Traversable functions in scope by default. +* Unsafe functions are prefixed with "unsafe" in separate module. +* Compiler agnostic, GHC internal modules are abstracted out into Base. +* ``sum`` and ``product`` are strict by default. +* Includes Semiring for GHC >= 7.6. +* Includes Bifunctor for GHC >= 7.6. +* Includes Semigroup for GHC >= 7.6. + +Supports: + + * GHC 7.6.3 + * GHC 7.8.4 + * GHC 7.10.3 + * GHC 8.0.2 + * GHC 8.2.2 + * GHC 8.4.1 + * GHC 8.4.4 + * GHC 8.6.1 + * GHC 8.6.4 + * GHC 8.6.5 + * GHC 8.8.1 + * GHC 8.10.1 + * GHC 9.0.1 + * GHC 9.2.1 + +Stack LTS: + +* lts-6.x +* lts-7.x +* lts-8.x +* lts-9.x +* lts-10.x +* lts-11.x +* lts-12.x +* lts-13.x +* lts-14.x +* lts-15.x +* lts-16.x +* lts-17.x +* lts-18.x +* lts-19.14 and higher + +Usage +----- + +To try out standalone prelude at the interactive shell, from the Protolude +project directory run. + +```haskell +$ stack repl +> import Protolude +``` + +Swapping out the old Prelude +---------------------------- + +Disable the built-in prelude at the top of your file: + +```haskell +{-# LANGUAGE NoImplicitPrelude #-} +``` + +Or directly in your project cabal file: + +```haskell +default-extensions: NoImplicitPrelude +``` + +Then in your modules: + +```haskell +import Protolude +``` + +Dependencies +------------ + +Protolude tries to be light on dependencies and only pulls in *essential* +libraries that are universally common across most real-world projects. Lower and +upper bounds are fully specified and compatible with both vanilla Cabal and +tracks Stack LTS resolver. + +| Dependencies | Lower (>=) | Upper (<) | +| ----------- | -------- | -------- | +| array | 0.4 | 0.6 | +| async | 2.0 | 2.3 | +| base | 4.6 | 4.16 | +| bytestring | 0.10 | 0.11 | +| containers | 0.5 | 0.7 | +| deepseq | 1.3 | 1.5 | +| ghc-prim | 0.3 | 0.7 | +| hashable | 1.2 | 1.4 | +| mtl | 2.1 | 2.3 | +| stm | 2.4 | 2.6 | +| text | 1.2 | 1.3 | +| transformers | 0.4 | 0.6 | +| fail | 4.9 | 4.10 | + +Structure +--------- + +Protolude's main modules are the following: + +* [Protolude.hs](https://github.com/sdiehl/protolude/blob/master/src/Protolude.hs) +* [Base.hs](https://github.com/sdiehl/protolude/blob/master/src/Protolude/Base.hs) +* [Show.hs](https://github.com/sdiehl/protolude/blob/master/src/Protolude/Show.hs) +* [Conv.hs](https://github.com/sdiehl/protolude/blob/master/src/Protolude/Conv.hs) + +FAQs +---- + +* **My ``putStrLn`` and ``putStr`` instances are no longer inferred in the presense +of the ``-XOverloadedStrings`` extension?** + +Because the print functions are polymorphic the type of the print functions may +require annotations if the type is not fully specified by inference. To force a +specific type at the call site use either + +```haskell +putText :: MonadIO m => T.Text -> m () +putLText :: MonadIO m => TL.Text -> m () +``` + +* **How do I write manual Show instances if ``show`` isn't provided?** + +Generally speaking writing manual instances of Show is a +[Haskell antipattern](http://www.stephendiehl.com/posts/strings.html) because it produces +law-violating instances of Show. You probably want to use a +[pretty printer](https://hackage.haskell.org/package/wl-pprint-text) library for custom printing. + +If backwards compatibility is needed then the base library can be imported +manually. + +```haskell +import GHC.Show (Show(..)) +``` + +Automatic deriving of ``Show`` for your types is still supported since the class +is in scope by default. + +* **Partial functions like ``undefined`` raise compiler warnings on + usage.** + +This is by design. For fatal uncatchable errors use the provided ``panic`` +function if you intend the program to immediately abort. + +```haskell +panic "Thus I die. Thus, thus, thus. Now I am dead" +``` + +If inside of IO simply use ``throwIO`` for exception handling, or if in pure +business logic use well-typed checked exceptions of the ``ExceptT`` variety. + +* **Why is ``id`` not in scope?** + +It has been renamed to ``identity`` to reserve the ``id`` identifier for the +more common use case of business logic. + +* **But what if I want the partial functions?** + +You if you need partial functions for backwards compatibility you can use the +`Protolude.Partial` module and mask the safe definitions as needed. + +```haskell +import Protolude hiding (head) +import Protolude.Partial (head) +``` + +Development Tools +----------------- + +**GHC Magic** + +To build the `exports` management tool use: + +```bash +$ cabal new-build exports --flag dev +$ cabal run exports +``` + +This tool uses GHC's internal compile symbol table to generate a list of exports +and keep the export list of protolude stable across different versions of GHC +and base. + +**Continious Integration** + +There is a massive test suite that tests all versions of GHC 7.6 - GHC HEAD +alongside all Stack resolvers to ensure no regressions. Any pull requests or +patch has to pass the 47 integrity checks before being considered. Any pull +request must keep the export list consistent across GHC and Base version and not +have any accidental symbol dropping or drift without updating the export golden +tests. + +License +------- + +Released under the MIT License. +Copyright (c) 2016-2022, Stephen Diehl diff --git a/protolude.cabal b/protolude.cabal --- a/protolude.cabal +++ b/protolude.cabal @@ -1,78 +1,91 @@ -name: protolude -version: 0.1.10 -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 -license: MIT -license-file: LICENSE -author: Stephen Diehl -maintainer: stephen.m.diehl@gmail.com -copyright: 2016 Stephen Diehl -category: Prelude -build-type: Simple -cabal-version: >=1.10 -tested-with: - GHC == 7.6.1, - GHC == 7.6.2, - GHC == 7.6.3, - GHC == 7.8.1, - GHC == 7.8.2, - GHC == 7.8.3, - GHC == 7.8.4, - GHC == 7.10.1, - GHC == 7.10.2, - GHC == 7.10.3 -Bug-Reports: https://github.com/sdiehl/protolude/issues +name: protolude +version: 0.3.5 +synopsis: A small prelude. +description: A sensible set of defaults for writing custom Preludes. +homepage: https://github.com/sdiehl/protolude +license: MIT +license-file: LICENSE +author: Stephen Diehl +maintainer: adamwespiser@gmail.com, stephen.m.diehl@gmail.com +copyright: 2016-2022 Stephen Diehl +category: Prelude +build-type: Simple +cabal-version: >=1.10 +bug-reports: https://github.com/sdiehl/protolude/issues +tested-with: + GHC ==7.6.3 + || ==7.8.4 + || ==7.10.3 + || ==8.0.1 + || ==8.2.1 + || ==8.4.1 + || ==8.6.1 + || ==8.8.1 + || ==8.10.1 + || ==9.0.1 + || ==9.2.2 + || ==9.6.1 + || ==9.8.2 + || ==9.10.1 + || ==9.12.1 -description: - A sensible set of defaults for writing custom Preludes. -Source-Repository head - type: git - location: git@github.com:sdiehl/protolude.git +extra-source-files: + README.md + ChangeLog.md +source-repository head + type: git + location: git@github.com:protolude/protolude.git + library - exposed-modules: + exposed-modules: Protolude - Unsafe - Base - Applicative - Bool - Debug - List - Monad - Show - Conv - Either - Functor - Semiring - Bifunctor - Exceptions - Panic - - other-modules: + Protolude.Applicative + Protolude.Base + Protolude.Bifunctor + Protolude.Bool + Protolude.CallStack + Protolude.Conv + Protolude.ConvertText + Protolude.Debug + Protolude.Either + Protolude.Error + Protolude.Exceptions + Protolude.Functor + Protolude.List + Protolude.Monad + Protolude.Panic + Protolude.Partial + Protolude.Safe + Protolude.Semiring + Protolude.Show + Protolude.Unsafe default-extensions: NoImplicitPrelude - OverloadedStrings FlexibleContexts MultiParamTypeClasses + OverloadedStrings - ghc-options: - -Wall - -fwarn-implicit-prelude + ghc-options: -Wall -fwarn-implicit-prelude + build-depends: + array >=0.4 && <0.6 + , async >=2.0 && <2.3 + , base >=4.6 && <4.22 + , bytestring >=0.10 && <0.13 + , containers >=0.5 && <0.8 + , deepseq >=1.3 && <1.6 + , ghc-prim >=0.3 && <0.14 + , hashable >=1.2 && <1.6 + , mtl >=2.1 && <2.4 + , mtl-compat >=0.2 && <0.3 + , stm >=2.4 && <2.6 + , text >=1.2 && <2.2 + , transformers >=0.2 && <0.7 + , transformers-compat >=0.4 && <0.8 - build-depends: - base >= 4.6 && <4.10, - ghc-prim >= 0.3 && <0.6, - safe >= 0.3 && <0.4, - async >= 2.1 && <2.2, - deepseq >= 1.3 && <1.5, - containers >= 0.5 && <0.6, - mtl >= 2.1 && <2.3, - transformers >= 0.4 && <0.6, - text >= 1.2 && <1.3, - stm >= 2.4 && <2.5, - bytestring >= 0.10 && <0.11 + if !impl(ghc >=8.0) + build-depends: fail ==4.9.* - hs-source-dirs: src - default-language: Haskell2010 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Applicative.hs b/src/Applicative.hs deleted file mode 100644 --- a/src/Applicative.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Applicative ( - orAlt, - orEmpty, - eitherA, - purer, - liftAA2, - (<<*>>), -) where - -import Data.Bool (Bool) -import Data.Function ((.)) -import Data.Either (Either(..)) -import Data.Monoid (Monoid(..)) -import Control.Applicative - -orAlt :: (Alternative f, Monoid a) => f a -> f a -orAlt f = f <|> pure mempty - -orEmpty :: Alternative f => Bool -> a -> f a -orEmpty b a = if b then pure a else empty - -eitherA :: (Alternative f) => f a -> f b -> f (Either a b) -eitherA a b = (Left <$> a) <|> (Right <$> b) - -purer :: (Applicative f, Applicative g) => a -> f (g a) -purer = pure . pure - -liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c) -liftAA2 = liftA2 . liftA2 - -(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b) -(<<*>>) = liftA2 (<*>) diff --git a/src/Base.hs b/src/Base.hs deleted file mode 100644 --- a/src/Base.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Unsafe #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Base ( - module X, - ($!), -) where - --- Glorious Glasgow Haskell Compiler -#if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 ) - --- Base GHC types -import GHC.Num as X -import GHC.Enum as X -import GHC.Real as X -import GHC.Float as X -import GHC.Err as X ( - undefined - , error - ) -import GHC.Show as X ( - Show(..) - ) -import GHC.Exts as X ( - Constraint - , Ptr - , FunPtr - ) -import GHC.Base as X ( - (++) - , seq - , asTypeOf - , ord - , maxInt - , minInt - ) -import System.IO as X ( - print - , putStr - , putStrLn - ) - -import GHC.Types as X ( - Bool - , Char - , Int - , Word - , Ordering - , IO -#if ( __GLASGOW_HASKELL__ >= 710 ) - , Coercible -#endif - ) - -#if ( __GLASGOW_HASKELL__ >= 800 ) -import GHC.OverloadedLabels as X ( - 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(..) - ) --} - -import Data.Kind as X ( - type (*) - , type Type - ) -#endif - -infixr 0 $! - -($!) :: (a -> b) -> a -> b -f $! x = let !vx = x in f vx - -#endif diff --git a/src/Bifunctor.hs b/src/Bifunctor.hs deleted file mode 100644 --- a/src/Bifunctor.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Bifunctor ( - Bifunctor(..) -) where - -import Data.Function (id, (.)) -import Data.Either (Either(..)) -import Control.Applicative ( Const(..) ) - -class Bifunctor p where - {-# MINIMAL bimap | first, second #-} - - bimap :: (a -> b) -> (c -> d) -> p a c -> p b d - bimap f g = first f . second g - - first :: (a -> b) -> p a c -> p b c - first f = bimap f id - - second :: (b -> c) -> p a b -> p a c - second = bimap id - -instance Bifunctor (,) where - bimap f g ~(a, b) = (f a, g b) - -instance Bifunctor ((,,) x1) where - bimap f g ~(x1, a, b) = (x1, f a, g b) - -instance Bifunctor ((,,,) x1 x2) where - bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b) - -instance Bifunctor ((,,,,) x1 x2 x3) where - bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b) - -instance Bifunctor ((,,,,,) x1 x2 x3 x4) where - bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b) - -instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where - bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b) - -instance Bifunctor Either where - bimap f _ (Left a) = Left (f a) - bimap _ g (Right b) = Right (g b) - -instance Bifunctor Const where - bimap f _ (Const a) = Const (f a) diff --git a/src/Bool.hs b/src/Bool.hs deleted file mode 100644 --- a/src/Bool.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Bool ( - whenM -, unlessM -, ifM -, guardM -, bool -) where - -import Data.Bool (Bool) -import Data.Function (flip) -import Control.Monad (Monad, MonadPlus, when, unless, guard, (>>=), (=<<)) - -bool :: a -> a -> Bool -> a -bool f t p = if p then t else f - -whenM :: Monad m => m Bool -> m () -> m () -whenM p m = - p >>= flip when m - -unlessM :: Monad m => m Bool -> m () -> m () -unlessM p m = - p >>= flip unless m - -ifM :: Monad m => m Bool -> m a -> m a -> m a -ifM p x y = p >>= \b -> if b then x else y - -guardM :: MonadPlus m => m Bool -> m () -guardM f = guard =<< f diff --git a/src/Conv.hs b/src/Conv.hs deleted file mode 100644 --- a/src/Conv.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/Debug.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Debug ( - undefined, - error, - trace, - traceM, - traceId, - traceIO, - traceShow, - traceShowId, - traceShowM, - notImplemented, -) where - -import Data.Text (Text, unpack) -import Control.Monad (Monad, return) - -import qualified Base as P -import Show (Print, putStrLn) - -import System.IO.Unsafe (unsafePerformIO) - -{-# WARNING trace "'trace' remains in code" #-} -trace :: Print b => b -> a -> a -trace string expr = unsafePerformIO (do - putStrLn string - return expr) - -{-# WARNING traceIO "'traceIO' remains in code" #-} -traceIO :: Print b => b -> a -> P.IO a -traceIO string expr = do - putStrLn string - return expr - -{-# WARNING error "'error' remains in code" #-} -error :: Text -> a -error s = P.error (unpack s) - -{-# WARNING traceShow "'traceShow' remains in code" #-} -traceShow :: P.Show a => a -> b -> b -traceShow a b = trace (P.show a) b - -{-# WARNING traceShowId "'traceShowId' remains in code" #-} -traceShowId :: P.Show a => a -> a -traceShowId a = trace (P.show a) a - -{-# WARNING traceShowM "'traceShowM' remains in code" #-} -traceShowM :: (P.Show a, Monad m) => a -> m () -traceShowM a = trace (P.show a) (return ()) - -{-# WARNING traceM "'traceM' remains in code" #-} -traceM :: (Monad m) => Text -> m () -traceM s = trace (unpack s) (return ()) - -{-# WARNING traceId "'traceM' remains in code" #-} -traceId :: Text -> Text -traceId s = trace s s - -notImplemented :: a -notImplemented = P.error "Not implemented" - -undefined :: a -undefined = P.undefined diff --git a/src/Either.hs b/src/Either.hs deleted file mode 100644 --- a/src/Either.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Either ( - maybeToLeft -, maybeToRight -, leftToMaybe -, rightToMaybe -, maybeToEither -) where - -import Data.Function (const) -import Data.Monoid (Monoid, mempty) -import Data.Maybe (Maybe(..), maybe) -import Data.Either (Either(..), either) - -leftToMaybe :: Either l r -> Maybe l -leftToMaybe = either Just (const Nothing) - -rightToMaybe :: Either l r -> Maybe r -rightToMaybe = either (const Nothing) Just - -maybeToRight :: l -> Maybe r -> Either l r -maybeToRight l = maybe (Left l) Right - -maybeToLeft :: r -> Maybe l -> Either l r -maybeToLeft r = maybe (Right r) Left - -maybeToEither :: Monoid b => (a -> b) -> Maybe a -> b -maybeToEither = maybe mempty diff --git a/src/Exceptions.hs b/src/Exceptions.hs deleted file mode 100644 --- a/src/Exceptions.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Exceptions ( - hush, - note, - tryIO, -) where - -import Base (IO) -import Data.Function ((.)) -import Control.Monad.Trans (liftIO) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Except (ExceptT(..), MonadError, throwError) -import Control.Exception as Exception -import Control.Applicative -import Data.Maybe (Maybe, maybe) -import Data.Either (Either(..)) - -hush :: Alternative m => Either e a -> m a -hush (Left _) = empty -hush (Right x) = pure x - -note :: (MonadError e m, Applicative m) => e -> Maybe a -> m a -note err = maybe (throwError err) pure - -tryIO :: MonadIO m => IO a -> ExceptT IOException m a -tryIO = ExceptT . liftIO . Exception.try diff --git a/src/Functor.hs b/src/Functor.hs deleted file mode 100644 --- a/src/Functor.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Functor ( - Functor(..), - ($>), - (<$>), - void, -) where - -#if (__GLASGOW_HASKELL__ >= 710) -import Data.Functor ( - Functor(..) - , ($>) - , (<$>) - , void - ) -#else -import Data.Functor ( - Functor(..) - , (<$>) - ) - -import Data.Function (flip) -import Data.Function ((.)) - -infixl 4 $> - -($>) :: Functor f => f a -> b -> f b -($>) = flip (<$) - -(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) -(<<$>>) = fmap . fmap - -void :: Functor f => f a -> f () -void x = () <$ x -#endif diff --git a/src/List.hs b/src/List.hs deleted file mode 100644 --- a/src/List.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module List ( - head, - ordNub, - sortOn, - list, - product, - sum -) where - -import Data.List (sortBy) -import Data.Maybe (Maybe(..)) -import Data.Ord (Ord, comparing) -import Data.Foldable (Foldable, foldr, foldl') -import Data.Function ((.)) -import Data.Functor (fmap) -import Control.Monad (return) -import qualified Data.Set as Set -import GHC.Num (Num, (+), (*)) - -head :: (Foldable f) => f a -> Maybe a -head = foldr (\x _ -> return x) Nothing - -sortOn :: (Ord o) => (a -> o) -> [a] -> [a] -sortOn = sortBy . comparing - --- O(n * log n) -ordNub :: (Ord a) => [a] -> [a] -ordNub l = go Set.empty l - where - go _ [] = [] - go s (x:xs) = - if x `Set.member` s - then go s xs - else x : go (Set.insert x s) xs - -list :: [b] -> (a -> b) -> [a] -> [b] -list def f xs = case xs of - [] -> def - _ -> fmap f xs - -{-# INLINE product #-} -product :: (Foldable f, Num a) => f a -> a -product = foldl' (*) 1 - -{-# INLINE sum #-} -sum :: (Foldable f, Num a) => f a -> a -sum = foldl' (+) 0 diff --git a/src/Monad.hs b/src/Monad.hs deleted file mode 100644 --- a/src/Monad.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Monad ( - Monad((>>=), return) - , MonadPlus(..) - - , (=<<) - , (>=>) - , (<=<) - , (>>) - , forever - - , join - , mfilter - , filterM - , mapAndUnzipM - , zipWithM - , zipWithM_ - , foldM - , foldM_ - , replicateM - , replicateM_ - , concatMapM - - , guard - , when - , unless - - , liftM - , liftM2 - , liftM3 - , liftM4 - , liftM5 - , liftM' - , liftM2' - , ap - - , (<$!>) - ) where - -import Base (seq) -import Data.List (concat) - -#if (__GLASGOW_HASKELL__ >= 710) -import Control.Monad hiding ((<$!>)) -#else -import Control.Monad -#endif - -concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] -concatMapM f xs = liftM concat (mapM f xs) - -liftM' :: Monad m => (a -> b) -> m a -> m b -liftM' = (<$!>) -{-# INLINE liftM' #-} - -liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c -liftM2' f a b = do - x <- a - y <- b - let z = f x y - z `seq` return z -{-# INLINE liftM2' #-} - -(<$!>) :: Monad m => (a -> b) -> m a -> m b -f <$!> m = do - x <- m - let z = f x - z `seq` return z -{-# INLINE (<$!>) #-} diff --git a/src/Panic.hs b/src/Panic.hs deleted file mode 100644 --- a/src/Panic.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# 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,49 +1,166 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ExplicitNamespaces #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} module Protolude ( - module X, + -- * Base functions module Base, identity, - map, + pass, +#if !MIN_VERSION_base(4,8,0) (&), + scanl', +#endif + -- * Function functions + module Function, + applyN, + -- * List functions + module List, + map, uncons, unsnoc, - applyN, - print, - throwIO, - throwTo, - foreach, + -- * Data Structures + module DataStructures, + -- * Show functions + module Show, show, - pass, + print, + -- * Bool functions + module Bool, + -- * Monad functions + module Monad, + liftIO1, + liftIO2, + -- * Functor functions + module Functor, + -- * Either functions + module Either, + -- * Applicative functions + module Applicative, guarded, guardedA, - LText, + -- * String conversion + module ConvertText, + -- * Debug functions + module Debug, + + -- * Panic functions + module Panic, + -- * Exception functions + module Exception, + Protolude.throwIO, + Protolude.throwTo, + -- * Semiring functions + module Semiring, + + -- * String functions + module String, + -- * Safe functions + module Safe, + -- * Eq functions + module Eq, + -- * Ord functions + module Ord, + -- * Traversable functions + module Traversable, + -- * Foldable functions + module Foldable, + -- * Semigroup functions +#if MIN_VERSION_base(4,9,0) + module Semigroup, +#endif + -- * Monoid functions + module Monoid, + -- * Bifunctor functions + module Bifunctor, + -- * Bifunctor functions + module Hashable, + + -- * Deepseq functions + module DeepSeq, + + -- * Tuple functions + module Tuple, + + module Typeable, + +#if MIN_VERSION_base(4,7,0) + -- * Typelevel programming + module Typelevel, +#endif + + -- * Monads + module Fail, + module State, + module Reader, + module Except, + module Trans, + module ST, + module STM, + + -- * Integers + module Int, + module Bits, + + -- * Complex functions + module Complex, + + -- * Char functions + module Char, + + -- * Maybe functions + module Maybe, + + -- * Generics functions + module Generics, + + -- * ByteString functions + module ByteString, LByteString, + + -- * Text functions + module Text, + LText, + + -- * Read functions + module Read, + readMaybe, + readEither, + + -- * System functions + module System, + die, + + -- * Concurrency functions + module Concurrency, + + -- * Foreign functions + module Foreign, ) where -import List as X -import Show as X -import Bool as X -import Debug as X -import Monad as X -import Functor as X -import Either as X -import Applicative as X -import Conv as X -import Panic as X -import Exceptions as X +-- Protolude module exports. +import Protolude.Debug as Debug +import Protolude.List as List +import Protolude.Show as Show +import Protolude.Bool as Bool +import Protolude.Monad as Monad +import Protolude.Functor as Functor +import Protolude.Either as Either +import Protolude.Applicative as Applicative +import Protolude.ConvertText as ConvertText +import Protolude.Panic as Panic +import Protolude.Exceptions as Exception +import Protolude.Semiring as Semiring +import qualified Protolude.Conv as Conv -import Base as Base hiding ( +import Protolude.Base as Base hiding ( 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. @@ -51,14 +168,14 @@ , showSignedFloat -- Custom Show instances deprecated. , showsPrec -- Custom Show instances deprecated. ) -import qualified Base as PBase +import qualified Protolude.Base as PBase -- Used for 'show', not exported. import Data.String (String) -import Data.String as X (IsString) +import Data.String as String (IsString) -- Maybe'ized version of partial functions -import Safe as X ( +import Protolude.Safe as Safe ( headMay , headDef , initMay @@ -71,16 +188,21 @@ , lastMay , foldr1May , foldl1May + , foldl1May' + , maximumMay + , minimumMay + , maximumDef + , minimumDef , atMay , atDef ) -- Applicatives -import Control.Applicative as X ( +import Control.Applicative as Applicative ( Applicative(..) , Alternative(..) - , Const(..) - , ZipList(..) + , Const(Const,getConst) + , ZipList(ZipList,getZipList) , (<**>) , liftA , liftA2 @@ -89,33 +211,91 @@ ) -- Base typeclasses -import Data.Eq as X -import Data.Ord as X -import Data.Traversable as X -import Data.Foldable as X hiding ( - foldr1 - , foldl1 - , product - , sum +import Data.Eq as Eq ( + Eq(..) ) -import Semiring as X -import Data.Functor.Identity as X +import Data.Ord as Ord ( + Ord(..) + , Ordering(LT,EQ,GT) + , Down(Down) + , comparing + ) +import Data.Traversable as Traversable +import Data.Foldable as Foldable ( + Foldable, + fold, + foldMap, + foldr, + foldr', + foldl, + foldl', + toList, +#if MIN_VERSION_base(4,8,0) + null, + length, +#endif + elem, + maximum, + minimum, + foldrM, + foldlM, + traverse_, + for_, + mapM_, + forM_, + sequence_, + sequenceA_, + asum, + msum, + concat, + concatMap, + and, + or, + any, + all, + maximumBy, + minimumBy, + notElem, + find, + ) +import Data.Functor.Identity as Functor ( + Identity(Identity, runIdentity) + ) -#if ( __GLASGOW_HASKELL__ >= 800 ) -import Data.Monoid as X hiding ((<>)) -import Data.Semigroup as X ( Semigroup(..) ) -#else -import Data.Monoid as X +#if MIN_VERSION_base(4,9,0) +import Data.List.NonEmpty as List ( + NonEmpty((:|)) + , nonEmpty + ) +import Data.Semigroup as Semigroup ( + Semigroup(sconcat, stimes) + , WrappedMonoid + , diff + , cycle1 + , stimesMonoid + , stimesIdempotent + , stimesIdempotentMonoid + , mtimesDefault + ) #endif -#if (__GLASGOW_HASKELL__ >= 710) -import Data.Bifunctor as X (Bifunctor(..)) +#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,16,0) +import Data.Semigroup as Semigroup ( + Option(..) + , option + ) +#endif + +import Data.Monoid as Monoid + +#if !MIN_VERSION_base(4,8,0) +import Protolude.Bifunctor as Bifunctor (Bifunctor(bimap, first, second)) #else -import Bifunctor as X (Bifunctor(..)) +import Data.Bifunctor as Bifunctor (Bifunctor(bimap, first, second)) #endif -- Deepseq -import Control.DeepSeq as X ( +import Control.DeepSeq as DeepSeq ( NFData(..) , ($!!) , deepseq @@ -123,12 +303,21 @@ ) -- Data structures -import Data.Tuple as X -import Data.List as X ( +import Data.Tuple as Tuple ( + fst + , snd + , curry + , uncurry + , swap + ) + +import Data.List as List ( splitAt , break , intercalate , isPrefixOf + , isInfixOf + , isSuffixOf , drop , filter , reverse @@ -141,6 +330,9 @@ , subsequences , permutations , scanl +#if MIN_VERSION_base(4,8,0) + , scanl' +#endif , scanr , iterate , repeat @@ -153,33 +345,58 @@ , tails , zipWith , zip + , unzip + , genericLength + , genericTake + , genericDrop + , genericSplitAt + , genericReplicate ) -import Data.Map as X (Map) -import Data.Set as X (Set) -import Data.Sequence as X (Seq) -import Data.IntMap as X (IntMap) -import Data.IntSet as X (IntSet) +#if !MIN_VERSION_base(4,8,0) +-- These imports are required for the scanl' rewrite rules +import GHC.Exts (build) +import Data.List (tail) +#endif -#if ( __GLASGOW_HASKELL__ >= 710 ) -import Data.Proxy as X ( - Proxy(..) +-- Hashing +import Data.Hashable as Hashable ( + Hashable + , hash + , hashWithSalt + , hashUsing ) -import Data.Typeable as X ( +import Data.Map as DataStructures (Map) +import Data.Set as DataStructures (Set) +import Data.Sequence as DataStructures (Seq) +import Data.IntMap as DataStructures (IntMap) +import Data.IntSet as DataStructures (IntSet) + +import Data.Typeable as Typeable ( TypeRep , Typeable - , typeRep + , typeOf , cast + , gcast +#if MIN_VERSION_base(4,7,0) + , typeRep , eqT +#endif ) -import Data.Type.Coercion as X ( +#if MIN_VERSION_base(4,7,0) +import Data.Proxy as Typelevel ( + Proxy(..) + ) + +import Data.Type.Coercion as Typelevel ( Coercion(..) , coerceWith + , repr ) -import Data.Type.Equality as X ( +import Data.Type.Equality as Typelevel ( (:~:)(..) , type (==) , sym @@ -188,18 +405,25 @@ , gcastWith ) -import Data.Void as X ( +#endif + +#if MIN_VERSION_base(4,8,0) +import Data.Void as Typelevel ( Void , absurd , vacuous ) #endif +import Control.Monad.Fail as Fail ( + MonadFail + ) + -- Monad transformers -import Control.Monad.State as X ( +import Control.Monad.State as State ( MonadState , State - , StateT + , StateT(StateT) , put , get , gets @@ -216,10 +440,10 @@ , evalStateT ) -import Control.Monad.Reader as X ( +import Control.Monad.Reader as Reader ( MonadReader , Reader - , ReaderT + , ReaderT(ReaderT) , ask , asks , local @@ -228,47 +452,170 @@ , runReaderT ) -import Control.Monad.Except as X ( +import Control.Monad.Trans.Except as Except ( + throwE + , catchE + ) + +import Control.Monad.Except as Except ( MonadError , Except - , ExceptT + , ExceptT(ExceptT) , throwError , catchError , runExcept , runExceptT + , mapExcept + , mapExceptT + , withExcept + , withExceptT ) -import Control.Monad.Trans as X ( +import Control.Monad.Trans as Trans ( MonadIO , lift , liftIO ) -- Base types -import Data.Int as X -import Data.Bits as X hiding ( - unsafeShiftL - , unsafeShiftR +import Data.Int as Int ( + Int + , Int8 + , Int16 + , Int32 + , Int64 ) -import Data.Word as X -import Data.Either as X -import Data.Complex as X -import Data.Char as X (chr) -import Data.Bool as X hiding (bool) -import Data.Maybe as X hiding (fromJust) +import Data.Bits as Bits ( + Bits, + (.&.), + (.|.), + xor, + complement, + shift, + rotate, +#if MIN_VERSION_base(4,7,0) + zeroBits, +#endif + bit, + setBit, + clearBit, + complementBit, + testBit, +#if MIN_VERSION_base(4,7,0) + bitSizeMaybe, +#endif + bitSize, + isSigned, + shiftL, + shiftR, + rotateL, + rotateR, + popCount, +#if MIN_VERSION_base(4,7,0) + FiniteBits, + finiteBitSize, + bitDefault, + testBitDefault, + popCountDefault, +#endif +#if MIN_VERSION_base(4,8,0) + toIntegralSized, + countLeadingZeros, + countTrailingZeros, +#endif + ) +import Data.Word as Bits ( + Word + , Word8 + , Word16 + , Word32 + , Word64 +#if MIN_VERSION_base(4,7,0) + , byteSwap16 + , byteSwap32 + , byteSwap64 +#endif + ) -import Data.Function as X ( +import Data.Either as Either ( + Either(Left,Right) + , either + , lefts + , rights + , partitionEithers +#if MIN_VERSION_base(4,7,0) + , isLeft + , isRight +#endif + ) + +import Data.Complex as Complex ( + Complex((:+)) + , realPart + , imagPart + , mkPolar + , cis + , polar + , magnitude + , phase + , conjugate + ) +import Data.Char as Char ( + Char + , ord + , chr + , digitToInt + , intToDigit + , toUpper + , toLower + , toTitle + , isAscii + , isLetter + , isDigit + , isHexDigit + , isPrint + , isAlpha + , isAlphaNum + , isUpper + , isLower + , isSpace + , isControl + ) +import Data.Bool as Bool ( + Bool(True, False), + (&&), + (||), + not, + otherwise + ) +import Data.Maybe as Maybe ( + Maybe(Nothing, Just) + , maybe + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + ) + +import Data.Function as Function ( const , (.) , ($) , flip , fix , on +#if MIN_VERSION_base(4,8,0) + , (&) +#endif ) -- Genericss -import GHC.Generics as X ( +import GHC.Generics as Generics ( Generic(..) + , Generic1 , Rep , K1(..) , M1(..) @@ -277,26 +624,37 @@ , D1 , C1 , S1 - , (:+:) - , (:*:) + , (:+:)(..) + , (:*:)(..) + , (:.:)(..) , Rec0 , Constructor(..) + , Datatype(..) , Selector(..) , Fixity(..) + , Associativity(..) #if ( __GLASGOW_HASKELL__ >= 800 ) , Meta(..) + , FixityI(..) + , URec #endif ) -- ByteString import qualified Data.ByteString.Lazy -import Data.ByteString as X (ByteString) +import Data.ByteString as ByteString (ByteString) -- Text -import Data.Text as X (Text) +import Data.Text as Text ( + Text + , lines + , words + , unlines + , unwords + ) import qualified Data.Text.Lazy -import Data.Text.IO as X ( +import Data.Text.IO as Text ( getLine , getContents , interact @@ -305,22 +663,38 @@ , appendFile ) -import Data.Text.Lazy as X ( +import Data.Text.Lazy as Text ( toStrict , fromStrict ) -import Data.Text.Encoding as X ( +import Data.Text.Encoding as Text ( encodeUtf8 , decodeUtf8 , decodeUtf8' , decodeUtf8With ) +import Data.Text.Encoding.Error as Text ( + OnDecodeError + , OnError + , UnicodeException + , lenientDecode + , strictDecode + , ignore + , replace + ) + -- IO -import System.Exit as X -import System.Environment as X (getArgs) -import System.IO as X ( +import System.Environment as System (getArgs) +import qualified System.Exit +import System.Exit as System ( + ExitCode(..) + , exitWith + , exitFailure + , exitSuccess + ) +import System.IO as System ( Handle , FilePath , IOMode(..) @@ -332,91 +706,355 @@ ) -- ST -import Control.Monad.ST as X +import Control.Monad.ST as ST ( + ST + , runST + , fixST + ) -- Concurrency and Parallelism -import Control.Exception as X hiding ( - throw -- Impure throw is forbidden. - , throwIO - , throwTo - , assert - , displayException - , Handler(..) +import Control.Exception as Exception ( + Exception, + toException, + fromException, +#if MIN_VERSION_base(4,8,0) + displayException, +#endif + SomeException(SomeException) + , IOException + , ArithException( + Overflow, + Underflow, + LossOfPrecision, + DivideByZero, + Denormal, + RatioZeroDenominator + ) + , ArrayException(IndexOutOfBounds, UndefinedElement) + , AssertionFailed(AssertionFailed) +#if MIN_VERSION_base(4,7,0) + , SomeAsyncException(SomeAsyncException) + , asyncExceptionToException + , asyncExceptionFromException +#endif + , AsyncException(StackOverflow, HeapOverflow, ThreadKilled, UserInterrupt) + , NonTermination(NonTermination) + , NestedAtomically(NestedAtomically) + , BlockedIndefinitelyOnMVar(BlockedIndefinitelyOnMVar) + , BlockedIndefinitelyOnSTM(BlockedIndefinitelyOnSTM) +#if MIN_VERSION_base(4,8,0) + , AllocationLimitExceeded(AllocationLimitExceeded) +#endif +#if MIN_VERSION_base(4,10,0) + , CompactionFailed(CompactionFailed) +#endif + , Deadlock(Deadlock) + , NoMethodError(NoMethodError) + , PatternMatchFail(PatternMatchFail) + , RecConError(RecConError) + , RecSelError(RecSelError) + , RecUpdError(RecUpdError) +#if MIN_VERSION_base(4,9,0) + , ErrorCall(ErrorCall, ErrorCallWithLocation) +#else + , ErrorCall(ErrorCall) +#endif +#if MIN_VERSION_base(4,9,0) + , TypeError(TypeError) +#endif + , ioError + , catch + , catches + , Handler(Handler) + , catchJust + , handle + , handleJust + , try + , tryJust + , evaluate + , mapException + , mask + , mask_ + , uninterruptibleMask + , uninterruptibleMask_ + , MaskingState(..) + , getMaskingState +#if MIN_VERSION_base(4,9,0) + , interruptible +#endif + , allowInterrupt + , bracket + , bracket_ + , bracketOnError + , finally + , onException ) +import qualified Control.Exception as PException -import qualified Control.Exception +import Control.Monad.STM as STM ( + STM + , atomically +#if !(MIN_VERSION_stm(2,5,0)) + , always + , alwaysSucceeds +#endif + , retry + , orElse + , check + , throwSTM + , catchSTM + ) -import Control.Monad.STM as X -import Control.Concurrent as X hiding ( - throwTo +import Control.Concurrent.MVar as Concurrency ( + MVar + , newEmptyMVar + , newMVar + , takeMVar + , putMVar + , readMVar + , swapMVar + , tryTakeMVar + , tryPutMVar + , isEmptyMVar + , withMVar +#if MIN_VERSION_base(4,7,0) + , withMVarMasked +#endif + , modifyMVar_ + , modifyMVar + , modifyMVarMasked_ + , modifyMVarMasked +#if MIN_VERSION_base(4,7,0) + , tryReadMVar + , mkWeakMVar +#endif + , addMVarFinalizer + ) +import Control.Concurrent.Chan as Concurrency ( + Chan + , newChan + , writeChan + , readChan + , dupChan + , getChanContents + , writeList2Chan + ) +import Control.Concurrent.QSem as Concurrency ( + QSem + , newQSem + , waitQSem + , signalQSem + ) +import Control.Concurrent.QSemN as Concurrency ( + QSemN + , newQSemN + , waitQSemN + , signalQSemN + ) +import Control.Concurrent as Concurrency ( + ThreadId + , forkIO + , forkFinally + , forkIOWithUnmask + , killThread + , forkOn + , forkOnWithUnmask + , getNumCapabilities + , setNumCapabilities + , threadCapability , yield + , threadDelay + , threadWaitRead + , threadWaitWrite +#if MIN_VERSION_base(4,7,0) + , threadWaitReadSTM + , threadWaitWriteSTM +#endif + , rtsSupportsBoundThreads + , forkOS +#if MIN_VERSION_base(4,9,0) + , forkOSWithUnmask +#endif + , isCurrentThreadBound + , runInBoundThread + , runInUnboundThread + , mkWeakThreadId + , myThreadId ) -import Control.Concurrent.Async as X +import Control.Concurrent.Async as Concurrency ( + Async(..) + , Concurrently(..) + , async + , asyncBound + , asyncOn + , withAsync + , withAsyncBound + , withAsyncOn + , wait + , poll + , waitCatch + , cancel + , cancelWith + , asyncThreadId + , waitAny + , waitAnyCatch + , waitAnyCancel + , waitAnyCatchCancel + , waitEither + , waitEitherCatch + , waitEitherCancel + , waitEitherCatchCancel + , waitEither_ + , waitBoth + , link + , link2 + , race + , race_ + , concurrently + ) -import Foreign.Storable as X (Storable) +import Foreign.Ptr as Foreign (IntPtr, WordPtr) +import Foreign.Storable as Foreign (Storable) +import Foreign.StablePtr as Foreign (StablePtr) -- Read instances hiding unsafe builtins (read) -import Text.Read as X ( +import qualified Text.Read as Read +import Text.Read as Read ( Read , reads - , readMaybe - , readEither ) -- Type synonymss for lazy texts type LText = Data.Text.Lazy.Text type LByteString = Data.ByteString.Lazy.ByteString + +#if !MIN_VERSION_base(4,8,0) infixl 1 & (&) :: a -> (a -> b) -> b x & f = f x +#endif +-- | The identity function, returns the give value unchanged. identity :: a -> a identity x = x -map :: Functor f => (a -> b) -> f a -> f b -map = fmap +map :: Functor.Functor f => (a -> b) -> f a -> f b +map = Functor.fmap uncons :: [a] -> Maybe (a, [a]) -uncons [] = Nothing +uncons [] = Nothing uncons (x:xs) = Just (x, xs) unsnoc :: [x] -> Maybe ([x],x) -unsnoc = foldr go Nothing +unsnoc = Foldable.foldr go Nothing where go x mxs = Just (case mxs of Nothing -> ([], x) Just (xs, e) -> (x:xs, e)) +-- | Apply a function n times to a given value applyN :: Int -> (a -> a) -> a -> a -applyN n f = X.foldr (.) identity (X.replicate n f) +applyN n f = Foldable.foldr (.) identity (List.replicate n f) -print :: (X.MonadIO m, PBase.Show a) => a -> m () -print = liftIO . PBase.print +-- | Parse a string using the 'Read' instance. +-- Succeeds if there is exactly one valid result. +-- +-- >>> readMaybe ("123" :: Text) :: Maybe Int +-- Just 123 +-- +-- >>> readMaybe ("hello" :: Text) :: Maybe Int +-- Nothing +readMaybe :: (Read b, Conv.StringConv a String) => a -> Maybe b +readMaybe = Read.readMaybe . Conv.toS -throwIO :: (X.MonadIO m, Exception e) => e -> m a -throwIO = liftIO . Control.Exception.throwIO +-- | Parse a string using the 'Read' instance. +-- Succeeds if there is exactly one valid result. +-- A 'Left' value indicates a parse error. +-- +-- >>> readEither "123" :: Either Text Int +-- Right 123 +-- +-- >>> readEither "hello" :: Either Text Int +-- Left "Prelude.read: no parse" +readEither :: (Read a, Conv.StringConv String e, Conv.StringConv e String) => e -> Either e a +readEither = first Conv.toS . Read.readEither . Conv.toS -throwTo :: (X.MonadIO m, Exception e) => ThreadId -> e -> m () -throwTo tid e = liftIO (Control.Exception.throwTo tid e) +-- | The print function outputs a value of any printable type to the standard +-- output device. Printable types are those that are instances of class Show; +-- print converts values to strings for output using the show operation and adds +-- a newline. +print :: (Trans.MonadIO m, PBase.Show a) => a -> m () +print = liftIO . PBase.print -foreach :: Functor f => f a -> (a -> b) -> f b -foreach = flip fmap +-- | Lifted throwIO +throwIO :: (Trans.MonadIO m, Exception e) => e -> m a +throwIO = liftIO . PException.throwIO +-- | Lifted throwTo +throwTo :: (Trans.MonadIO m, Exception e) => ThreadId -> e -> m () +throwTo tid e = liftIO (PException.throwTo tid e) + +-- | Do nothing returning unit inside applicative. pass :: Applicative f => f () pass = pure () guarded :: (Alternative f) => (a -> Bool) -> a -> f a -guarded p x = X.bool empty (pure x) (p x) +guarded p x = Bool.bool empty (pure x) (p x) -guardedA :: (Functor f, Alternative t) => (a -> f Bool) -> a -> f (t a) -guardedA p x = X.bool empty (pure x) <$> p x +guardedA :: (Functor.Functor f, Alternative t) => (a -> f Bool) -> a -> f (t a) +guardedA p x = Bool.bool empty (pure x) `Functor.fmap` p x -show :: (Show a, StringConv String b) => a -> b -show x = toS (PBase.show x) +-- | Lift an 'IO' operation with 1 argument into another monad +liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b +liftIO1 = (.) liftIO + +-- | Lift an 'IO' operation with 2 arguments into another monad +liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c +liftIO2 = ((.).(.)) liftIO + +show :: (Show a, Conv.StringConv String b) => a -> b +show x = Conv.toS (PBase.show x) {-# 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 #-} + +#if MIN_VERSION_base(4,8,0) +-- | Terminate main process with failure +die :: Text -> IO a +die err = System.Exit.die (ConvertText.toS err) +#else +-- | Terminate main process with failure +die :: Text -> IO a +die err = hPutStrLn stderr err >> exitFailure +#endif + +#if !MIN_VERSION_base(4,8,0) +-- This is a literal copy of the implementation in GHC.List in base-4.10.1.0. + +-- | A strictly accumulating version of 'scanl' +{-# NOINLINE [1] scanl' #-} +scanl' :: (b -> a -> b) -> b -> [a] -> [b] +scanl' = scanlGo' + where + scanlGo' :: (b -> a -> b) -> b -> [a] -> [b] + scanlGo' f !q ls = q : (case ls of + [] -> [] + x:xs -> scanlGo' f (f q x) xs) + +{-# RULES +"scanl'" [~1] forall f a bs . scanl' f a bs = + build (\c n -> a `c` foldr (scanlFB' f c) (flipSeqScanl' n) bs a) +"scanlList'" [1] forall f a bs . + foldr (scanlFB' f (:)) (flipSeqScanl' []) bs a = tail (scanl' f a bs) + #-} + +{-# INLINE [0] scanlFB' #-} +scanlFB' :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c +scanlFB' f c = \b g -> \x -> let !b' = f x b in b' `c` g b' + +{-# INLINE [0] flipSeqScanl' #-} +flipSeqScanl' :: a -> b -> a +flipSeqScanl' a !_b = a +#endif diff --git a/src/Protolude/Applicative.hs b/src/Protolude/Applicative.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Applicative.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Applicative + ( orAlt, + orEmpty, + eitherA, + purer, + liftAA2, + (<<*>>), + ) +where + +import Control.Applicative +import Data.Bool (Bool) +import Data.Either (Either (Left, Right)) +import Data.Function ((.)) +import Data.Monoid (Monoid (mempty)) + +orAlt :: (Alternative f, Monoid a) => f a -> f a +orAlt f = f <|> pure mempty + +orEmpty :: Alternative f => Bool -> a -> f a +orEmpty b a = if b then pure a else empty + +eitherA :: (Alternative f) => f a -> f b -> f (Either a b) +eitherA a b = (Left <$> a) <|> (Right <$> b) + +purer :: (Applicative f, Applicative g) => a -> f (g a) +purer = pure . pure + +liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c) +liftAA2 = liftA2 . liftA2 + +infixl 4 <<*>> + +(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b) +(<<*>>) = liftA2 (<*>) diff --git a/src/Protolude/Base.hs b/src/Protolude/Base.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Base.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ExplicitNamespaces #-} + +module Protolude.Base ( + module Base, + ($!), +) where + +-- Glorious Glasgow Haskell Compiler +#if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 ) + +-- Base GHC types +import GHC.Num as Base ( + Num( + (+), + (-), + (*), + negate, + abs, + signum, + fromInteger + ) + , Integer + , subtract + ) +import GHC.Enum as Base ( + Bounded(minBound, maxBound) + , Enum( + succ, + pred, + toEnum, + fromEnum, + enumFrom, + enumFromThen, + enumFromTo, + enumFromThenTo + ) + , boundedEnumFrom + , boundedEnumFromThen + ) +import GHC.Real as Base ( + (%) + , (/) + , Fractional + , Integral + , Ratio + , Rational + , Real + , RealFrac + , (^) + , (^%^) + , (^^) + , (^^%^^) + , ceiling + , denominator + , div + , divMod +#if MIN_VERSION_base(4,7,0) + , divZeroError +#endif + , even + , floor + , fromIntegral + , fromRational + , gcd +#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,15,0) +#if defined(MIN_VERSION_integer_gmp) + , gcdInt' + , gcdWord' +#endif +#endif + , infinity + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromThenTo + , integralEnumFromTo + , lcm + , mod + , notANumber + , numerator + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromThenTo + , numericEnumFromTo + , odd +#if MIN_VERSION_base(4,7,0) + , overflowError +#endif + , properFraction + , quot + , quotRem + , ratioPrec + , ratioPrec1 +#if MIN_VERSION_base(4,7,0) + , ratioZeroDenominatorError +#endif + , realToFrac + , recip + , reduce + , rem + , round + , showSigned + , toInteger + , toRational + , truncate +#if MIN_VERSION_base(4,12,0) + , underflowError +#endif + ) +import GHC.Float as Base ( + Float(F#) + , Double(D#) + , Floating (..) + , RealFloat(..) + , showFloat + , showSignedFloat + ) +import GHC.Show as Base ( + Show(showsPrec, show, showList) + ) +import GHC.Exts as Base ( + Constraint + , Ptr + , FunPtr + ) +import GHC.Base as Base ( + (++) + , seq + , asTypeOf + , ord + , maxInt + , minInt + , until + ) + +-- Exported for lifting into new functions. +import System.IO as Base ( + print + , putStr + , putStrLn + ) + +import GHC.Types as Base ( + Bool + , Char + , Int + , Word + , Ordering + , IO +#if ( __GLASGOW_HASKELL__ >= 710 ) + , Coercible +#endif + ) + +#if ( __GLASGOW_HASKELL__ >= 710 ) +import GHC.StaticPtr as Base (StaticPtr) +#endif + +#if ( __GLASGOW_HASKELL__ >= 800 ) +import GHC.OverloadedLabels as Base ( + IsLabel(fromLabel) + ) + +import GHC.ExecutionStack as Base ( + Location(Location, srcLoc, objectName, functionName) + , SrcLoc(SrcLoc, sourceColumn, sourceLine, sourceColumn) + , getStackTrace + , showStackTrace + ) + +import GHC.Stack as Base ( + CallStack + , type HasCallStack + , callStack + , prettySrcLoc + , currentCallStack + , getCallStack + , prettyCallStack + , withFrozenCallStack + ) +#endif + +#if ( __GLASGOW_HASKELL__ >= 710 ) +import GHC.TypeLits as Base ( + Symbol + , SomeSymbol(SomeSymbol) + , Nat + , SomeNat(SomeNat) + , CmpNat + , KnownSymbol + , KnownNat + , natVal + , someNatVal + , symbolVal + , someSymbolVal + ) +#endif + +#if ( __GLASGOW_HASKELL__ >= 802 ) +import GHC.Records as Base ( + HasField(getField) + ) +#endif + +#if ( __GLASGOW_HASKELL__ >= 800 ) +import Data.Kind as Base ( + type Type +#if ( __GLASGOW_HASKELL__ < 805 ) + , type (*) +#endif + , type Type + ) +#endif + +-- Default Prelude defines this at the toplevel module, so we do as well. +infixr 0 $! + +($!) :: (a -> b) -> a -> b +f $! x = let !vx = x in f vx + +#endif diff --git a/src/Protolude/Bifunctor.hs b/src/Protolude/Bifunctor.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Bifunctor.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Bifunctor + ( Bifunctor, + bimap, + first, + second, + ) +where + +import Control.Applicative (Const (Const)) +import Data.Either (Either (Left, Right)) +import Data.Function ((.), id) + +class Bifunctor p where + {-# MINIMAL bimap | first, second #-} + + bimap :: (a -> b) -> (c -> d) -> p a c -> p b d + bimap f g = first f . second g + + first :: (a -> b) -> p a c -> p b c + first f = bimap f id + + second :: (b -> c) -> p a b -> p a c + second = bimap id + +instance Bifunctor (,) where + bimap f g ~(a, b) = (f a, g b) + +instance Bifunctor ((,,) x1) where + bimap f g ~(x1, a, b) = (x1, f a, g b) + +instance Bifunctor ((,,,) x1 x2) where + bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b) + +instance Bifunctor ((,,,,) x1 x2 x3) where + bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b) + +instance Bifunctor ((,,,,,) x1 x2 x3 x4) where + bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b) + +instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where + bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b) + +instance Bifunctor Either where + bimap f _ (Left a) = Left (f a) + bimap _ g (Right b) = Right (g b) + +instance Bifunctor Const where + bimap f _ (Const a) = Const (f a) diff --git a/src/Protolude/Bool.hs b/src/Protolude/Bool.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Bool.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Bool ( + whenM +, unlessM +, ifM +, guardM +, bool +, (&&^) +, (||^) +, (<&&>) +, (<||>) +) where + +import Data.Bool (Bool(True, False), (&&), (||)) +import Data.Function (flip) +import Control.Applicative(Applicative, liftA2) +import Control.Monad (Monad, MonadPlus, return, when, unless, guard, (>>=), (=<<)) + +bool :: a -> a -> Bool -> a +bool f t p = if p then t else f + +whenM :: Monad m => m Bool -> m () -> m () +whenM p m = + p >>= flip when m + +unlessM :: Monad m => m Bool -> m () -> m () +unlessM p m = + p >>= flip unless m + +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM p x y = p >>= \b -> if b then x else y + +guardM :: MonadPlus m => m Bool -> m () +guardM f = guard =<< f + +-- | The '||' operator lifted to a monad. If the first +-- argument evaluates to 'True' the second argument will not +-- be evaluated. +infixr 2 ||^ -- same as (||) +(||^) :: Monad m => m Bool -> m Bool -> m Bool +(||^) a b = ifM a (return True) b + +infixr 2 <||> +-- | '||' lifted to an Applicative. +-- Unlike '||^' the operator is __not__ short-circuiting. +(<||>) :: Applicative a => a Bool -> a Bool -> a Bool +(<||>) = liftA2 (||) +{-# INLINE (<||>) #-} + +-- | The '&&' operator lifted to a monad. If the first +-- argument evaluates to 'False' the second argument will not +-- be evaluated. +infixr 3 &&^ -- same as (&&) +(&&^) :: Monad m => m Bool -> m Bool -> m Bool +(&&^) a b = ifM a b (return False) + +infixr 3 <&&> +-- | '&&' lifted to an Applicative. +-- Unlike '&&^' the operator is __not__ short-circuiting. +(<&&>) :: Applicative a => a Bool -> a Bool -> a Bool +(<&&>) = liftA2 (&&) +{-# INLINE (<&&>) #-} diff --git a/src/Protolude/CallStack.hs b/src/Protolude/CallStack.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/CallStack.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ConstraintKinds #-} + +module Protolude.CallStack +( HasCallStack +) where + +#if MIN_VERSION_base(4,9,0) +import GHC.Stack (HasCallStack) +#elif MIN_VERSION_base(4,8,1) +import qualified GHC.Stack +type HasCallStack = (?callStack :: GHC.Stack.CallStack) +#else +import GHC.Exts (Constraint) +type HasCallStack = (() :: Constraint) +#endif diff --git a/src/Protolude/Conv.hs b/src/Protolude/Conv.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Conv.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} + +-- | An alternative to 'Protolude.ConvertText' that includes +-- partial conversions. Not re-exported by 'Protolude'. +module Protolude.Conv ( + StringConv +, strConv +, toS +, toSL +, Leniency (Lenient, Strict) +) 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 Protolude.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/Protolude/ConvertText.hs b/src/Protolude/ConvertText.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/ConvertText.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Safe #-} + +-- | Non-partial text conversion typeclass and functions. +-- For an alternative with partial conversions import 'Protolude.Conv'. +module Protolude.ConvertText ( + ConvertText (toS) +, toUtf8 +, toUtf8Lazy +) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT + +import Data.Function (id, (.)) +import Data.String (String) +import Data.Text.Encoding (encodeUtf8) + +-- | Convert from one Unicode textual type to another. Not for serialization/deserialization, +-- so doesn't have instances for bytestrings. +class ConvertText a b where + toS :: a -> b + +instance ConvertText String String where toS = id +instance ConvertText String T.Text where toS = T.pack +instance ConvertText String LT.Text where toS = LT.pack + +instance ConvertText T.Text String where toS = T.unpack +instance ConvertText T.Text LT.Text where toS = LT.fromStrict +instance ConvertText T.Text T.Text where toS = id + +instance ConvertText LT.Text String where toS = LT.unpack +instance ConvertText LT.Text T.Text where toS = LT.toStrict +instance ConvertText LT.Text LT.Text where toS = id + +instance ConvertText LB.ByteString B.ByteString where toS = LB.toStrict +instance ConvertText LB.ByteString LB.ByteString where toS = id + +instance ConvertText B.ByteString B.ByteString where toS = id +instance ConvertText B.ByteString LB.ByteString where toS = LB.fromStrict + +toUtf8 :: ConvertText a T.Text => a -> B.ByteString +toUtf8 = + encodeUtf8 . toS + +toUtf8Lazy :: ConvertText a T.Text => a -> LB.ByteString +toUtf8Lazy = + LB.fromStrict . encodeUtf8 . toS diff --git a/src/Protolude/Debug.hs b/src/Protolude/Debug.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Debug.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} + +module Protolude.Debug ( + undefined, + trace, + traceM, + traceId, + traceIO, + traceShow, + traceShowId, + traceShowM, + notImplemented, + witness, +) where + +import Data.Text (Text, unpack) +import Control.Monad (Monad, return) + +import qualified Protolude.Base as P +import Protolude.Error (error) +import Protolude.Show (Print, hPutStrLn) + +import System.IO(stderr) +import System.IO.Unsafe (unsafePerformIO) + +{-# WARNING trace "'trace' remains in code" #-} +trace :: Print b => b -> a -> a +trace string expr = unsafePerformIO (do + hPutStrLn stderr string + return expr) + +{-# WARNING traceIO "'traceIO' remains in code" #-} +traceIO :: Print b => b -> a -> P.IO a +traceIO string expr = do + hPutStrLn stderr string + return expr + +{-# WARNING traceShow "'traceShow' remains in code" #-} +traceShow :: P.Show a => a -> b -> b +traceShow a b = trace (P.show a) b + +{-# WARNING traceShowId "'traceShowId' remains in code" #-} +traceShowId :: P.Show a => a -> a +traceShowId a = trace (P.show a) a + +{-# WARNING traceShowM "'traceShowM' remains in code" #-} +traceShowM :: (P.Show a, Monad m) => a -> m () +traceShowM a = trace (P.show a) (return ()) + +{-# WARNING traceM "'traceM' remains in code" #-} +traceM :: (Monad m) => Text -> m () +traceM s = trace (unpack s) (return ()) + +{-# WARNING traceId "'traceId' remains in code" #-} +traceId :: Text -> Text +traceId s = trace s s + +{-# WARNING notImplemented "'notImplemented' remains in code" #-} +notImplemented :: a +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/Either.hs b/src/Protolude/Either.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Either.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Either ( + maybeToLeft +, maybeToRight +, leftToMaybe +, rightToMaybe +, maybeEmpty +, maybeToEither +, fromLeft +, fromRight +) where + +import Data.Function (const) +import Data.Monoid (Monoid, mempty) +import Data.Maybe (Maybe(Nothing, Just), maybe) +import Data.Either (Either(Left, Right), either) +#if MIN_VERSION_base(4,10,0) +import Data.Either (fromLeft, fromRight) +#else +-- | Return the contents of a 'Right'-value or a default value otherwise. +fromLeft :: a -> Either a b -> a +fromLeft _ (Left a) = a +fromLeft a _ = a + +-- | Return the contents of a 'Right'-value or a default value otherwise. +fromRight :: b -> Either a b -> b +fromRight _ (Right b) = b +fromRight b _ = b +#endif + +leftToMaybe :: Either l r -> Maybe l +leftToMaybe = either Just (const Nothing) + +rightToMaybe :: Either l r -> Maybe r +rightToMaybe = either (const Nothing) Just + +maybeToRight :: l -> Maybe r -> Either l r +maybeToRight l = maybe (Left l) Right + +maybeToLeft :: r -> Maybe l -> Either l r +maybeToLeft r = maybe (Right r) Left + +maybeEmpty :: Monoid b => (a -> b) -> Maybe a -> b +maybeEmpty = maybe mempty + +maybeToEither :: e -> Maybe a -> Either e a +maybeToEither e Nothing = Left e +maybeToEither _ (Just a) = Right a diff --git a/src/Protolude/Error.hs b/src/Protolude/Error.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Error.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ExistentialQuantification #-} +#if ( __GLASGOW_HASKELL__ >= 800 ) +{-# LANGUAGE TypeInType #-} +#endif + +#if MIN_VERSION_base(4,9,0) +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Protolude.Error +( error +) where + +import Data.Text (Text, unpack) + +#if MIN_VERSION_base(4,9,0) +-- Full stack trace. + +import GHC.Prim (TYPE, raise#) +import GHC.Types (RuntimeRep) +import Protolude.CallStack (HasCallStack) +import GHC.Exception (errorCallWithCallStackException) + +{-# WARNING error "'error' remains in code" #-} +error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => Text -> a +error s = raise# (errorCallWithCallStackException (unpack s) ?callStack) + +#elif MIN_VERSION_base(4,7,0) +-- Basic Call Stack with callsite. + +import GHC.Prim (raise#) +import GHC.Exception (errorCallException) + +{-# WARNING error "'error' remains in code" #-} +error :: Text -> a +error s = raise# (errorCallException (unpack s)) + +#else + +-- No exception tracing. +import GHC.Types +import GHC.Exception + +{-# WARNING error "'error' remains in code" #-} +error :: Text -> a +error s = throw (ErrorCall (unpack s)) + +#endif diff --git a/src/Protolude/Exceptions.hs b/src/Protolude/Exceptions.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Exceptions.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Exceptions ( + hush, + note, + tryIO, +) where + +import Protolude.Base (IO) +import Data.Function ((.)) +import Control.Monad.Trans (liftIO) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Except (ExceptT(ExceptT), MonadError, throwError) +import Control.Exception as Exception +import Control.Applicative +import Data.Maybe (Maybe, maybe) +import Data.Either (Either(Left,Right)) + +hush :: Alternative m => Either e a -> m a +hush (Left _) = empty +hush (Right x) = pure x + +-- To suppress redundant applicative constraint warning on GHC 8.0 +#if ( __GLASGOW_HASKELL__ >= 800 ) +note :: (MonadError e m) => e -> Maybe a -> m a +note err = maybe (throwError err) pure +#else +note :: (MonadError e m, Applicative m) => e -> Maybe a -> m a +note err = maybe (throwError err) pure +#endif + +tryIO :: MonadIO m => IO a -> ExceptT IOException m a +tryIO = ExceptT . liftIO . Exception.try diff --git a/src/Protolude/Functor.hs b/src/Protolude/Functor.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Functor.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Functor ( + Functor(fmap), + ($>), + (<$), + (<$>), + (<<$>>), + (<&>), + void, + foreach, +) where + +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(fmap) + , (<$) + , ($>) + , (<$>) + , void + ) +#else +import Data.Functor ( + Functor(fmap) + , (<$) + , (<$>) + ) + + +infixl 4 $> + +($>) :: Functor f => f a -> b -> f b +($>) = flip (<$) + +void :: Functor f => f a -> f () +void x = () <$ x +#endif + +infixl 4 <<$>> + +(<<$>>) :: (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/List.hs b/src/Protolude/List.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/List.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Protolude.List + ( head, + ordNub, + sortOn, + list, + product, + sum, + groupBy, + ) +where + +import Control.Applicative (pure) +import Data.Foldable (Foldable, foldl', foldr) +import Data.Function ((.)) +import Data.Functor (fmap) +import Data.List (groupBy, sortBy) +import Data.Maybe (Maybe (Nothing)) +import Data.Ord (Ord, comparing) +import qualified Data.Set as Set +import Prelude ((*), (+), Num) + +head :: (Foldable f) => f a -> Maybe a +head = foldr (\x _ -> pure x) Nothing + +sortOn :: (Ord o) => (a -> o) -> [a] -> [a] +sortOn = sortBy . comparing + +-- O(n * log n) +ordNub :: (Ord a) => [a] -> [a] +ordNub l = go Set.empty l + where + go _ [] = [] + go s (x : xs) = + if x `Set.member` s + then go s xs + else x : go (Set.insert x s) xs + +list :: [b] -> (a -> b) -> [a] -> [b] +list def f xs = case xs of + [] -> def + _ -> fmap f xs + +{-# INLINE product #-} +product :: (Foldable f, Num a) => f a -> a +product = foldl' (*) 1 + +{-# INLINE sum #-} +sum :: (Foldable f, Num a) => f a -> a +sum = foldl' (+) 0 diff --git a/src/Protolude/Monad.hs b/src/Protolude/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Monad.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Monad ( + Monad((>>=), return) + , MonadPlus(mzero, mplus) + + , (=<<) + , (>=>) + , (<=<) + , (>>) + , forever + + , join + , mfilter + , filterM + , mapAndUnzipM + , zipWithM + , zipWithM_ + , foldM + , foldM_ + , replicateM + , replicateM_ + , concatMapM + + , guard + , when + , unless + + , liftM + , liftM2 + , liftM3 + , liftM4 + , liftM5 + , liftM' + , liftM2' + , ap + + , (<$!>) + ) where + +import Protolude.Base (seq) +import Data.List (concat) +import Control.Monad + +concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] +concatMapM f xs = liftM concat (mapM f xs) + +liftM' :: Monad m => (a -> b) -> m a -> m b +liftM' = (<$!>) +{-# INLINE liftM' #-} + +liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c +liftM2' f a b = do + x <- a + y <- b + let z = f x y + z `seq` return z +{-# INLINE liftM2' #-} + +#if !MIN_VERSION_base(4,8,0) +(<$!>) :: Monad m => (a -> b) -> m a -> m b +f <$!> m = do + x <- m + let z = f x + z `seq` return z +{-# INLINE (<$!>) #-} +#endif diff --git a/src/Protolude/Panic.hs b/src/Protolude/Panic.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Panic.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +#if MIN_VERSION_base(4,9,0) +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Protolude.Panic ( + FatalError(FatalError, fatalErrorMessage), + panic, +) where + +import Protolude.Base (Show) +import Protolude.CallStack (HasCallStack) +import Data.Text (Text) +import Data.Typeable (Typeable) +import Control.Exception as X + +-- | Uncatchable exceptions thrown and never caught. +newtype FatalError = FatalError { fatalErrorMessage :: Text } + deriving (Show, Typeable) + +instance Exception FatalError + +panic :: HasCallStack => Text -> a +panic a = throw (FatalError a) diff --git a/src/Protolude/Partial.hs b/src/Protolude/Partial.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Partial.hs @@ -0,0 +1,26 @@ +module Protolude.Partial + ( head, + init, + tail, + last, + foldl, + foldr, + foldl', + foldr', + foldr1, + foldl1, + cycle, + maximum, + minimum, + (!!), + sum, + product, + fromJust, + read, + ) +where + +import Data.Foldable (foldl, foldl', foldl1, foldr, foldr', foldr1, product, sum) +import Data.List ((!!), cycle, head, init, last, maximum, minimum, tail) +import Data.Maybe (fromJust) +import Text.Read (read) 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(Nothing, Just), fromMaybe) +import Data.Either (Either(Left, Right)) +import Data.Function ((.)) +import Data.List (null, head, last, tail, init, maximum, minimum, foldr1, foldl1, foldl1', (++)) + +import Prelude ((-)) +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 diff --git a/src/Protolude/Semiring.hs b/src/Protolude/Semiring.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Semiring.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Semiring + ( Semiring, + one, + (<.>), + zero, + ) +where + +import Data.Monoid + +-- | Alias for 'mempty' +zero :: Monoid m => m +zero = mempty + +class Monoid m => Semiring m where + {-# MINIMAL one, (<.>) #-} + + one :: m + (<.>) :: m -> m -> m diff --git a/src/Protolude/Show.hs b/src/Protolude/Show.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Show.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Show + ( Print, + hPutStr, + putStr, + hPutStrLn, + putStrLn, + putErrLn, + putText, + putErrText, + putLText, + putByteString, + putLByteString, + ) +where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Function ((.)) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL +import qualified Protolude.Base as Base +import qualified System.IO as Base +import System.IO (Handle, stderr, stdout) + +class Print a where + hPutStr :: MonadIO m => Handle -> a -> m () + putStr :: MonadIO m => a -> m () + putStr = hPutStr stdout + hPutStrLn :: MonadIO m => Handle -> a -> m () + putStrLn :: MonadIO m => a -> m () + putStrLn = hPutStrLn stdout + putErrLn :: MonadIO m => a -> m () + putErrLn = hPutStrLn stderr + +instance Print T.Text where + hPutStr = \h -> liftIO . T.hPutStr h + hPutStrLn = \h -> liftIO . T.hPutStrLn h + +instance Print TL.Text where + hPutStr = \h -> liftIO . TL.hPutStr h + hPutStrLn = \h -> liftIO . TL.hPutStrLn h + +instance Print BS.ByteString where + hPutStr = \h -> liftIO . BS.hPutStr h + hPutStrLn = \h -> liftIO . BS.hPutStrLn h + +instance Print BL.ByteString where + hPutStr = \h -> liftIO . BL.hPutStr h + hPutStrLn = \h -> liftIO . BL.hPutStrLn h + +instance Print [Base.Char] where + hPutStr = \h -> liftIO . Base.hPutStr h + hPutStrLn = \h -> liftIO . Base.hPutStrLn h + +-- For forcing type inference +putText :: MonadIO m => T.Text -> m () +putText = putStrLn +{-# SPECIALIZE putText :: T.Text -> Base.IO () #-} + +putLText :: MonadIO m => TL.Text -> m () +putLText = putStrLn +{-# SPECIALIZE putLText :: TL.Text -> Base.IO () #-} + +putByteString :: MonadIO m => BS.ByteString -> m () +putByteString = putStrLn +{-# SPECIALIZE putByteString :: BS.ByteString -> Base.IO () #-} + +putLByteString :: MonadIO m => BL.ByteString -> m () +putLByteString = putStrLn +{-# SPECIALIZE putLByteString :: BL.ByteString -> Base.IO () #-} + +putErrText :: MonadIO m => T.Text -> m () +putErrText = putErrLn +{-# SPECIALIZE putErrText :: T.Text -> Base.IO () #-} diff --git a/src/Protolude/Unsafe.hs b/src/Protolude/Unsafe.hs new file mode 100644 --- /dev/null +++ b/src/Protolude/Unsafe.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Protolude.Unsafe ( + unsafeHead, + unsafeTail, + unsafeInit, + unsafeLast, + unsafeFromJust, + unsafeIndex, + unsafeThrow, + unsafeRead, +) where + +import Protolude.Base (Int) + +#if ( __GLASGOW_HASKELL__ >= 800 ) +import Protolude.Base (HasCallStack) +#endif +import Data.Char (Char) +import Text.Read (Read, read) +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import qualified Control.Exception as Exc + +unsafeThrow :: Exc.Exception e => e -> a +unsafeThrow = Exc.throw + +#if ( __GLASGOW_HASKELL__ >= 800 ) +unsafeHead :: HasCallStack => [a] -> a +unsafeHead = List.head + +unsafeTail :: HasCallStack => [a] -> [a] +unsafeTail = List.tail + +unsafeInit :: HasCallStack => [a] -> [a] +unsafeInit = List.init + +unsafeLast :: HasCallStack => [a] -> a +unsafeLast = List.last + +unsafeFromJust :: HasCallStack => Maybe.Maybe a -> a +unsafeFromJust = Maybe.fromJust + +unsafeIndex :: HasCallStack => [a] -> Int -> a +unsafeIndex = (List.!!) + +unsafeRead :: (HasCallStack, Read a) => [Char] -> a +unsafeRead = Text.Read.read +#endif + + +#if ( __GLASGOW_HASKELL__ < 800 ) +unsafeHead :: [a] -> a +unsafeHead = List.head + +unsafeTail :: [a] -> [a] +unsafeTail = List.tail + +unsafeInit :: [a] -> [a] +unsafeInit = List.init + +unsafeLast :: [a] -> a +unsafeLast = List.last + +unsafeFromJust :: Maybe.Maybe a -> a +unsafeFromJust = Maybe.fromJust + +unsafeIndex :: [a] -> Int -> a +unsafeIndex = (List.!!) + +unsafeRead :: Read a => [Char] -> a +unsafeRead = Text.Read.read +#endif diff --git a/src/Semiring.hs b/src/Semiring.hs deleted file mode 100644 --- a/src/Semiring.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Semiring ( - Semiring(..), - zero, -) where - -import Data.Monoid - --- | Alias for 'mempty' -zero :: Monoid m => m -zero = mempty - -class Monoid m => Semiring m where - {-# MINIMAL one, (<.>) #-} - - one :: m - (<.>) :: m -> m -> m diff --git a/src/Show.hs b/src/Show.hs deleted file mode 100644 --- a/src/Show.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ExtendedDefaultRules #-} - -module Show ( - Print(..), - putText, - putLText, -) where - -import qualified Base -import Data.Function ((.)) - -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as BL - -import qualified Data.Text as T -import qualified Data.Text.IO as T - -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL - - -class Print a where - putStr :: MonadIO m => a -> m () - putStrLn :: MonadIO m => a -> m () - -instance Print T.Text where - putStr = liftIO . T.putStr - putStrLn = liftIO . T.putStrLn - -instance Print TL.Text where - putStr = liftIO . TL.putStr - putStrLn = liftIO . TL.putStrLn - -instance Print BS.ByteString where - putStr = liftIO . BS.putStr - putStrLn = liftIO . BS.putStrLn - -instance Print BL.ByteString where - putStr = liftIO . BL.putStr - putStrLn = liftIO . BL.putStrLn - -instance Print [Base.Char] where - putStr = liftIO . Base.putStr - putStrLn = liftIO . Base.putStrLn - --- For forcing type inference -putText :: MonadIO m => T.Text -> m () -putText = putStrLn -{-# SPECIALIZE putText :: T.Text -> Base.IO () #-} - -putLText :: MonadIO m => TL.Text -> m () -putLText = putStrLn -{-# SPECIALIZE putLText :: TL.Text -> Base.IO () #-} diff --git a/src/Unsafe.hs b/src/Unsafe.hs deleted file mode 100644 --- a/src/Unsafe.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Unsafe ( - unsafeHead, - unsafeTail, - unsafeInit, - unsafeLast, - 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 - -unsafeTail :: [a] -> [a] -unsafeTail = List.tail - -unsafeInit :: [a] -> [a] -unsafeInit = List.init - -unsafeLast :: [a] -> a -unsafeLast = List.last - -unsafeFromJust :: Maybe.Maybe a -> a -unsafeFromJust = Maybe.fromJust - -unsafeIndex :: [a] -> Int -> a -unsafeIndex = (List.!!) - -unsafeThrow :: Exc.Exception e => e -> a -unsafeThrow = Exc.throw