diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2016, 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 +deal in the Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +sell copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Applicative.hs b/src/Applicative.hs new file mode 100644 --- /dev/null +++ b/src/Applicative.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Applicative + ( orAlt + , orEmpty + , eitherA + ) where + +import Control.Applicative +import Data.Bool (Bool) +import Data.Either (Either (..)) +import Data.Monoid (Monoid (..)) + +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) diff --git a/src/Base.hs b/src/Base.hs new file mode 100644 --- /dev/null +++ b/src/Base.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Unsafe #-} + +module Base + ( module X + , ($!) + ) where + +-- Glorious Glasgow Haskell Compiler +#if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 ) + +-- Base GHC types +import GHC.Base as X (asTypeOf, maxInt, minInt, ord, seq, (++)) +import GHC.Enum as X +import GHC.Err as X (error, undefined) +import GHC.Exts as X (Constraint, FunPtr, Ptr) +import GHC.Float as X +import GHC.Num as X +import GHC.Real as X hiding ((%)) +import GHC.Show as X (Show (..)) +import System.IO as X (print, putStr, putStrLn) + +import GHC.Types as X (Bool, Char, Coercible, IO, Int, Ordering, + Word) + +#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, + currentCallStack, getCallStack, + prettyCallStack, prettySrcLoc) + +{- +import GHC.Records as X ( + HasField(..) + ) +-} + +#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 new file mode 100644 --- /dev/null +++ b/src/Bifunctor.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Bifunctor + ( Bifunctor (..) + ) where + +import Control.Applicative (Const (..)) +import Data.Either (Either (..)) +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/Bool.hs b/src/Bool.hs new file mode 100644 --- /dev/null +++ b/src/Bool.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Bool + ( whenM + , unlessM + , ifM + , guardM + , bool + ) where + +import Control.Monad (Monad, MonadPlus, guard, unless, when, (=<<), (>>=)) +import Data.Bool (Bool) +import Data.Function (flip) + +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 new file mode 100644 --- /dev/null +++ b/src/Conv.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Trustworthy #-} +{-# 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 Control.Applicative (pure) +import Data.Eq (Eq (..)) +import Data.Function (id, (.)) +import Data.Ord (Ord (..)) +import Data.String (String) + +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 new file mode 100644 --- /dev/null +++ b/src/Debug.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Trustworthy #-} + +module Debug + ( undefined + , error + , trace + , traceM + , traceId + , traceIO + , traceShow + , traceShowId + , traceShowM + , notImplemented, + ) where + +import Control.Monad (Monad, return) +import Data.Text (Text, unpack) + +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 (or use 'panic')" #-} +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 + +{-# WARNING notImplemented "'notImplemented' remains in code" #-} +notImplemented :: a +notImplemented = P.error "Not implemented" + +{-# WARNING undefined "'undefined' remains in code (or use 'panic')" #-} +undefined :: a +undefined = P.undefined diff --git a/src/Either.hs b/src/Either.hs new file mode 100644 --- /dev/null +++ b/src/Either.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Either + ( maybeToLeft + , maybeToRight + , leftToMaybe + , rightToMaybe + , maybeToEither + ) where + +import Data.Either (Either (..), either) +import Data.Function (const) +import Data.Maybe (Maybe (..), maybe) +import Data.Monoid (Monoid, mempty) + +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/Functor.hs b/src/Functor.hs new file mode 100644 --- /dev/null +++ b/src/Functor.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Functor + ( Functor (..) + , ($>) + , (<$>) + , void + ) where + +#if (__GLASGOW_HASKELL__ >= 710) +import Data.Functor (Functor (..), void, ($>), (<$>)) +#else +import Data.Functor (Functor (..), (<$>)) + +import Data.Function (flip) + +infixl 4 $> + +($>) :: Functor f => f a -> b -> f b +($>) = flip (<$) + +void :: Functor f => f a -> f () +void x = () <$ x +#endif diff --git a/src/List.hs b/src/List.hs new file mode 100644 --- /dev/null +++ b/src/List.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module List + ( head + , ordNub + , sortOn + , list + ) where + +import Control.Monad (return) +import Data.Foldable (Foldable, foldr) +import Data.Function ((.)) +import Data.Functor (fmap) +import Data.List (sortBy) +import Data.Maybe (Maybe (..)) +import Data.Ord (Ord, comparing) +import qualified Data.Set as Set + +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 diff --git a/src/Monad.hs b/src/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Monad.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Trustworthy #-} + +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 new file mode 100644 --- /dev/null +++ b/src/Panic.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE Trustworthy #-} + +module Panic + ( FatalError (..) + , panic + ) where + +import Base (Show) +import Control.Exception as X +import Data.Text (Text) +import Data.Typeable (Typeable) + +-- | 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/Semiring.hs b/src/Semiring.hs new file mode 100644 --- /dev/null +++ b/src/Semiring.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +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 new file mode 100644 --- /dev/null +++ b/src/Show.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeSynonymInstances #-} + +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/Universum.hs b/src/Universum.hs new file mode 100644 --- /dev/null +++ b/src/Universum.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +module Universum + ( -- * Reexports from base and from modules in this repo + module X + , module Base + + -- * Useful standard unclassifed functions + , identity + , map + , (&) + , uncons + , unsnoc + , applyN + , print + , throwIO + , throwTo + , foreach + , show + + -- * Convenient type aliases + , LText + , LByteString + ) where + +import Applicative as X +import Bool as X +import Conv as X +import Debug as X +import Either as X +import Functor as X +import List as X +import Monad as X +import Panic as X +import Show as X + +import Base as Base hiding (error, print, putStr, putStrLn, + show, showFloat, showList, showSigned, + showSignedFloat, showsPrec, undefined) +import qualified Base as PBase + +-- 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 (atDef, atMay, foldl1May, foldr1May, + headDef, headMay, initDef, initMay, + initSafe, lastDef, lastMay, tailDef, + tailMay, tailSafe) + +-- Applicatives +import Control.Applicative as X (Alternative (..), Applicative (..), + Const (..), ZipList (..), liftA, liftA2, + liftA3, optional, (<**>)) + +-- Base typeclasses +import Data.Eq as X +import Data.Foldable as X hiding (foldl1, foldr1) +import Data.Functor.Identity as X +import Data.Ord as X +import Data.Traversable as X hiding (for) +import Semiring as X + +#if ( __GLASGOW_HASKELL__ >= 800 ) +import Data.Monoid as X hiding ((<>)) +import Data.Semigroup as X (Semigroup (..)) +#else +import Data.Monoid as X +#endif + +#if (__GLASGOW_HASKELL__ >= 710) +import Data.Bifunctor as X (Bifunctor (..)) +#else +import Bifunctor as X (Bifunctor (..)) +#endif + +-- Deepseq +import Control.DeepSeq as X (NFData (..), deepseq, force, ($!!)) + +-- Data structures +import Data.List as X (break, cycle, drop, dropWhile, filter, + group, inits, intercalate, intersperse, + isPrefixOf, iterate, permutations, repeat, + replicate, reverse, scanl, scanr, sort, + sortBy, splitAt, subsequences, tails, + take, takeWhile, transpose, unfoldr, zip, + zipWith) +import Data.Tuple as X + +import Data.HashMap.Strict as X (HashMap) +import Data.HashSet as X (HashSet) +import Data.IntMap.Strict as X (IntMap) +import Data.IntSet as X (IntSet) +import Data.Map.Strict as X (Map) +import Data.Sequence as X (Seq) +import Data.Set as X (Set) + +#if ( __GLASGOW_HASKELL__ >= 710 ) +import Data.Proxy as X (Proxy (..)) +import Data.Typeable as X (Typeable) +import Data.Void as X (Void, absurd, vacuous) +#endif + +-- Monad transformers +import Control.Monad.State as X (MonadState, State, StateT, evalState, + evalStateT, execState, execStateT, gets, + modify, runState, runStateT, state, + withState) + +import Control.Monad.Reader as X (MonadReader, Reader, ReaderT, ask, asks, + local, reader, runReader, runReaderT) + +import Control.Monad.Except as X (Except, ExceptT, MonadError, catchError, + runExcept, runExceptT, throwError) + +import Control.Monad.Trans as X (MonadIO, lift, liftIO) + +-- Base types +import Data.Bits as X hiding (unsafeShiftL, unsafeShiftR) +import Data.Bool as X hiding (bool) +import Data.Char as X (chr) +import Data.Complex as X +import Data.Either as X +import Data.Int as X +import Data.Maybe as X hiding (fromJust) +import Data.Word as X + +import Data.Function as X (const, fix, flip, on, ($), (.)) + +-- Generics +import GHC.Generics as X (Generic) + +-- ByteString +import Data.ByteString as X (ByteString) +import qualified Data.ByteString.Lazy + +-- Text +import Data.Text as X (Text) +import qualified Data.Text.Lazy + +import Data.Text.IO as X (appendFile, getContents, getLine, + interact, readFile, writeFile) + +import Data.Text.Lazy as X (fromStrict, toStrict) + +import Data.Text.Encoding as X (decodeUtf8, decodeUtf8', decodeUtf8With, + encodeUtf8) + +-- IO +import System.Environment as X (getArgs) +import System.Exit as X +import System.IO as X (FilePath, Handle, IOMode (..), openFile, + stderr, stdin, stdout, withFile) + +-- ST +import Control.Monad.ST as X + +-- Concurrency and Parallelism +import Control.Exception as X hiding (assert, displayException, throw, + throwIO, throwTo) + +import qualified Control.Exception + +import Control.Concurrent as X hiding (throwTo) +import Control.Concurrent.Async as X hiding (wait) +import Control.Monad.STM as X + +import Foreign.Storable as X (Storable) + +-- Read instances hiding unsafe builtins (read) +import Text.Read as X (Read, readEither, readMaybe, reads) + +-- Type synonymss for lazy texts +type LText = Data.Text.Lazy.Text +type LByteString = Data.ByteString.Lazy.ByteString + +infixl 1 & + +(&) :: a -> (a -> b) -> b +x & f = f x + +identity :: a -> a +identity x = x + +map :: Functor f => (a -> b) -> f a -> f b +map = fmap + +uncons :: [a] -> Maybe (a, [a]) +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) + +print :: (X.MonadIO m, PBase.Show a) => a -> m () +print = liftIO . PBase.print + +throwIO :: (X.MonadIO m, Exception e) => e -> m a +throwIO = liftIO . Control.Exception.throwIO + +throwTo :: (X.MonadIO m, Exception e) => ThreadId -> e -> m () +throwTo tid e = liftIO (Control.Exception.throwTo tid e) + +foreach :: Functor f => f a -> (a -> b) -> f b +foreach = flip fmap + +show :: (Show a, StringConv String b) => a -> b +show x = 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 #-} diff --git a/src/Unsafe.hs b/src/Unsafe.hs new file mode 100644 --- /dev/null +++ b/src/Unsafe.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Unsafe #-} + +module Unsafe + ( unsafeHead + , unsafeTail + , unsafeInit + , unsafeLast + , unsafeFromJust + , unsafeIndex + , unsafeThrow + ) where + +import Base (Int) +import qualified Control.Exception as Exc +import qualified Data.List as List +import qualified Data.Maybe as Maybe + +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 diff --git a/universum.cabal b/universum.cabal new file mode 100644 --- /dev/null +++ b/universum.cabal @@ -0,0 +1,74 @@ +name: universum +version: 0.1.8 +synopsis: A sensible set of defaults for writing custom Preludes. +description: A sensible set of defaults for writing custom Preludes. +homepage: https://github.com/serokell/universum +license: MIT +license-file: LICENSE +author: Stephen Diehl +maintainer: hi@serokell.io +copyright: 2016-2016 Stephen Diehl, 2016-2016 Serokell +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/serokell/universum/issues + +description: + A sensible set of defaults for writing custom Preludes. +Source-Repository head + type: git + location: git@github.com:serokell/universum.git + +library + exposed-modules: + Universum + Unsafe + Base + Applicative + Bool + Debug + List + Monad + Show + Conv + Either + Functor + Semiring + Bifunctor + Panic + + default-extensions: + NoImplicitPrelude + OverloadedStrings + + ghc-options: + -Wall + -fwarn-implicit-prelude + + build-depends: + async >= 2.1 && <2.2, + base >= 4.6 && <4.10, + bytestring >= 0.10 && <0.11, + containers >= 0.5 && <0.6, + deepseq >= 1.3 && <1.5, + ghc-prim >= 0.3 && <0.6, + mtl >= 2.1 && <2.3, + safe >= 0.3 && <0.4, + stm >= 2.4 && <2.5, + text >= 1.2 && <1.3, + transformers >= 0.4 && <0.6, + unordered-containers + + hs-source-dirs: src + default-language: Haskell2010