Utils.hs

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Internal utilities and instances
module CalamityCommands.Internal.Utils (
  -- whileMFinalIO
  -- , untilJustFinalIO
  whenJust,
  whenM,
  unlessM,
  lastMaybe,
  leftToMaybe,
  rightToMaybe,
  justToEither,
  mapLeft,
  (<<$>>),
  (<<*>>),
  (<.>),
) where

-- import           CalamityCommands.Internal.RunIntoIO

import Control.Applicative

import Data.Semigroup (Last (..))

-- import qualified Polysemy              as P

-- -- | Like whileM, but stateful effects are not preserved to mitigate memory leaks
-- --
-- -- This means Polysemy.Error won't work to break the loop, etc.
-- -- Instead, Error/Alternative will just result in the loop quitting.
-- whileMFinalIO :: P.Member (P.Final IO) r => P.Sem r Bool -> P.Sem r ()
-- whileMFinalIO action = do
--   action' <- runSemToIO action
--   P.embedFinal $ go action'
--   where go action' = do
--           r <- action'
--           case r of
--             Just True ->
--               go action'
--             _ ->
--               pure ()

-- -- | Like untilJust, but stateful effects are not preserved to mitigate memory leaks
-- --
-- -- This means Polysemy.Error won't work to break the loop, etc.
-- -- Instead, Error/Alternative will just result in another loop.
-- untilJustFinalIO :: P.Member (P.Final IO) r => P.Sem r (Maybe a) -> P.Sem r a
-- untilJustFinalIO action = do
--   action' <- runSemToIO action
--   P.embedFinal $ go action'
--   where go action' = do
--           r <- action'
--           case r of
--             Just (Just a) ->
--               pure a
--             _ ->
--               go action'

whenJust :: (Applicative m) => Maybe a -> (a -> m ()) -> m ()
whenJust = flip $ maybe (pure ())

whenM :: (Monad m) => m Bool -> m () -> m ()
whenM p m =
  p >>= \case
    True -> m
    False -> pure ()

unlessM :: (Monad m) => m Bool -> m () -> m ()
unlessM = whenM . (not <$>)

lastMaybe :: Maybe a -> Maybe a -> Maybe a
lastMaybe l r = getLast <$> fmap Last l <> fmap Last r

mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft f (Left e) = Left (f e)
mapLeft _ (Right x) = Right x

leftToMaybe :: Either e a -> Maybe e
leftToMaybe (Left x) = Just x
leftToMaybe _ = Nothing

rightToMaybe :: Either e a -> Maybe a
rightToMaybe (Right x) = Just x
rightToMaybe _ = Nothing

justToEither :: Maybe e -> Either e ()
justToEither (Just x) = Left x
justToEither _ = Right ()

(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
(<<$>>) = fmap . fmap

infixl 4 <<$>>

(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)
(<<*>>) = liftA2 (<*>)

infixl 4 <<*>>

(<.>) :: (Functor f) => (a -> b) -> (c -> f a) -> (c -> f b)
(<.>) f g x = f <$> g x

infixl 4 <.>