{-|
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 System.IO (hPutStrLn, stderr)

import qualified Data.Sequence as Seq

-- | Concats a list of Monoids or returns Nothing if empty.
maybeConcat :: Monoid a => [a] -> Maybe a
maybeConcat :: forall a. Monoid a => [a] -> Maybe a
maybeConcat [] = forall a. Maybe a
Nothing
maybeConcat [a]
lst = forall a. a -> Maybe a
Just a
merged where
  !merged :: a
merged = 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 :: forall (m :: * -> *) a. MonadIO m => 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just a
x -> do
      [a]
xs <- forall (m :: * -> *) a. MonadIO m => m (Maybe a) -> m [a]
collectJustM m (Maybe a)
action
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
x 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 :: forall a. Seq a -> a
seqLast Seq a
seq
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
seq) = forall a. Seq a -> Int -> a
Seq.index Seq a
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
seq forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = 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 :: forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Seq a
prefix Seq a
seq = forall a. Int -> Seq a -> Seq a
Seq.take (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
prefix) Seq a
seq 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 :: forall a. Seq (Maybe a) -> Seq a
seqCatMaybes Seq (Maybe a)
Empty = forall a. Seq a
Empty
seqCatMaybes (Maybe a
x :<| Seq (Maybe a)
xs) = case Maybe a
x of
  Just a
val -> a
val forall a. a -> Seq a -> Seq a
:<| forall a. Seq (Maybe a) -> Seq a
seqCatMaybes Seq (Maybe a)
xs
  Maybe 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 :: forall a. [a -> a] -> a -> a
applyFnList [a -> a]
fns a
initial = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)) a
initial [a -> a]
fns

{-|
Returns the minimum value of a given floating type.

Copied from: https://hackage.haskell.org/package/numeric-limits
-}
minNumericValue :: (RealFloat a) => a
minNumericValue :: forall a. RealFloat a => a
minNumericValue = a
x where
  n :: Int
n = forall a. RealFloat a => a -> Int
floatDigits a
x
  b :: Integer
b = forall a. RealFloat a => a -> Integer
floatRadix a
x
  (Int
l, Int
_) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
  x :: a
x = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
bforall a b. (Num a, Integral b) => a -> b -> a
^Int
n forall a. Num a => a -> a -> a
- Integer
1) (Int
l forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
- Int
1)

{-|
Returns the maximum value of a given floating type.

Copied from: https://hackage.haskell.org/package/numeric-limits
-}
maxNumericValue :: (RealFloat a) => a
maxNumericValue :: forall a. RealFloat a => a
maxNumericValue = a
x where
  n :: Int
n = forall a. RealFloat a => a -> Int
floatDigits a
x
  b :: Integer
b = forall a. RealFloat a => a -> Integer
floatRadix a
x
  (Int
_, Int
u) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
  x :: a
x = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
bforall a b. (Num a, Integral b) => a -> b -> a
^Int
n forall a. Num a => a -> a -> a
- Integer
1) (Int
u forall a. Num a => a -> a -> a
- Int
n)

-- | Restricts a value to a given range.
clamp :: (Ord a) => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
mn a
mx = forall a. Ord a => a -> a -> a
max a
mn forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny = 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 :: forall a. [a] -> Maybe a
headMay [] = forall a. Maybe a
Nothing
headMay (a
x : [a]
_) = forall a. a -> Maybe a
Just a
x

putStrLnErr :: String -> IO ()
putStrLnErr :: [Char] -> IO ()
putStrLnErr [Char]
msg = forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny
  (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
msg)
  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
msg)