{-|
Module      : Monomer.Helper
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Helper functions used across the library. They do not belong to any specific
module and are not directly exported.
-}
{-# LANGUAGE BangPatterns #-}

module Monomer.Helper where

import Control.Exception (SomeException, catch)
import Control.Monad.IO.Class (MonadIO)
import Data.Sequence (Seq(..))

import qualified Data.Sequence as Seq

-- | Concats a list of Monoids or returns Nothing if empty.
maybeConcat :: Monoid a => [a] -> Maybe a
maybeConcat :: [a] -> Maybe a
maybeConcat [] = Maybe a
forall a. Maybe a
Nothing
maybeConcat [a]
lst = a -> Maybe a
forall a. a -> Maybe a
Just a
merged where
  !merged :: a
merged = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a]
lst

-- | Runs an action until Nothing is returned, collecting the results in a list.
collectJustM :: MonadIO m => m (Maybe a) -> m [a]
collectJustM :: m (Maybe a) -> m [a]
collectJustM m (Maybe a)
action = do
  Maybe a
x <- m (Maybe a)
action
  case Maybe a
x of
    Maybe a
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just a
x -> do
      [a]
xs <- m (Maybe a) -> m [a]
forall (m :: * -> *) a. MonadIO m => m (Maybe a) -> m [a]
collectJustM m (Maybe a)
action
      [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

-- | Returns the last item in a sequence. Unsafe, fails if sequence is empty.
seqLast :: Seq a -> a
seqLast :: Seq a -> a
seqLast Seq a
seq
  | Bool -> Bool
not (Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
seq) = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
seq (Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
seq Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid sequence provided to seqLast"

-- | Checks if the first sequence is a prefix of the second.
seqStartsWith :: Eq a => Seq a -> Seq a -> Bool
seqStartsWith :: Seq a -> Seq a -> Bool
seqStartsWith Seq a
prefix Seq a
seq = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.take (Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
prefix) Seq a
seq Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a
prefix

-- | Filters Nothing instances out of a Seq, and removes the Just wrapper.
seqCatMaybes :: Seq (Maybe a) -> Seq a
seqCatMaybes :: Seq (Maybe a) -> Seq a
seqCatMaybes Seq (Maybe a)
Empty = Seq a
forall a. Seq a
Empty
seqCatMaybes (Maybe a
x :<| Seq (Maybe a)
xs) = case Maybe a
x of
  Just a
val -> a
val a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq (Maybe a) -> Seq a
forall a. Seq (Maybe a) -> Seq a
seqCatMaybes Seq (Maybe a)
xs
  Maybe a
_ -> Seq (Maybe a) -> Seq a
forall a. Seq (Maybe a) -> Seq a
seqCatMaybes Seq (Maybe a)
xs

-- | Folds a list of functions over an initial value.
applyFnList :: [a -> a] -> a -> a
applyFnList :: [a -> a] -> a -> a
applyFnList [a -> a]
fns a
initial = (a -> (a -> a) -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((a -> a) -> a -> a) -> a -> (a -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($)) a
initial [a -> a]
fns

-- | Returns the maximum value of a given floating type.
maxNumericValue :: (RealFloat a) => a
maxNumericValue :: a
maxNumericValue = a
x where
  n :: Int
n = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
  b :: Integer
b = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
  (Int
_, Int
u) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
  x :: a
x = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)

-- | Restricts a value to a given range.
clamp :: (Ord a) => a -> a -> a -> a
clamp :: a -> a -> a -> a
clamp a
mn a
mx = a -> a -> a
forall a. Ord a => a -> a -> a
max a
mn (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
min a
mx

-- | Catches any exception thrown by the provided action
catchAny :: IO a -> (SomeException -> IO a) -> IO a
catchAny :: IO a -> (SomeException -> IO a) -> IO a
catchAny = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch

-- | Returns Just the first item if the list is not empty, Nothing otherwise.
headMay :: [a] -> Maybe a
headMay :: [a] -> Maybe a
headMay [] = Maybe a
forall a. Maybe a
Nothing
headMay (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x