{- |
Description: A module containing various utility functions.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

A module containing various utility functions.
-}
module Util where

-- | Generates a string of /i/ spaces where /i/ is the given indent.
genIndent :: Int -> String
genIndent :: Int -> String
genIndent i :: Int
i = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
i " "

-- | Returns @x@ iff the given Maybe is @Just x@.
-- Otherwise, returns the value produced by the given generator function.
safeFromJust :: Maybe a -> (() -> a) -> a
safeFromJust :: Maybe a -> (() -> a) -> a
safeFromJust Nothing gen :: () -> a
gen = () -> a
gen ()
safeFromJust (Just x :: a
x) _ = a
x

-- | Folds the given list after reversing it.
reversefoldr :: (a -> b -> b) -> b -> [a] -> b
reversefoldr :: (a -> b -> b) -> b -> [a] -> b
reversefoldr f :: a -> b -> b
f zero :: b
zero container :: [a]
container = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
zero ([a] -> b) -> [a] -> b
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
container

-- | Generates parenthesis around the given string iff the given bool is true.
parenIf :: Bool -> String -> String
parenIf :: Bool -> String -> String
parenIf True s :: String
s = "("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++")"
parenIf False s :: String
s = String
s

-- | Filters the given Maybe.
-- If the maybe's element satisfies the given predicate, the element will be kept.
-- Otherwise, returns @Nothing@.
takeIf :: (a -> Bool) -> Maybe a -> Maybe a
takeIf :: (a -> Bool) -> Maybe a -> Maybe a
takeIf _ Nothing = Maybe a
forall a. Maybe a
Nothing
takeIf p :: a -> Bool
p (Just x :: a
x)
    | a -> Bool
p a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

-- | Lifts a value to a 'Maybe' based on a predicate.
-- Iff the element satisfies the predicate, the result is @Nothing@.
-- Otherwise returns the @Just@ the element.
nothingIf :: (a -> Bool) -> a -> Maybe a
nothingIf :: (a -> Bool) -> a -> Maybe a
nothingIf p :: a -> Bool
p a :: a
a
    | a -> Bool
p a
a = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | Removes the first and the last element of a list.
removeFirstAndLast :: [a] -> [a]
removeFirstAndLast :: [a] -> [a]
removeFirstAndLast [] = []
removeFirstAndLast [x :: a
x] = []
removeFirstAndLast xs :: [a]
xs = [a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
init [a]
xs

-- | If the given string starts and ends with quotes @"@ (i.e., it is of the form @"\"something\""@), those parenthesis will be removed (i.e., turned to just @"something"@).
-- This is used for showing strings from a polymorphic context.
removeQuotes :: String -> String
removeQuotes :: String -> String
removeQuotes s :: String
s =
    if String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\"' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\"'
    then String -> String
forall a. [a] -> [a]
removeFirstAndLast String
s
    else String
s