{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Common.Utils
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Exports utility functions
module Common.Utils
  ( diffTime,
    divWithRem,
    eitherCompose,
    eitherComposeMay,
    eitherJoin,
    eitherToMaybe,
    formatSeconds,
    matchAndStrip,
    monoBimap,
    showToText,
    startsWith,
  )
where

import Common.RefinedUtils
import qualified Data.Bifunctor as BF
import qualified Data.Text as T
import qualified System.Clock as C

-- | Determines if the second parameter is a prefix of the first,
-- returns the rest if so. That is,
--
--   \[
--     \newcommand\doubleplus{+\kern-1.3ex+\kern0.8ex}
--     \mathrm{startsWith}(xs, ys) = \begin{cases}
--       \mathrm{Just\,} zs, &xs = ys \doubleplus zs \\
--       \mathrm{Nothing}, &\mathrm{otherwise}
--     \end{cases}
--   \]
--
-- Can be called infix, e.g.
--
-- @
--   "hello world" `'startsWith'` "hello" --> 'Just' " world"
-- @
startsWith :: Eq a => [a] -> [a] -> Maybe [a]
startsWith :: [a] -> [a] -> Maybe [a]
startsWith xs :: [a]
xs [] = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs
startsWith [] _ = Maybe [a]
forall a. Maybe a
Nothing
startsWith (x :: a
x : xs :: [a]
xs) (y :: a
y : ys :: [a]
ys)
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
startsWith [a]
xs [a]
ys
  | Bool
otherwise = Maybe [a]
forall a. Maybe a
Nothing

-- | Flipped version of 'startsWith'. Useful with @ViewPatterns@,
-- e.g.
--
-- @
--    :set -XViewPatterns
--
--    parseArg :: 'String' -> 'Either' 'String' SomeType
--    parseArg (matchAndStrip "--val=" -> 'Just' rest) = parseVal rest
--    parseArg (matchAndStrip "--other=" -> 'Just' rest) = parseOther rest
--    parseArg _ = 'Left' "did not match!"
-- @
matchAndStrip :: Eq a => [a] -> [a] -> Maybe [a]
matchAndStrip :: [a] -> [a] -> Maybe [a]
matchAndStrip = ([a] -> [a] -> Maybe [a]) -> [a] -> [a] -> Maybe [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
startsWith

-- | For given \(x, y\), returns the absolute difference \(|x - y|\).
diffTime :: C.TimeSpec -> C.TimeSpec -> RNonNegative Int
diffTime :: TimeSpec -> TimeSpec -> RNonNegative Int
diffTime t1 :: TimeSpec
t1 t2 :: TimeSpec
t2 =
  let diff :: Int
diff = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
C.sec (TimeSpec -> Int64) -> TimeSpec -> Int64
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
C.diffTimeSpec TimeSpec
t1 TimeSpec
t2
   in -- Safe because 'C.diffTimeSpec' guaranteed to be non-zero
      Int -> RNonNegative Int
forall p x. Predicate p x => x -> Refined p x
unsafeRef Int
diff

-- | For \(n \ge 0, d > 0\), returns non-negative \((e, r)\) such that
--
-- \[
--    \begin{align}
--      de + r = n \\
--      r < n \\
--    \end{align}
-- \]
divWithRem :: Integral a => RNonNegative a -> RPositive a -> (a, a)
divWithRem :: RNonNegative a -> RPositive a -> (a, a)
divWithRem n :: RNonNegative a
n d :: RPositive a
d = (a
n' a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
d', a
n' a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
d')
  where
    n' :: a
n' = RNonNegative a -> a
forall p x. Refined p x -> x
unrefine RNonNegative a
n
    d' :: a
d' = RPositive a -> a
forall p x. Refined p x -> x
unrefine RPositive a
d

-- | For \(n \ge 0\) seconds, returns a 'T.Text' description of the minutes
-- and seconds.
formatSeconds :: RNonNegative Int -> T.Text
formatSeconds :: RNonNegative Int -> Text
formatSeconds seconds :: RNonNegative Int
seconds =
  let d :: RPositive Int
d = $$(refineTH 60) :: RPositive Int
      (m :: Int
m, s :: Int
s) = RNonNegative Int -> RPositive Int -> (Int, Int)
forall a. Integral a => RNonNegative a -> RPositive a -> (a, a)
divWithRem RNonNegative Int
seconds RPositive Int
d
      pluralize :: a -> a -> a
pluralize i :: a
i t :: a
t
        | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
t
        | Bool
otherwise = a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "s"
   in [Text] -> Text
T.concat
        [ Int -> Text
forall a. Show a => a -> Text
showToText Int
m,
          Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
pluralize Int
m " minute",
          " and ",
          Int -> Text
forall a. Show a => a -> Text
showToText Int
s,
          Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
pluralize Int
s " second",
          "  "
        ]

-- | Convenience function for mapping the same function over
-- a monomorphic bifunctor.
monoBimap :: BF.Bifunctor f => (a -> b) -> f a a -> f b b
monoBimap :: (a -> b) -> f a a -> f b b
monoBimap g :: a -> b
g = (a -> b) -> (a -> b) -> f a a -> f b b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap a -> b
g a -> b
g

-- | Joins a composed 'Either' in the natural way.
eitherJoin :: Either a (Either b c) -> Either () c
eitherJoin :: Either a (Either b c) -> Either () c
eitherJoin (Right (Right x :: c
x)) = c -> Either () c
forall a b. b -> Either a b
Right c
x
eitherJoin _ = () -> Either () c
forall a b. a -> Either a b
Left ()

-- | Natural transformation from @'Either' a@ to 'Maybe'.
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe (Left _) = Maybe b
forall a. Maybe a
Nothing
eitherToMaybe (Right x :: b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x

-- | Composes 'Either' functions.
eitherCompose :: (a -> Either b c) -> (c -> Either d e) -> a -> Either () e
eitherCompose :: (a -> Either b c) -> (c -> Either d e) -> a -> Either () e
eitherCompose f :: a -> Either b c
f g :: c -> Either d e
g x :: a
x = Either b (Either d e) -> Either () e
forall a b c. Either a (Either b c) -> Either () c
eitherJoin (c -> Either d e
g (c -> Either d e) -> Either b c -> Either b (Either d e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Either b c
f a
x)

-- | Composition of 'eitherToMaybe' to 'eitherCompose'.
eitherComposeMay :: (a -> Either b c) -> (c -> Either d e) -> a -> Maybe e
eitherComposeMay :: (a -> Either b c) -> (c -> Either d e) -> a -> Maybe e
eitherComposeMay f :: a -> Either b c
f g :: c -> Either d e
g = Either () e -> Maybe e
forall a b. Either a b -> Maybe b
eitherToMaybe (Either () e -> Maybe e) -> (a -> Either () e) -> a -> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either b c) -> (c -> Either d e) -> a -> Either () e
forall a b c d e.
(a -> Either b c) -> (c -> Either d e) -> a -> Either () e
eitherCompose a -> Either b c
f c -> Either d e
g

-- | Transforms a showable to 'T.Text'.
showToText :: Show a => a -> T.Text
showToText :: a -> Text
showToText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show