1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
-- | 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, guard) 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.Exception as Export (bracketOnError)
import Control.Monad
import Control.Monad.IO.Class as Export
import Control.Monad.State
import Data.Containers.ListUtils as Export (nubOrd) -- Faster than `nub`.
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.HashMap.Strict as Export (HashMap)
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.Monoid (First(..))
import Data.Sequence as Export (Seq(..))
import Data.Set as Export (Set)
import Data.Set.Internal qualified as Set
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.Clock as Export (getMonotonicTimeNSec)
import GHC.Generics as Export (Generic(..), Generic1(..))
import Prettyprinter as Export (pretty)
import System.IO as Export
( Handle
, hClose
, hFlush
, openBinaryTempFileWithDefaultPermissions
, openTempFile
, utf8
)
import System.IO.Error as Export (isDoesNotExistError, tryIOError)
import UnliftIO as Export (throwIO)
-- | 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)
-- | 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
{-| Decompose two sets into their /exclusive/ parts.
@
symmetricDifferenceDecompose t1 t2 = (t1 \\\\ t2, t2 \\\\ t1)
@
This is essentially a structural version of symmetric difference that
preserves the balance of the underlying tree representation.
@
let t1 = Set.fromList [1,2,3,4]
let t2 = Set.fromList [3,4,5,6]
symmetricDifferenceDecompose t1 t2 == (fromList [1,2],fromList [5,6])
@
-}
symmetricDifferenceDecompose :: Ord a => Set a -> Set a -> (Set a, Set a)
symmetricDifferenceDecompose Set.Tip t2 = (Set.Tip, t2)
symmetricDifferenceDecompose t1 Set.Tip = (t1, Set.Tip)
symmetricDifferenceDecompose (Set.Bin _ x l1 r1) t2 =
let !(l2, found, r2) = Set.splitMember x t2
!(l1', l2') = symmetricDifferenceDecompose l1 l2
!(r1', r2') = symmetricDifferenceDecompose r1 r2
in if found
then (Set.merge l1' r1', Set.merge l2' r2')
else (Set.link x l1' r1', Set.merge l2' r2')
|
