> module GenUtils (
> partition', tack,
> assocMaybeErr,
> arrElem,
> memoise,
> returnMaybe,handleMaybe, findJust,
> MaybeErr(..),
> mapMaybe,
> maybeMap,
> joinMaybe,
> mkClosure,
> foldb,
> listArray',
> cjustify,
> ljustify,
> rjustify,
> space,
> copy,
> combinePairs,
>
> fst3,
> snd3,
> thd3,
> mapDollarDollar,
> str, char, nl, brack, brack',
> interleave, interleave',
> strspace, maybestr
> ) where
> import Data.Char (isAlphaNum)
> import Data.List
> import Data.Ix ( Ix(..) )
> import Data.Array ( Array, listArray, array, (!) )
> mapMaybe :: (a -> Maybe b) -> [a] -> [b]
> mapMaybe :: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
_ [] = []
> mapMaybe a -> Maybe b
f (a
a:[a]
r) = case a -> Maybe b
f a
a of
> Maybe b
Nothing -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
r
> Just b
b -> b
b forall a. a -> [a] -> [a]
: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
r
> maybeMap :: (a -> b) -> Maybe a -> Maybe b
> maybeMap :: forall a b. (a -> b) -> Maybe a -> Maybe b
maybeMap a -> b
f (Just a
a) = forall a. a -> Maybe a
Just (a -> b
f a
a)
> maybeMap a -> b
_ Maybe a
Nothing = forall a. Maybe a
Nothing
> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
> joinMaybe :: forall a. (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
joinMaybe a -> a -> a
_ Maybe a
Nothing Maybe a
Nothing = forall a. Maybe a
Nothing
> joinMaybe a -> a -> a
_ (Just a
g) Maybe a
Nothing = forall a. a -> Maybe a
Just a
g
> joinMaybe a -> a -> a
_ Maybe a
Nothing (Just a
g) = forall a. a -> Maybe a
Just a
g
> joinMaybe a -> a -> a
f (Just a
g) (Just a
h) = forall a. a -> Maybe a
Just (a -> a -> a
f a
g a
h)
> data MaybeErr a err = Succeeded a | Failed err deriving (MaybeErr a err -> MaybeErr a err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a err.
(Eq a, Eq err) =>
MaybeErr a err -> MaybeErr a err -> Bool
/= :: MaybeErr a err -> MaybeErr a err -> Bool
$c/= :: forall a err.
(Eq a, Eq err) =>
MaybeErr a err -> MaybeErr a err -> Bool
== :: MaybeErr a err -> MaybeErr a err -> Bool
$c== :: forall a err.
(Eq a, Eq err) =>
MaybeErr a err -> MaybeErr a err -> Bool
Eq,Int -> MaybeErr a err -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a err. (Show a, Show err) => Int -> MaybeErr a err -> ShowS
forall a err. (Show a, Show err) => [MaybeErr a err] -> ShowS
forall a err. (Show a, Show err) => MaybeErr a err -> String
showList :: [MaybeErr a err] -> ShowS
$cshowList :: forall a err. (Show a, Show err) => [MaybeErr a err] -> ShowS
show :: MaybeErr a err -> String
$cshow :: forall a err. (Show a, Show err) => MaybeErr a err -> String
showsPrec :: Int -> MaybeErr a err -> ShowS
$cshowsPrec :: forall a err. (Show a, Show err) => Int -> MaybeErr a err -> ShowS
Show)
> mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
> mkClosure :: forall a. (a -> a -> Bool) -> (a -> a) -> a -> a
mkClosure a -> a -> Bool
eq a -> a
f = [a] -> a
match forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate a -> a
f
> where
> match :: [a] -> a
match (a
a:a
b:[a]
_) | a
a a -> a -> Bool
`eq` a
b = a
a
> match (a
_:[a]
c) = [a] -> a
match [a]
c
> match [] = forall a. HasCallStack => String -> a
error String
"Can't happen: match []"
> foldb :: (a -> a -> a) -> [a] -> a
> foldb :: forall a. (a -> a -> a) -> [a] -> a
foldb a -> a -> a
_ [] = forall a. HasCallStack => String -> a
error String
"can't reduce an empty list using foldb"
> foldb a -> a -> a
_ [a
x] = a
x
> foldb a -> a -> a
f [a]
l = forall a. (a -> a -> a) -> [a] -> a
foldb a -> a -> a
f ([a] -> [a]
foldb' [a]
l)
> where
> foldb' :: [a] -> [a]
foldb' (a
x:a
y:a
x':a
y':[a]
xs) = a -> a -> a
f (a -> a -> a
f a
x a
y) (a -> a -> a
f a
x' a
y') forall a. a -> [a] -> [a]
: [a] -> [a]
foldb' [a]
xs
> foldb' (a
x:a
y:[a]
xs) = a -> a -> a
f a
x a
y forall a. a -> [a] -> [a]
: [a] -> [a]
foldb' [a]
xs
> foldb' [a]
xs = [a]
xs
> returnMaybe :: a -> Maybe a
> returnMaybe :: forall a. a -> Maybe a
returnMaybe = forall a. a -> Maybe a
Just
> handleMaybe :: Maybe a -> Maybe a -> Maybe a
> handleMaybe :: forall a. Maybe a -> Maybe a -> Maybe a
handleMaybe Maybe a
m Maybe a
k = case Maybe a
m of
> Maybe a
Nothing -> Maybe a
k
> Maybe a
_ -> Maybe a
m
> findJust :: (a -> Maybe b) -> [a] -> Maybe b
> findJust :: forall a b. (a -> Maybe b) -> [a] -> Maybe b
findJust a -> Maybe b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Maybe a -> Maybe a -> Maybe a
handleMaybe forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe b
f
> fst3 :: (a, b, c) -> a
> fst3 :: forall a b c. (a, b, c) -> a
fst3 (a
a,b
_,c
_) = a
a
> snd3 :: (a, b, c) -> b
> snd3 :: forall a b c. (a, b, c) -> b
snd3 (a
_,b
a,c
_) = b
a
> thd3 :: (a, b, c) -> c
> thd3 :: forall a b c. (a, b, c) -> c
thd3 (a
_,b
_,c
a) = c
a
> cjustify, ljustify, rjustify :: Int -> String -> String
> cjustify :: Int -> ShowS
cjustify Int
n String
s = Int -> String
space Int
halfm forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ Int -> String
space (Int
m forall a. Num a => a -> a -> a
- Int
halfm)
> where m :: Int
m = Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
> halfm :: Int
halfm = Int
m forall a. Integral a => a -> a -> a
`div` Int
2
> ljustify :: Int -> ShowS
ljustify Int
n String
s = String
s forall a. [a] -> [a] -> [a]
++ Int -> String
space (forall a. Ord a => a -> a -> a
max Int
0 (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s))
> rjustify :: Int -> ShowS
rjustify Int
n String
s = Int -> String
space (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) forall a. [a] -> [a] -> [a]
++ String
s
> space :: Int -> String
> space :: Int -> String
space Int
n = forall a. Int -> a -> [a]
copy Int
n Char
' '
> copy :: Int -> a -> [a]
> copy :: forall a. Int -> a -> [a]
copy Int
n a
x = forall a. Int -> [a] -> [a]
take Int
n [a]
xs where xs :: [a]
xs = a
xforall a. a -> [a] -> [a]
:[a]
xs
> partition' :: (Eq b) => (a -> b) -> [a] -> [[a]]
> partition' :: forall b a. Eq b => (a -> b) -> [a] -> [[a]]
partition' a -> b
_ [] = []
> partition' a -> b
_ [a
x] = [[a
x]]
> partition' a -> b
f (a
x:a
x':[a]
xs) | a -> b
f a
x forall a. Eq a => a -> a -> Bool
== a -> b
f a
x'
> = forall a. a -> [[a]] -> [[a]]
tack a
x (forall b a. Eq b => (a -> b) -> [a] -> [[a]]
partition' a -> b
f (a
x'forall a. a -> [a] -> [a]
:[a]
xs))
> | Bool
otherwise
> = [a
x] forall a. a -> [a] -> [a]
: forall b a. Eq b => (a -> b) -> [a] -> [[a]]
partition' a -> b
f (a
x'forall a. a -> [a] -> [a]
:[a]
xs)
> tack :: a -> [[a]] -> [[a]]
> tack :: forall a. a -> [[a]] -> [[a]]
tack a
x [[a]]
xss = (a
x forall a. a -> [a] -> [a]
: forall a. [a] -> a
head [[a]]
xss) forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail [[a]]
xss
> combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]
> combinePairs :: forall a b. Ord a => [(a, b)] -> [(a, [b])]
combinePairs [(a, b)]
xs =
> forall {a} {a}. Eq a => [(a, [a])] -> [(a, [a])]
combine [ (a
a,[b
b]) | (a
a,b
b) <- forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ (a
a,b
_) (a
b,b
_) -> forall a. Ord a => a -> a -> Ordering
compare a
a a
b) [(a, b)]
xs]
> where
> combine :: [(a, [a])] -> [(a, [a])]
combine [] = []
> combine ((a
a,[a]
b):(a
c,[a]
d):[(a, [a])]
r) | a
a forall a. Eq a => a -> a -> Bool
== a
c = [(a, [a])] -> [(a, [a])]
combine ((a
a,[a]
bforall a. [a] -> [a] -> [a]
++[a]
d) forall a. a -> [a] -> [a]
: [(a, [a])]
r)
> combine ((a, [a])
a:[(a, [a])]
r) = (a, [a])
a forall a. a -> [a] -> [a]
: [(a, [a])] -> [(a, [a])]
combine [(a, [a])]
r
>
> assocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String
> assocMaybeErr :: forall a b. Eq a => [(a, b)] -> a -> MaybeErr b String
assocMaybeErr [(a, b)]
env a
k = case [ b
val | (a
key,b
val) <- [(a, b)]
env, a
k forall a. Eq a => a -> a -> Bool
== a
key] of
> [] -> forall a err. err -> MaybeErr a err
Failed String
"assoc: "
> (b
val:[b]
_) -> forall a err. a -> MaybeErr a err
Succeeded b
val
>
> arrElem :: (Ix a, Ord a) => [a] -> a -> Bool
> arrElem :: forall a. (Ix a, Ord a) => [a] -> a -> Bool
arrElem [a]
obj = \a
x -> forall a. Ix a => (a, a) -> a -> Bool
inRange (a, a)
size a
x Bool -> Bool -> Bool
&& Array a Bool
arr forall i e. Ix i => Array i e -> i -> e
! a
x
> where
> obj' :: [a]
obj' = forall a. Ord a => [a] -> [a]
sort [a]
obj
> size :: (a, a)
size = (forall a. [a] -> a
head [a]
obj',forall a. [a] -> a
last [a]
obj')
> arr :: Array a Bool
arr = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (a, a)
size [ a
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
obj | a
i <- forall a. Ix a => (a, a) -> [a]
range (a, a)
size ]
> fib = memoise (0,100) fib'
> where
> fib' 0 = 0
> fib' 1 = 0
> fib' n = fib (n-1) + fib (n-2)
> memoise :: (Ix a) => (a,a) -> (a -> b) -> a -> b
> memoise :: forall a b. Ix a => (a, a) -> (a -> b) -> a -> b
memoise (a, a)
bds a -> b
f = forall i e. Ix i => Array i e -> i -> e
(!) Array a b
arr
> where arr :: Array a b
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (a, a)
bds [ (a
t, a -> b
f a
t) | a
t <- forall a. Ix a => (a, a) -> [a]
range (a, a)
bds ]
> listArray' :: (Int,Int) -> [a] -> Array Int a
> listArray' :: forall a. (Int, Int) -> [a] -> Array Int a
listArray' (Int
low,Int
up) [a]
elems =
> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
elems forall a. Eq a => a -> a -> Bool
/= Int
upforall a. Num a => a -> a -> a
-Int
lowforall a. Num a => a -> a -> a
+Int
1 then forall a. HasCallStack => String -> a
error String
"wibble" else
> forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
low,Int
up) [a]
elems
> mapDollarDollar :: String -> Maybe (String -> String)
> mapDollarDollar :: String -> Maybe ShowS
mapDollarDollar String
code0 = String -> String -> Maybe ShowS
go String
code0 String
""
> where go :: String -> String -> Maybe ShowS
go String
code String
acc =
> case String
code of
> [] -> forall a. Maybe a
Nothing
>
> Char
'"' :String
r -> case forall a. Read a => ReadS a
reads String
code :: [(String,String)] of
> [] -> String -> String -> Maybe ShowS
go String
r (Char
'"'forall a. a -> [a] -> [a]
:String
acc)
> (String
s,String
r'):[(String, String)]
_ -> String -> String -> Maybe ShowS
go String
r' (forall a. [a] -> [a]
reverse (forall a. Show a => a -> String
show String
s) forall a. [a] -> [a] -> [a]
++ String
acc)
> Char
a:Char
'\'' :String
r | Char -> Bool
isAlphaNum Char
a -> String -> String -> Maybe ShowS
go String
r (Char
'\''forall a. a -> [a] -> [a]
:Char
aforall a. a -> [a] -> [a]
:String
acc)
> Char
'\'' :String
r -> case forall a. Read a => ReadS a
reads String
code :: [(Char,String)] of
> [] -> String -> String -> Maybe ShowS
go String
r (Char
'\''forall a. a -> [a] -> [a]
:String
acc)
> (Char
c,String
r'):[(Char, String)]
_ -> String -> String -> Maybe ShowS
go String
r' (forall a. [a] -> [a]
reverse (forall a. Show a => a -> String
show Char
c) forall a. [a] -> [a] -> [a]
++ String
acc)
> Char
'\\':Char
'$':String
r -> String -> String -> Maybe ShowS
go String
r (Char
'$'forall a. a -> [a] -> [a]
:String
acc)
> Char
'$':Char
'$':String
r -> forall a. a -> Maybe a
Just (\String
repl -> forall a. [a] -> [a]
reverse String
acc forall a. [a] -> [a] -> [a]
++ String
repl forall a. [a] -> [a] -> [a]
++ String
r)
> Char
c:String
r -> String -> String -> Maybe ShowS
go String
r (Char
cforall a. a -> [a] -> [a]
:String
acc)
> str :: String -> String -> String
> str :: String -> ShowS
str = String -> ShowS
showString
> char :: Char -> String -> String
> char :: Char -> ShowS
char Char
c = (Char
c forall a. a -> [a] -> [a]
:)
> interleave :: String -> [String -> String] -> String -> String
> interleave :: String -> [ShowS] -> ShowS
interleave String
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ShowS
a ShowS
b -> ShowS
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
b) forall a. a -> a
id
> interleave' :: String -> [String -> String] -> String -> String
> interleave' :: String -> [ShowS] -> ShowS
interleave' String
s = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ShowS
a ShowS
b -> ShowS
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
b)
> strspace :: String -> String
> strspace :: ShowS
strspace = Char -> ShowS
char Char
' '
> nl :: String -> String
> nl :: ShowS
nl = Char -> ShowS
char Char
'\n'
> maybestr :: Maybe String -> String -> String
> maybestr :: Maybe String -> ShowS
maybestr (Just String
s) = String -> ShowS
str String
s
> maybestr Maybe String
_ = forall a. a -> a
id
> brack :: String -> String -> String
> brack :: String -> ShowS
brack String
s = String -> ShowS
str (Char
'(' forall a. a -> [a] -> [a]
: String
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
char Char
')'
> brack' :: (String -> String) -> String -> String
> brack' :: ShowS -> ShowS
brack' ShowS
s = Char -> ShowS
char Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
char Char
')'