module Test.Framework.Utilities where

import Control.Arrow (first, second)

import Data.Function (on)
import Data.Maybe ( fromMaybe, listToMaybe )
import Data.List (intercalate)


newtype K a = K { forall a. K a -> a
unK :: a }


secondsToMicroseconds :: Num a => a -> a
secondsToMicroseconds :: forall a. Num a => a -> a
secondsToMicroseconds = (a
1000000a -> a -> a
forall a. Num a => a -> a -> a
*)

microsecondsToPicoseconds :: Num a => a -> a
microsecondsToPicoseconds :: forall a. Num a => a -> a
microsecondsToPicoseconds = (a
1000000a -> a -> a
forall a. Num a => a -> a -> a
*)

listToMaybeLast :: [a] -> Maybe a
listToMaybeLast :: forall a. [a] -> Maybe a
listToMaybeLast = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

mappendBy :: Monoid b => (a -> b) -> a -> a -> b
mappendBy :: forall b a. Monoid b => (a -> b) -> a -> a -> b
mappendBy a -> b
f = b -> b -> b
forall a. Monoid a => a -> a -> a
mappend (b -> b -> b) -> (a -> b) -> a -> a -> b
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f

orElse :: Maybe a -> a -> a
orElse :: forall a. Maybe a -> a -> a
orElse = (a -> Maybe a -> a) -> Maybe a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe

onLeft :: (a -> c) -> (a, b) -> (c, b)
onLeft :: forall a c b. (a -> c) -> (a, b) -> (c, b)
onLeft = (a -> c) -> (a, b) -> (c, b)
forall a c b. (a -> c) -> (a, b) -> (c, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first

onRight :: (b -> c) -> (a, b) -> (a, c)
onRight :: forall b c a. (b -> c) -> (a, b) -> (a, c)
onRight = (b -> c) -> (a, b) -> (a, c)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second

-- | Like 'unlines', but does not append a trailing newline if there
-- is at least one line.  For example:
--
-- > unlinesConcise ["A", "B"] == "A\nB"
-- > unlinesConcise [] == ""
--
-- Whereas:
--
-- > unlines ["A", "B"] == "A\nB\n"
-- > unlines [] == ""
--
-- This is closer to the behaviour of 'unwords', which does not append
-- a trailing space.
unlinesConcise :: [String] -> String
unlinesConcise :: [String] -> String
unlinesConcise = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"

mapAccumLM :: Monad m => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
_ acc
acc [] = (acc, [y]) -> m (acc, [y])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
acc, [])
mapAccumLM acc -> x -> m (acc, y)
f acc
acc (x
x:[x]
xs) = do
    (acc', y) <- acc -> x -> m (acc, y)
f acc
acc x
x
    (acc'', ys) <- mapAccumLM f acc' xs
    return (acc'', y:ys)

padRight :: Int -> String -> String
padRight :: Int -> String -> String
padRight Int
desired_length String
s = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
desired_length Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '

dropLast :: Int -> [a] -> [a]
dropLast :: forall a. Int -> [a] -> [a]
dropLast Int
n = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse