From 29b854cf98d28b7dcb3f19e5559d2e17d775cfdb Mon Sep 17 00:00:00 2001 From: Stephen Diehl Date: Thu, 7 Apr 2016 15:22:44 -0400 Subject: [PATCH] initial commit --- .ghci | 1 + .gitignore | 2 + LICENSE | 19 ++++ protolude.cabal | 51 +++++++++ src/Applicative.hs | 18 +++ src/Bool.hs | 27 +++++ src/Debug.hs | 46 ++++++++ src/Either.hs | 22 ++++ src/Function.hs | 0 src/List.hs | 29 +++++ src/Monad.hs | 56 ++++++++++ src/Protolude.hs | 268 +++++++++++++++++++++++++++++++++++++++++++++ src/Show.hs | 55 ++++++++++ src/Unsafe.hs | 28 +++++ stack.yaml | 34 ++++++ 15 files changed, 656 insertions(+) create mode 100644 .ghci create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 protolude.cabal create mode 100644 src/Applicative.hs create mode 100644 src/Bool.hs create mode 100644 src/Debug.hs create mode 100644 src/Either.hs create mode 100644 src/Function.hs create mode 100644 src/List.hs create mode 100644 src/Monad.hs create mode 100644 src/Protolude.hs create mode 100644 src/Show.hs create mode 100644 src/Unsafe.hs create mode 100644 stack.yaml diff --git a/.ghci b/.ghci new file mode 100644 index 000000000..29a3cb319 --- /dev/null +++ b/.ghci @@ -0,0 +1 @@ +:set -XNoImplicitPrelude diff --git a/.gitignore b/.gitignore new file mode 100644 index 000000000..002f47523 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.stack-work +dist diff --git a/LICENSE b/LICENSE new file mode 100644 index 000000000..d7e3e5b9c --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2014-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/protolude.cabal b/protolude.cabal new file mode 100644 index 000000000..942553ea9 --- /dev/null +++ b/protolude.cabal @@ -0,0 +1,51 @@ +name: protolude +version: 0.1.0 +synopsis: A sensible start of defaults +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.3, + GHC == 7.8.0 + GHC == 7.10.3 +Bug-Reports: https://github.com/sdiehl/protolude/issues + +library + exposed-modules: + Protolude + + other-modules: + Applicative + Bool + Debug + List + Monad + + default-extensions: + NoImplicitPrelude + + ghc-options: + -Wall + -Werror + + build-depends: + base >= 4.6 && <4.10, + safe >= 0.3 && <0.4, + async >= 2.1 && <2.2, + deepseq >= 1.3 && <= 1.5, + containers >= 0.5 && <0.6, + semiring-simple >= 1.0 && <1.1, + mtl >= 2.1 && <2.3, + transformers >= 0.4 && < 0.6, + text >= 1.2 && <1.3, + string-conv >= 0.1 && <0.2, + bytestring >= 0.10 && <0.11 + + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Applicative.hs b/src/Applicative.hs new file mode 100644 index 000000000..596437654 --- /dev/null +++ b/src/Applicative.hs @@ -0,0 +1,18 @@ +module Applicative ( + orAlt, + orEmpty, + eitherA, +) where + +import Data.Monoid +import Control.Applicative +import Prelude (Bool, Either(..)) + +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/Bool.hs b/src/Bool.hs new file mode 100644 index 000000000..797f96c88 --- /dev/null +++ b/src/Bool.hs @@ -0,0 +1,27 @@ +module Bool ( + whenM + , unlessM + , ifM + , guardM + , bool + ) where + +import Prelude +import Control.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/Debug.hs b/src/Debug.hs new file mode 100644 index 000000000..0e3eaade4 --- /dev/null +++ b/src/Debug.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Debug ( + undefined + , error + , trace + , traceM + , traceIO + , traceShow + , traceShowM + , notImplemented + ) where + +import qualified Prelude as P +import qualified Debug.Trace as T + +--{-# WARNING undefined "Do not use 'undefined' in production code" #-} +undefined :: a +undefined = P.undefined + +--{-# WARNING error "Do not use 'error' in production code" #-} +error :: P.String -> a +error = P.error + +--{-# WARNING trace "Do not use 'trace' in production code" #-} +trace :: P.String -> a -> a +trace = T.trace + +--{-# WARNING trace "Do not use 'trace' in production code" #-} +traceShow :: P.Show a => a -> a +traceShow a = T.trace (P.show a) a + +--{-# WARNING trace "Do not use 'trace' in production code" #-} +traceShowM :: (P.Show a, P.Monad m) => a -> m () +traceShowM a = T.traceM (P.show a) + +--{-# WARNING traceM "Do not use 'traceM' in production code" #-} +traceM :: P.Monad m => P.String -> m () +traceM = T.traceM + +--{-# WARNING traceIO "Do not use 'traceIO' in production code" #-} +traceIO :: P.String -> P.IO () +traceIO = T.traceIO + +notImplemented :: a +notImplemented = P.error "Not implemented" diff --git a/src/Either.hs b/src/Either.hs new file mode 100644 index 000000000..1e7809a22 --- /dev/null +++ b/src/Either.hs @@ -0,0 +1,22 @@ +module P.Either ( + maybeToLeft +, maybeToRight +, leftToMaybe +, rightToMaybe +, maybeToEither +) where + +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 => Maybe a -> Either b a +maybeToEither = maybe mempty diff --git a/src/Function.hs b/src/Function.hs new file mode 100644 index 000000000..e69de29bb diff --git a/src/List.hs b/src/List.hs new file mode 100644 index 000000000..d3555ae34 --- /dev/null +++ b/src/List.hs @@ -0,0 +1,29 @@ +module List ( + head, + ordNub, + sortOn, +) where + +import Data.List (sortBy) +import Data.Maybe (Maybe(..)) +import Data.Ord (Ord, comparing) +import Data.Foldable (Foldable, foldr) +import Data.Function ((.)) +import Control.Monad (return) +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 diff --git a/src/Monad.hs b/src/Monad.hs new file mode 100644 index 000000000..027fdd171 --- /dev/null +++ b/src/Monad.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Monad ( + Monad(..) + , 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 Prelude (concat, seq) +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' #-} diff --git a/src/Protolude.hs b/src/Protolude.hs new file mode 100644 index 000000000..be5adaf8f --- /dev/null +++ b/src/Protolude.hs @@ -0,0 +1,268 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +module Protolude ( + module X, + identity, + bool, + (&), + uncons, + applyN, + print, + + LText, + LByteString, +) where + +import qualified Prelude as P + +import qualified List as X +import qualified Show as X +import qualified Bool as X +import qualified Debug as X +import qualified Monad as X +import qualified Applicative as X + +-- Maybe'ized version of partial functions +import Safe as X ( + headMay, + initMay, + tailMay + ) + +-- Applicatives +import Control.Applicative as X ( + Applicative(..) + , Alternative(..) + , Const(..) + , ZipList(..) + , (<**>) + , liftA + , liftA2 + , liftA3 + , optional + ) + +-- Base typeclasses +import Data.Eq as X +import Data.Ord as X +import Data.Monoid as X +import Data.Traversable as X +import Data.Foldable as X hiding ( + foldr1 + , foldl1 + , maximum + , maximumBy + , minimum + , minimumBy + ) +import Data.Semiring as X +import Data.Functor.Identity as X +import Data.Functor as X ( + Functor(..) + , ($>) + , (<$>) + , void + ) + +-- Deepseq +import Control.DeepSeq as X ( + NFData(..) + , ($!!) + , deepseq + , force + ) + +-- Data structures +import Data.Tuple as X +import Data.List as X ( + splitAt + , break + , intercalate + , isPrefixOf + , drop + , filter + , reverse + , replicate + ) + +import Control.Monad.State as X ( + MonadState, + State, + StateT, + put, + get, + gets, + modify, + withState, + + runStateT, + execStateT, + evalStateT, + ) + +import Control.Monad.Reader as X ( + MonadReader, + Reader, + ReaderT, + ask, + asks, + local, + runReader, + runReaderT, + ) + +import Control.Monad.Except as X ( + MonadError, + Except, + ExceptT, + throwError, + catchError, + runExcept, + runExceptT, + ) + +import Control.Monad.Trans as X ( + MonadIO, + lift, + liftIO, + ) + +-- Common data structure types +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) + +-- Base types +import Data.Int as X +import Data.Bits as X +import Data.Word as X +import Data.Bool as X hiding (bool) +import Data.Char as X (Char) +import Data.Maybe as X hiding (fromJust) +import Data.Either as X +import Data.Complex as X + +import Data.Function as X ( + id + , const + , (.) + , flip + , fix + , on + ) + +-- Base GHC types +import GHC.Num as X +import GHC.Real as X +import GHC.Float as X +import GHC.Show as X +import GHC.Exts as X ( + Constraint + , Ptr + , FunPtr + , the + ) + +import GHC.Generics ( + Generic(..) + , Rep + , K1(..) + , M1(..) + , U1(..) + , V1 + , D1 + , C1 + , S1 + , (:+:) + , (:*:) + , NoSelector + , Rec0 + , Par0 + , Constructor(..) + , Selector(..) + , Arity(..) + , Fixity(..) + ) + +-- ByteString +import qualified Data.ByteString.Lazy +import qualified Data.ByteString as X (ByteString) + +-- Text +import Data.Text as X (Text) +import qualified Data.Text.Lazy +import qualified Data.Text.IO +import Text.Printf as X (printf) + +import Data.Text.Lazy ( + toStrict + , fromStrict + ) + +import Data.String.Conv as X ( + strConv + , toS + , toSL + , Leniency(..) + ) + +-- Printf +import Text.Printf as Exports ( + PrintfArg + , printf + , hPrintf + ) + +-- IO +import System.Exit as X +import System.Environment as X (getArgs) +import System.IO as X ( + Handle + , hClose + ) + +-- ST +import Control.Monad.ST as ST + +-- Concurrency and Parallelism +import Control.Exception as X +import Control.Concurrent as X +import Control.Concurrent.Async as X + + +import Foreign.Storable as Exports (Storable) + +-- Read instances hiding unsafe builtins (read) +import Text.Read as X ( + Read + , reads + , readMaybe + , readEither + ) + +-- 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 + +bool :: a -> a -> Bool -> a +bool f t b = if b then t else f + +identity :: a -> a +identity x = x + +uncons :: [a] -> Maybe (a, [a]) +uncons [] = Nothing +uncons (x:xs) = Just (x, xs) + +applyN :: Int -> (a -> a) -> a -> a +applyN n f = X.foldr (.) id (X.replicate n f) + +print :: (X.MonadIO m, P.Show a) => a -> m () +print = liftIO . P.print diff --git a/src/Show.hs b/src/Show.hs new file mode 100644 index 000000000..1c3d26716 --- /dev/null +++ b/src/Show.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Show ( + Print(..), + putText, + putLText, +) where + +import Prelude ((.), Char, IO) +import qualified Prelude + +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 [Char] where + putStr = liftIO . Prelude.putStr + putStrLn = liftIO . Prelude.putStrLn + +-- For forcing type inference +putText :: MonadIO m => T.Text -> m () +putText = putStrLn +{-# SPECIALIZE putText :: T.Text -> IO () #-} + +putLText :: MonadIO m => TL.Text -> m () +putLText = putStrLn +{-# SPECIALIZE putLText :: TL.Text -> IO () #-} diff --git a/src/Unsafe.hs b/src/Unsafe.hs new file mode 100644 index 000000000..49d0eb0d7 --- /dev/null +++ b/src/Unsafe.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Unsafe where + +import qualified Prelude +import qualified Data.Maybe +import qualified Data.List + +unsafeHead :: [a] -> a +unsafeHead = Prelude.head + +unsafeTail :: [a] -> [a] +unsafeTail = Prelude.tail + +unsafeInit :: [a] -> [a] +unsafeInit = Prelude.init + +unsafeLast :: [a] -> a +unsafeLast = Prelude.last + +fromJust :: Prelude.Maybe a -> a +fromJust = Data.Maybe.fromJust + +unsafeIndex :: [a] -> Prelude.Int -> a +unsafeIndex = (Data.List.!!) + +(!!) :: [a] -> Prelude.Int -> a +(!!) = (Data.List.!!) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 000000000..029f3726e --- /dev/null +++ b/stack.yaml @@ -0,0 +1,34 @@ +# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md + +# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) +resolver: lts-5.10 + +# Local packages, usually specified by relative directory name +packages: +- '.' + +# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) +extra-deps: +- semiring-simple-1.0.0.1 +- string-conv-0.1 + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true + +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: >= 0.1.4.0 + +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 + +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir]