initial commit

This commit is contained in:
Stephen Diehl
2016-04-07 15:22:44 -04:00
commit 29b854cf98
15 changed files with 656 additions and 0 deletions
+1
View File
@@ -0,0 +1 @@
:set -XNoImplicitPrelude
+2
View File
@@ -0,0 +1,2 @@
.stack-work
dist
+19
View File
@@ -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.
+51
View File
@@ -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
+18
View File
@@ -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)
+27
View File
@@ -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
+46
View File
@@ -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"
+22
View File
@@ -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
View File
+29
View File
@@ -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
+56
View File
@@ -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' #-}
+268
View File
@@ -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
+55
View File
@@ -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 () #-}
+28
View File
@@ -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.!!)
+34
View File
@@ -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]