From 442d732696ad431b84f6e5c72b6ee785be4fd968 Mon Sep 17 00:00:00 2001 From: adelon <22380201+adelon@users.noreply.github.com> Date: Sat, 10 Feb 2024 02:22:14 +0100 Subject: Initial commit --- source/Base.hs | 155 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 155 insertions(+) create mode 100644 source/Base.hs (limited to 'source/Base.hs') diff --git a/source/Base.hs b/source/Base.hs new file mode 100644 index 0000000..1068684 --- /dev/null +++ b/source/Base.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | A basic prelude intended to reduce the amount of repetitive imports. +-- Mainly consists of re-exports from @base@ modules. +-- Intended to be imported explicitly (but with @NoImplicitPrelude@ enabled) +-- so that it is obvious that this module is used. Commonly used data types +-- or helper functions from outside of @base@ are also included. +-- +module Base (module Base, module Export) where + +-- Some definitions from @base@ need to be hidden to avoid clashes. +-- +import Prelude as Export hiding + ( Word + , head, last, init, tail, lines, lookup + , filter -- Replaced by generalized form from "Data.Filtrable". + , words, pi, all + ) + +import Control.Applicative as Export hiding (some) +import Control.Applicative qualified as Applicative +import Control.Monad.IO.Class as Export +import Control.Monad.State +import Data.Containers.ListUtils as Export (nubOrd) -- Faster than `nub`. +import Data.DList as Export (DList) +import Data.Foldable as Export +import Data.Function as Export (on) +import Data.Functor as Export (void) +import Data.Hashable as Export (Hashable(..)) +import Data.IntMap.Strict as Export (IntMap) +import Data.List.NonEmpty as Export (NonEmpty(..)) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Map as Export (Map) +import Data.Maybe as Export hiding (mapMaybe, catMaybes) -- Replaced by generalized form from "Data.Filtrable". +import Data.Sequence as Export (Seq(..), replicateA) +import Data.Set as Export (Set) +import Data.HashSet as Export (HashSet) +import Data.HashMap.Strict as Export (HashMap) +import Data.String as Export (IsString(..)) +import Data.Text as Export (Text) +import Data.Traversable as Export +import Data.Void as Export +import Data.Word as Export (Word64) +import Debug.Trace as Export +import GHC.Generics as Export (Generic(..), Generic1(..)) +import Prettyprinter as Export (pretty) +import UnliftIO as Export (throwIO) +import Data.Monoid (First(..)) + +-- | Signal to the developer that a branch is unreachable or represent +-- an impossible state. Using @impossible@ instead of @error@ allows +-- for easily finding leftover @error@s while ignoring impossible branches. +impossible :: String -> a +impossible msg = error ("IMPOSSIBLE: " <> msg) + +-- | Signal to the developer that some part of the program is unfinished. +_TODO :: String -> a +_TODO msg = error ("TODO: " <> msg) + +-- | Eliminate a @Maybe a@ value with default value as fallback. +(??) :: Maybe a -> a -> a +ma ?? a = fromMaybe a ma + +-- | Convert a ternary uncurried function to a curried function. +curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d +curry3 f a b c = f (a,b,c) + +-- | Convert a ternary curried function to an uncurried function. +uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) +uncurry3 f ~(a, b, c) = f a b c + +-- | Convert a ternary curried function to an uncurried function. +uncurry4 :: (a -> b -> c -> d -> e) -> ((a, b, c, d) -> e) +uncurry4 f ~(a, b, c, d) = f a b c d + +-- | Fold of composition of endomorphisms: +-- like @sum@ but for @(.)@ instead of @(+)@. +compose :: Foldable t => t (a -> a) -> (a -> a) +compose = foldl' (.) id + +-- | Safe list lookup. Replaces @(!!)@. +nth :: Int -> [a] -> Maybe a +nth _ [] = Nothing +nth 0 (a : _) = Just a +nth n (_ : as) = nth (n - 1) as + +-- Same as 'find', but with a 'Maybe'-valued predicate that also transforms the resulting value. +firstJust :: Foldable t => (a -> Maybe b) -> t a -> Maybe b +firstJust p = getFirst . foldMap (\ x -> First (p x)) + +-- | Do nothing and return @()@. +skip :: Applicative f => f () +skip = pure () + +-- | One or more. Equivalent to @some@ from @Control.Applicative@, but +-- keeps the information that the result is @NonEmpty@. +many1 :: Alternative f => f a -> f (NonEmpty a) +many1 a = NonEmpty.fromList <$> Applicative.some a + +-- | Same as 'many1', but discards the type information that the result is @NonEmpty@. +many1_ :: Alternative f => f a -> f [a] +many1_ = Applicative.some + +count :: Applicative f => Int -> f a -> f [a] +count n fa + | n <= 0 = pure [] + | otherwise = replicateM n fa + +-- | Same as 'count', but requires at least one occurrence. +count1 :: Applicative f => Int -> f a -> f (NonEmpty a) +count1 n fa + | n <= 1 = (:| []) <$> fa + | otherwise = NonEmpty.fromList <$> replicateM n fa + +-- | Apply a functor of functions to a plain value. +flap :: Functor f => f (a -> b) -> a -> f b +flap ff x = (\f -> f x) <$> ff +{-# INLINE flap #-} + +-- | Like 'when' but for functions that carry a witness with them: +-- execute a monadic action depending on a 'Left' value. +-- Does nothing on 'Right' values. +-- +-- > whenLeft eitherErrorOrResult throwError +-- +whenLeft :: Applicative f => Either a b -> (a -> f ()) -> f () +whenLeft mab action = case mab of + Left err -> action err + Right _ -> skip + +-- | Like 'when', but the guard is monadic. +whenM :: Monad m => m Bool -> m () -> m () +whenM mb ma = ifM mb ma skip + +-- | Like 'unless', but the guard is monadic. +unlessM :: Monad m => m Bool -> m () -> m () +unlessM mb ma = ifM mb skip ma + +-- | Like 'guard', but the guard is monadic. +guardM :: MonadPlus m => m Bool -> m () +guardM f = guard =<< f + +-- | @if [...] then [...] else [...]@ lifted to a monad. +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM mb ma1 ma2 = do + b <- mb + if b then ma1 else ma2 + +-- | Similar to @Reader@'s @local@, but for @MonadState@. Resets the state after a computation. +locally :: MonadState s m => m a -> m a +locally ma = do + s <- get + a <- ma + put s + return a -- cgit v1.2.3