diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2021 Andre Van Der Merwe + +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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,84 @@ +# Verset + +[![Haskell-CI](https://github.com/andrevdm/verset/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/andrevdm/verset/actions/workflows/haskell-ci.yml) + +Small Haskell alternative prelude based on [Protolude](https://hackage.haskell.org/package/protolude) and [Intro](https://hackage.haskell.org/package/intro) + +## Why +(*At least it is not a monad tutorial*) + +There are some great alternative preludes around but I find most of them either too large or too opinionated. +What I'd rather have is a minimal prelude and then layer additional changes over it. +Obviously if the other preludes suit you better, then Verset is not for you :) + +## Goals + - Very small + - Minimal dependencies + - Removes partial functions where possible + - It be easy to switch from `Verset` to other preludes + +## Notes + - `catch`, `finally` etc are not exported. This makes it easier to use e.g. `Control.Exception.Safe`, `UnliftIO.Exception` etc for safer exception without having to hide all the defaults + - No transformers are exposed but `lift` is + - Simple `IsString` helpers (from Protolude) + - `identity` rather than `id` (from Protolude) + - `String` is not exported use `[Char]`. This is to discourage its use. + + +### If you want to reduce imports + +If you want to use Verset but would rather avoid imports in all your modules. There are at least two optios + +1) Create a module with the imports you always use and import that along with Verset + +```haskell +{-# LANGUAGE NoImplicitPrelude #-} + +module Verse + ( (Control.Lens.^.) + , (Control.Lens.^..) + ) where + +import Verset +import qualified Control.Lens +``` + +```haskell +module Demo where + import Verset + import Verse + import qualified Whatever as W +``` + + +2) Similar to the method above but reexport verset + +```haskell +{-# LANGUAGE NoImplicitPrelude #-} + +module Verse + ( module Verset + , (Control.Lens.^.) + , (Control.Lens.^..) + ) where + +import Verset +import qualified Control.Lens +``` + +```haskell +module Demo where + import Verse + import qualified Whatever as W +``` + +#### But... + +Personally I happy with imports as I think it makes the code more explicit. However if you want to avoid them using something like the above methods I think there are still benefits to Verset. + - Verset is not getting in your way. + - You can define company wide defaults, project wide defaults or both + + +## Compatibility + +Tested with GHC 8.7.10, 9.0.1 and 9.2.1 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/Verset.hs b/src/Verset.hs new file mode 100644 --- /dev/null +++ b/src/Verset.hs @@ -0,0 +1,761 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +module Verset + ( + -- * Basic functions + (Data.Function.&) + , (Data.Function.$) + , Data.Function.const + , Data.Function.fix + , Data.Function.flip + , Data.Function.on + , (Prelude.$!) + , Prelude.seq + + -- * Basic algebraic types + + -- ** Void + , Data.Void.Void + + -- ** Bool + , (Data.Bool.&&) + , (Data.Bool.||) + , Data.Bool.bool + , Data.Bool.Bool(False, True) + , Data.Bool.not + , Data.Bool.otherwise + + -- ** Maybe + , (?:) + , Data.Maybe.catMaybes + , Data.Maybe.fromMaybe + , Data.Maybe.isJust + , Data.Maybe.isNothing + , Data.Maybe.mapMaybe + , Data.Maybe.maybe + , Data.Maybe.Maybe(Nothing, Just) + + -- ** List + , Data.List.break + , Data.List.drop + , Data.List.dropWhile + , Data.List.dropWhileEnd + , Data.List.Extra.breakOn + , Data.List.Extra.breakOnEnd + , Data.List.Extra.dropEnd + , Data.List.Extra.groupOn + , Data.List.Extra.groupSort + , Data.List.Extra.groupSortBy + , Data.List.Extra.groupSortOn + , Data.List.Extra.nubOrd + , Data.List.Extra.nubOrdBy + , Data.List.Extra.nubOrdOn + , Data.List.Extra.spanEnd + , Data.List.Extra.split + , Data.List.Extra.splitOn + , Data.List.Extra.takeEnd + , Data.List.Extra.takeWhileEnd + , atMay + , Data.List.filter + , Data.List.group + , Data.List.groupBy + , Data.List.inits + , Data.List.intercalate + , Data.List.intersperse + , Data.List.isPrefixOf + , Data.List.isSuffixOf + , Data.List.iterate + , Data.List.iterate' + , Data.List.lookup + , Data.List.permutations + , Data.List.repeat + , Data.List.replicate + , Data.List.reverse + , Data.List.scanl + , Data.List.scanr + , Data.List.sort + , Data.List.sortBy + , Data.List.sortOn + , Data.List.span + , Data.List.splitAt + , Data.List.subsequences + , Data.List.tails + , Data.List.take + , Data.List.takeWhile + , Data.List.transpose + , Data.List.unfoldr + , Data.List.unzip + , Data.List.unzip3 + , Data.List.zip + , Data.List.zip3 + , Data.List.zipWith + , Data.List.zipWith3 + , Safe.cycleDef + , Safe.cycleMay + , Safe.headDef + , Safe.headMay -- prefer pattern match + , Safe.initDef + , Safe.initMay + , Safe.lastDef + , Safe.lastMay + , Safe.tailDef + , Safe.tailMay -- prefer pattern match + + -- ** NonEmpty + , Data.List.NonEmpty.NonEmpty((:|)) + -- (<|), -- in lens + , Data.List.NonEmpty.scanl1 + , Data.List.NonEmpty.scanr1 + , Data.List.NonEmpty.head + , Data.List.NonEmpty.init + , Data.List.NonEmpty.last + , Data.List.NonEmpty.tail + , Data.List.NonEmpty.cycle + + -- ** Tuple + , Data.Tuple.fst + , Data.Tuple.snd + , Data.Tuple.curry + , Data.Tuple.uncurry + , Data.Tuple.swap + + -- ** Either + , Data.Either.Either(Left, Right) + , Data.Either.either + , Data.Either.Extra.fromLeft + , Data.Either.Extra.fromRight + , Data.Either.isLeft + , Data.Either.isRight + , Data.Either.lefts + , Data.Either.rights + , Data.Either.partitionEithers + , Data.Either.Extra.eitherToMaybe + , Data.Either.Extra.maybeToEither + + -- * Text types + + -- ** Char and String + , Data.Char.Char + + -- ** String conversion + , Data.String.IsString(fromString) + + + -- * Container types + + -- ** Map and Set (Ordered) + , Data.Map.Map + , Data.Set.Set + + -- ** Seq + -- ! , Data.Sequence.Seq + + + -- * Numeric types + + -- ** Big integers + , Prelude.Integer + , Numeric.Natural.Natural + + -- ** Small integers + , Data.Int.Int + , Data.Int.Int16 + , Data.Int.Int32 + , Data.Int.Int64 + , Data.Int.Int8 + , Data.Word.Word + , Data.Word.Word16 + , Data.Word.Word32 + , Data.Word.Word64 + , Data.Word.Word8 + + -- ** Floating point + , Prelude.Float + , Prelude.Double + + -- * Numeric type classes + + -- ** Num + , Prelude.Num((+), (-), (*), negate, abs, signum, fromInteger) + , Prelude.subtract + , (Prelude.^) -- partial functions! + + -- ** Real + , Prelude.Real(toRational) + , Prelude.realToFrac + + -- ** Integral + , Prelude.Integral(quot, rem, div, mod, quotRem, divMod, toInteger) -- partial functions! + , Data.Bits.toIntegralSized + , Prelude.even + , Prelude.odd + + -- ** Fractional + , Prelude.Fractional((/), recip, fromRational) -- partial functions + , (Prelude.^^) + + -- ** Floating + , Prelude.Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh) + -- ** RealFrac + , Prelude.RealFrac(properFraction, truncate, round, ceiling, floor) -- partial functions + + -- ** RealFloat + , Prelude.RealFloat(floatRadix, floatDigits, floatRange, decodeFloat, encodeFloat, exponent, significand, scaleFloat, isNaN, isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2) + + -- * Read and Show + + -- ** Show + , Text.Show.Show + , Data.Functor.Classes.Show1 + , Data.Functor.Classes.Show2 + --, Text.Show.show + -- ! , showT + -- ! , showS + , show + + -- ** Read + , Text.Read.Read + , Data.Functor.Classes.Read1 + , Data.Functor.Classes.Read2 + , Text.Read.readMaybe + + -- * Equality and ordering + + -- ** Eq + , Data.Eq.Eq((==), (/=)) + , Data.Functor.Classes.Eq1 + , Data.Functor.Classes.Eq2 + + -- ** Ord + , Data.Ord.Ord(compare, (<), (>), (<=), (>=), max, min) + , Data.Functor.Classes.Ord1 + , Data.Functor.Classes.Ord2 + , Data.Ord.Ordering(LT,GT,EQ) + , Data.Ord.Down(Down) + , Data.Ord.comparing + + -- ** Enum + , Prelude.Enum(-- toEnum, succ, pred, -- partial + fromEnum, enumFrom, enumFromThen, + enumFromTo, enumFromThenTo) + , Safe.toEnumMay + , Safe.toEnumDef + , Safe.predMay + , Safe.predDef + , Safe.succMay + , Safe.succDef + + -- ** Bounded + , Prelude.Bounded(minBound, maxBound) + + -- * Algebraic type classes + + -- ** Category + -- ! , Control.Category.Category(id, (.)) + , Control.Category.Category((.)) + , (Control.Category.<<<) + , (Control.Category.>>>) + + -- ** Semigroup + , Data.Semigroup.First(First, getFirst) + , Data.Semigroup.Last(Last, getLast) + , Data.Semigroup.Max(Max, getMax) + , Data.Semigroup.Min(Min, getMin) + , Data.Semigroup.Semigroup((<>), sconcat, stimes) + + -- ** Monoid + , Data.Monoid.All(All, getAll) + , Data.Monoid.Alt(Alt, getAlt) + , Data.Monoid.Any(Any, getAny) + , Data.Monoid.Dual(Dual, getDual) + , Data.Monoid.Endo(Endo, appEndo) + , Data.Monoid.Monoid(mempty, mappend, mconcat) + + -- ** Functor + , Control.Applicative.Const(Const, getConst) -- Data.Functor.Const + , (Data.Functor.<&>) + , (Data.Functor.<$) + , (Data.Functor.<$>) + , (Data.Functor.$>) + , Data.Functor.fmap + , Data.Functor.Identity.Identity(Identity, runIdentity) + , Data.Functor.void + + -- ** Contravariant + , Data.Functor.Contravariant.Contravariant( + (>$), + contramap + ) + , (Data.Functor.Contravariant.$<) + , (Data.Functor.Contravariant.>$<) + , (Data.Functor.Contravariant.>$$<) + + -- ** Foldable + , Data.Foldable.Foldable(elem, fold, foldMap, foldr, foldr', foldl, foldl', product, sum, toList) + , Data.Foldable.all + , Data.Foldable.and + , Data.Foldable.any + , Data.Foldable.asum + , Data.Foldable.concat + , Data.Foldable.concatMap + , Data.Foldable.find + , Data.Foldable.foldlM + , Data.Foldable.foldrM + , Data.Foldable.for_ + , Data.Foldable.length + , Data.Foldable.notElem + , Data.Foldable.null + , Data.Foldable.or + , Data.Foldable.sequenceA_ + , Data.Foldable.traverse_ + , Safe.Foldable.foldl1May + , Safe.Foldable.foldr1May + , Safe.Foldable.maximumBound + , Safe.Foldable.maximumBoundBy + , Safe.Foldable.maximumBounded + , Safe.Foldable.maximumByMay + , Safe.Foldable.maximumMay + , Safe.Foldable.minimumBound + , Safe.Foldable.minimumBoundBy + , Safe.Foldable.minimumBounded + , Safe.Foldable.minimumByMay + , Safe.Foldable.minimumMay + + -- ** Traversable + , Data.Traversable.Traversable(traverse, sequenceA) + , Data.Traversable.for + , Data.Traversable.mapAccumL + , Data.Traversable.mapAccumR + + -- ** Applicative + , Control.Applicative.Applicative(pure, (<*>), (*>), (<*)) + , Control.Applicative.ZipList(ZipList, getZipList) + , (Control.Applicative.<**>) + , Control.Applicative.liftA2 + , Control.Applicative.liftA3 + , pass + + -- ** Alternative + , Control.Applicative.Alternative((<|>), empty, many {-, some -}) + , Control.Applicative.optional + , Data.List.NonEmpty.some1 + + -- ** Monad + , (Control.Monad.<=<) + , (Control.Monad.=<<) + , (Control.Monad.>=>) + , (Control.Monad.>>) + , (Control.Monad.<$!>) + , Control.Monad.ap + , (Control.Monad.Extra.&&^) + , (Control.Monad.Extra.||^) + , Control.Monad.Extra.allM + , Control.Monad.Extra.andM + , Control.Monad.Extra.anyM + , Control.Monad.Extra.concatMapM + , Control.Monad.Extra.ifM + , Control.Monad.Extra.orM + , Control.Monad.Extra.unlessM + , Control.Monad.Extra.whenM + , Control.Monad.filterM + , Control.Monad.Fix.MonadFix(mfix) + , Control.Monad.foldM + , Control.Monad.foldM_ + , Control.Monad.forever + , Control.Monad.guard + , Control.Monad.join + , Control.Monad.liftM + , Control.Monad.liftM2 + , Control.Monad.liftM3 + , Control.Monad.liftM4 + , Control.Monad.liftM5 + , Control.Monad.mapAndUnzipM + , Control.Monad.mfilter + , Control.Monad.Monad((>>=)) + , Control.Monad.replicateM + , Control.Monad.replicateM_ + , Control.Monad.unless + , Control.Monad.when + , Control.Monad.zipWithM + , Control.Monad.zipWithM_ + + , Control.Exception.Exception + , Control.Exception.SomeException + + -- ** Bifunctor + , Data.Bifunctor.Bifunctor(bimap, first, second) + + -- ** Bifoldable + , Data.Bifoldable.Bifoldable(bifoldr + --, bifoldl -- not strict enough + , bifoldMap) + , Data.Bifoldable.bifoldl' + , Data.Bifoldable.bifoldr' + , Data.Bifoldable.bitraverse_ + , Data.Bifoldable.bisequenceA_ + , Data.Bifoldable.bifor_ + + -- ** Bitraversable + , Data.Bitraversable.Bitraversable(bitraverse) + , Data.Bitraversable.bifor + , Data.Bitraversable.bisequenceA + + -- * Effects and monad transformers + , Control.Monad.Trans.MonadTrans(lift) + + , Control.Concurrent.ThreadId + , Control.Concurrent.forkIO + , Control.Concurrent.forkFinally + , Control.Concurrent.threadDelay + , Control.Concurrent.myThreadId + + -- * Generic type classes + , GHC.Generics.Generic + , GHC.Generics.Generic1 + , Data.Typeable.Typeable + , GHC.Real.fromIntegral + + -- * Type level + , Data.Kind.Type + , Data.Proxy.Proxy(Proxy) + + -- * IO + , System.IO.IO + , Control.Monad.Trans.MonadIO(liftIO) + + -- ** Console + , print + , Print + , hPutStr + , putStr + , hPutStrLn + , putStrLn + , putErrLn + , putText + , putErrText + , putLText + , putByteString + , putLByteString + + -- * Error handling and debugging + , HasCallStack + , Control.Monad.Fail.MonadFail + , undefined + , trace + , traceIO + , traceId + , traceM + , traceShow + , traceShowId + , traceShowM + + -- * Time + , Data.Time.UTCTime + , Data.Time.LocalTime + , Data.Time.NominalDiffTime + + + -- * Custom + , Data.UUID.UUID + , BS.ByteString + , Data.Text.Text + , System.IO.FilePath + , (<<$>>) + , ordNub + , identity + +) where + +import qualified Control.Applicative +import Control.Applicative (Applicative, pure) +import qualified Control.Category +import qualified Control.Concurrent +import qualified Control.Exception +import qualified Control.Monad +import Control.Monad ((>>)) +import qualified Control.Monad.Except +import qualified Control.Monad.Extra +import qualified Control.Monad.Fail +import qualified Control.Monad.Fix +import qualified Control.Monad.Trans +import Control.Monad.Trans (MonadIO(liftIO)) +import qualified Data.Bifoldable +import qualified Data.Bifunctor +import qualified Data.Bitraversable +import qualified Data.Bits +import qualified Data.Bool +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import Data.Char (Char) +import qualified Data.Either +import qualified Data.Either.Extra +import qualified Data.Eq +import qualified Data.Foldable +import Data.Foldable (Foldable, foldl', foldr) +import qualified Data.Function +import Data.Function ((.), ($)) +import qualified Data.Functor +import qualified Data.Functor.Classes +import qualified Data.Functor.Contravariant +import Data.Functor (Functor(fmap)) +import qualified Data.Functor.Identity +import qualified Data.Int +import qualified Data.Kind +import qualified Data.List +import qualified Data.List.Extra +import Data.List (groupBy, sortBy) +import qualified Data.List.NonEmpty +import qualified Data.Map +import qualified Data.Maybe +import Data.Maybe (fromMaybe) +import qualified Data.Monoid +import qualified Data.Ord +import Data.Ord (Ord, comparing) +import qualified Data.Proxy +import qualified Data.Semigroup +import Data.Semigroup (Semigroup((<>))) +import qualified Data.Set +import qualified Data.Set as Set +import Data.String (IsString(fromString), String) +import qualified Data.Text as Txt +import qualified Data.Text.IO as Txt +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy as TxtL +import qualified Data.Text.Lazy.IO as TxtL +import Data.Text (Text) +import qualified Data.Traversable +import qualified Data.Tuple +import qualified Data.Typeable +import qualified Data.Void +import qualified Data.Word +import qualified Debug.Trace +import qualified GHC.Generics +import qualified GHC.Real +import qualified GHC.Show +import GHC.Stack (HasCallStack) +import qualified Numeric.Natural +import qualified Prelude +import qualified Safe +import qualified Safe.Foldable +import qualified System.IO +import System.IO (FilePath) +import qualified Text.Read +import Text.Show (Show) +import Prelude (Maybe(..), Bool(..), otherwise, const, (<), (-)) +import qualified Data.UUID +import qualified Data.Time + +import qualified Verset.Conv as Conv + +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +-- from intro + +-- | 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. +-- +-- For example, a program to print the first 20 integers and their +-- powers of 2 could be written as: +-- +-- > main = print ([(n, 2^n) | n <- [0..19]]) +-- +-- __Note__: This function is lifted to the 'MonadIO' class. +print :: (MonadIO m, Show a) => a -> m () +print = liftIO . System.IO.print +{-# INLINE print #-} + + +-- | Throw an undefined error. Use only for debugging. +undefined :: HasCallStack => a +undefined = Prelude.undefined +{-# WARNING undefined "'undefined' should be used only for debugging" #-} + + +-- | An infix form of 'fromMaybe' with arguments flipped. +(?:) :: Maybe a -> a -> a +(?:) = Data.Function.flip fromMaybe +infix 1 ?: +{-# INLINE (?:) #-} + +-- | @()@ lifted to an 'Control.Applicative.Applicative'. +-- +-- @pass = 'Control.Applicative.pure' ()@ +pass :: Applicative f => f () +pass = pure () +{-# INLINE pass #-} + + + +-- | The 'trace' function outputs the trace message given as its first argument, +-- before returning the second argument as its result. +-- +-- For example, this returns the value of @f x@ but first outputs the message. +-- +-- > trace ("calling f with x = " ++ show x) (f x) +-- +-- The 'trace' function should /only/ be used for debugging, or for monitoring +-- execution. The function is not referentially transparent: its type indicates +-- that it is a pure function but it has the side effect of outputting the +-- trace message. +trace :: Text -> a -> a +trace = Debug.Trace.trace . Txt.unpack +{-# WARNING trace "'trace' should be used only for debugging" #-} + +-- | Like 'trace' but returning unit in an arbitrary 'Applicative' context. Allows +-- for convenient use in do-notation. +-- +-- Note that the application of 'traceM' is not an action in the 'Applicative' +-- context, as 'traceIO' is in the 'MonadIO' type. While the fresh bindings in the +-- following example will force the 'traceM' expressions to be reduced every time +-- the @do@-block is executed, @traceM "not crashed"@ would only be reduced once, +-- and the message would only be printed once. If your monad is in 'MonadIO', +-- @traceIO@ may be a better option. +-- +-- > ... = do +-- > x <- ... +-- > traceM $ "x: " ++ show x +-- > y <- ... +-- > traceM $ "y: " ++ show y +traceM :: Applicative m => Text -> m () +traceM = Debug.Trace.traceM . Txt.unpack +{-# WARNING traceM "'traceM' should be used only for debugging" #-} + +-- | Like 'trace', but uses 'show' on the argument to convert it to a 'String'. +-- +-- This makes it convenient for printing the values of interesting variables or +-- expressions inside a function. For example here we print the value of the +-- variables @x@ and @z@: +-- +-- > f x y = +-- > traceShow (x, z) $ result +-- > where +-- > z = ... +-- > ... +traceShow :: Show a => a -> b -> b +traceShow = Debug.Trace.traceShow +{-# WARNING traceShow "'traceShow' should be used only for debugging" #-} + +-- | Like 'traceM', but uses 'show' on the argument to convert it to a 'String'. +-- +-- > ... = do +-- > x <- ... +-- > traceShowM $ x +-- > y <- ... +-- > traceShowM $ x + y +traceShowM :: (Show a, Applicative m) => a -> m () +traceShowM = Debug.Trace.traceShowM +{-# WARNING traceShowM "'traceShowM' should be used only for debugging" #-} + +-- | The 'traceIO' function outputs the trace message from the IO monad. +-- This sequences the output with respect to other IO actions. +traceIO :: MonadIO m => Text -> m () +traceIO = liftIO . Debug.Trace.traceIO . Txt.unpack +{-# WARNING traceIO "'traceIO' should be used only for debugging" #-} + +-- | Like 'traceShow' but returns the shown value instead of a third value. +traceShowId :: Show a => a -> a +traceShowId = Debug.Trace.traceShowId +{-# WARNING traceShowId "'traceShowId' should be used only for debugging" #-} + +-- | Like 'trace' but returns the message instead of a third value. +traceId :: Text -> Text +traceId a = Debug.Trace.trace (Txt.unpack a) a +{-# WARNING traceId "'traceId' should be used only for debugging" #-} + +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +-- From protolude + + +-- | The identity function, returns the give value unchanged. +identity :: a -> a +identity x = x + +infixl 4 <<$>> +(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) +(<<$>>) = fmap . fmap + + +class Print a where + hPutStr :: MonadIO m => System.IO.Handle -> a -> m () + putStr :: MonadIO m => a -> m () + putStr = hPutStr System.IO.stdout + hPutStrLn :: MonadIO m => System.IO.Handle -> a -> m () + putStrLn :: MonadIO m => a -> m () + putStrLn = hPutStrLn System.IO.stdout + putErrLn :: MonadIO m => a -> m () + putErrLn = hPutStrLn System.IO.stderr + +instance Print Txt.Text where + hPutStr = \h -> liftIO . Txt.hPutStr h + hPutStrLn = \h -> liftIO . Txt.hPutStrLn h + +instance Print TxtL.Text where + hPutStr = \h -> liftIO . TxtL.hPutStr h + hPutStrLn h v = liftIO $ TxtL.hPutStr h v >> TxtL.hPutStr h "\n" + +instance Print BS.ByteString where + hPutStr = \h -> liftIO . BS.hPutStr h + hPutStrLn h v = liftIO $ BS.hPutStr h v >> BS.hPutStr h "\n" + +instance Print BSL.ByteString where + hPutStr = \h -> liftIO . BSL.hPutStr h + hPutStrLn h v = liftIO $ BSL.hPutStr h v >> BSL.hPutStr h "\n" + +instance Print [Char] where + hPutStr = \h -> liftIO . System.IO.hPutStr h + hPutStrLn = \h -> liftIO . System.IO.hPutStrLn h + +-- For forcing type inference +putText :: MonadIO m => Txt.Text -> m () +putText = putStrLn +{-# SPECIALIZE putText :: Txt.Text -> System.IO.IO () #-} + +putLText :: MonadIO m => TxtL.Text -> m () +putLText = putStrLn +{-# SPECIALIZE putLText :: TxtL.Text -> System.IO.IO () #-} + +putByteString :: MonadIO m => BS.ByteString -> m () +putByteString = putStrLn +{-# SPECIALIZE putByteString :: BS.ByteString -> System.IO.IO () #-} + +putLByteString :: MonadIO m => BSL.ByteString -> m () +putLByteString = putStrLn +{-# SPECIALIZE putLByteString :: BSL.ByteString -> System.IO.IO () #-} + +putErrText :: MonadIO m => Txt.Text -> m () +putErrText = putErrLn +{-# SPECIALIZE putErrText :: Txt.Text -> System.IO.IO () #-} + +show :: (Show a, Conv.StringConv String b) => a -> b +show x = Conv.toS (GHC.Show.show x) +{-# SPECIALIZE show :: Show a => a -> Data.Text.Text #-} +{-# SPECIALIZE show :: Show a => a -> Data.Text.Lazy.Text #-} +{-# SPECIALIZE show :: Show a => a -> String #-} + + +-- O(n * log n) +ordNub :: (Ord a) => [a] -> [a] +ordNub = go Set.empty + where + go _ [] = [] + go s (x : xs) = + if x `Set.member` s + then go s xs + else x : go (Set.insert x s) xs + + +atMay :: [a] -> Prelude.Int -> Maybe a +atMay xs n + | n < 0 = Nothing + -- Definition adapted from GHC.List + | otherwise = foldr (\x r k -> case k of + 0 -> Just x + _ -> r (k-1)) (const Nothing) xs n +{-# INLINABLE atMay #-} diff --git a/src/Verset/Conv.hs b/src/Verset/Conv.hs new file mode 100644 --- /dev/null +++ b/src/Verset/Conv.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Verset.Conv ( + StringConv +, strConv +, toS +, toSL +, Leniency (Lenient, Strict) +) where + +import Prelude +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 + + +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/verset.cabal b/verset.cabal new file mode 100644 --- /dev/null +++ b/verset.cabal @@ -0,0 +1,37 @@ +cabal-version: 2.2 +name: verset +version: 0.0.1.5 +synopsis: Small alternative prelude +description: Small Haskell alternative prelude. Based on Protolude and Intro +homepage: https://github.com/andrevdm/verset#readme +license: MIT +license-file: LICENSE +author: Andre Van Der Merwe +maintainer: andre@andrevdm.com +copyright: 2021 Andre Van Der Merwe +category: Prelude +build-type: Simple +extra-source-files: README.md +tested-with: GHC==8.10.7, GHC==9.0.1, GHC==9.2.1 + +library + ghc-options: -Wall -Wimplicit-prelude -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wredundant-constraints -Wnoncanonical-monad-instances -Widentities -fhide-source-paths -Wpartial-fields -fhide-source-paths -freverse-errors -fwrite-ide-info -hiedir=.hie + + build-depends: base >=4.9 && <5 + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: Verset.Conv + , Verset + build-depends: + , bytestring >= 0.10.10 && < 0.12 + , containers >= 0.6.0 && < 0.7 + , extra >= 1.7.9 && < 1.8 + , mtl >= 2.2.2 && < 2.3 + , safe >= 0.3.19 && < 0.4 + , text >= 1.2.4 && < 1.3 + , time >= 1.9.3 && < 1.10 + , uuid >= 1.3.15 && < 1.4 + +source-repository head + type: git + location: https://github.com/andrevdm/verset