-----------------------------------------------------------------------------
-- |
-- Module      :  Sindre.Util
-- License     :  MIT-style (see LICENSE)
--
-- Stability   :  stable
-- Portability :  portable
--
-- Various utility bits and pieces.
--
-----------------------------------------------------------------------------
module Sindre.Util
    ( io
    , fi
    , err
    , upcase
    , downcase
    , hsv2rgb
    , wrap
    , quote
    , clamp
    , mapAccumLM
    , ifM
    , divide
    ) where

import Control.Monad.Trans

import Data.Char

import System.IO

-- | Short-hand for 'liftIO'
io :: MonadIO m => IO a -> m a
io :: IO a -> m a
io = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Short-hand for 'fromIntegral'
fi :: (Integral a, Num b) => a -> b
fi :: a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Short-hand for 'liftIO . hPutStrLn stderr'
err :: MonadIO m => String -> m ()
err :: String -> m ()
err = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr

-- | Short-hand for 'map toUpper'
upcase :: String -> String
upcase :: String -> String
upcase = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper

-- | Short-hand for 'map toLower'
downcase :: String -> String
downcase :: String -> String
downcase = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

-- | Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
hsv2rgb :: (Integer, a, a) -> (a, a, a)
hsv2rgb (Integer
h,a
s,a
v) =
    let hi :: Integer
hi = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
h Integer
60 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
6 :: Integer
        f :: a
f = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fi Integer
ha -> a -> a
forall a. Fractional a => a -> a -> a
/a
60 a -> a -> a
forall a. Num a => a -> a -> a
- Integer -> a
forall a b. (Integral a, Num b) => a -> b
fi Integer
hi :: Fractional a => a
        q :: a
q = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
f)
        p :: a
p = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
s)
        t :: a
t = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a
1a -> a -> a
forall a. Num a => a -> a -> a
-(a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
f)a -> a -> a
forall a. Num a => a -> a -> a
*a
s)
    in case Integer
hi of
         Integer
0 -> (a
v,a
t,a
p)
         Integer
1 -> (a
q,a
v,a
p)
         Integer
2 -> (a
p,a
v,a
t)
         Integer
3 -> (a
p,a
q,a
v)
         Integer
4 -> (a
t,a
p,a
v)
         Integer
5 -> (a
v,a
p,a
q)
         Integer
_ -> String -> (a, a, a)
forall a. HasCallStack => String -> a
error String
"The world is ending. x mod a >= a."

-- | Prepend and append first argument to second argument.
wrap :: String -> String -> String
wrap :: String -> String -> String
wrap String
x String
y = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

-- | Put double quotes around the given string.
quote :: String -> String
quote :: String -> String
quote = String -> String -> String
wrap String
"\""

-- | Bound a value by minimum and maximum values.
clamp :: Ord a => a -> a -> a -> a
clamp :: a -> a -> a -> a
clamp a
lower a
x a
upper = a -> a -> a
forall a. Ord a => a -> a -> a
min a
upper (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
lower a
x

-- | The 'mapAccumLM' function behaves like a combination of 'mapM' and
-- 'foldlM'; it applies a monadic function to each element of a list,
-- passing an accumulating parameter from left to right, and returning
-- a final value of this accumulator together with the new list.
mapAccumLM :: Monad m => (acc -> x -> m (acc, y))
           -> acc
           -> [x]
           -> m (acc, [y])
mapAccumLM :: (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
_ acc
s []     = (acc, [y]) -> m (acc, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, [])
mapAccumLM acc -> x -> m (acc, y)
f acc
s (x
x:[x]
xs) = do
  (acc
s', y
y ) <- acc -> x -> m (acc, y)
f acc
s x
x
  (acc
s'',[y]
ys) <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
s' [x]
xs
  (acc, [y]) -> m (acc, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s'',y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys)

-- | Like 'when', but with two branches.  A lifted @if@.
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM m Bool
p m a
t m a
e = do Bool
b <- m Bool
p
               if Bool
b then m a
t else m a
e

-- | @x `divide` n@ splits the interval @[0..x]@ into @n@
-- non-overlapping chunks that together form the entire interval.
-- For example:
-- 
-- >>> 10 `divide` 3
-- [3,3,4]
divide :: Integral a => a -> a -> [a]
divide :: a -> a -> [a]
divide a
total a
n = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a b. a -> b -> a
const a
c) [a
0..a
na -> a -> a
forall a. Num a => a -> a -> a
-a
2] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
r]
  where (a
c,a
r) = a
total a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
n