{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}

-- | I rewrote: https://hackage.haskell.org/package/unliftio-0.2.20/docs/src/UnliftIO.Memoize.html#Memoized
-- for monad trans basecontrol
-- we don't need a generic `m` anyway. it's good enough in base IO.
module Codec.Xlsx.Parser.Internal.Memoize
  ( Memoized
  , runMemoized
  , memoizeRef
  ) where

import Control.Applicative as A
import Control.Monad (join)
import Control.Monad.IO.Class
import Data.IORef
import Control.Exception

-- | A \"run once\" value, with results saved. Extract the value with
-- 'runMemoized'. For single-threaded usage, you can use 'memoizeRef' to
-- create a value. If you need guarantees that only one thread will run the
-- action at a time, use 'memoizeMVar'.
--
-- Note that this type provides a 'Show' instance for convenience, but not
-- useful information can be provided.
newtype Memoized a = Memoized (IO a)
  deriving (a -> Memoized b -> Memoized a
(a -> b) -> Memoized a -> Memoized b
(forall a b. (a -> b) -> Memoized a -> Memoized b)
-> (forall a b. a -> Memoized b -> Memoized a) -> Functor Memoized
forall a b. a -> Memoized b -> Memoized a
forall a b. (a -> b) -> Memoized a -> Memoized b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Memoized b -> Memoized a
$c<$ :: forall a b. a -> Memoized b -> Memoized a
fmap :: (a -> b) -> Memoized a -> Memoized b
$cfmap :: forall a b. (a -> b) -> Memoized a -> Memoized b
Functor, Functor Memoized
a -> Memoized a
Functor Memoized
-> (forall a. a -> Memoized a)
-> (forall a b. Memoized (a -> b) -> Memoized a -> Memoized b)
-> (forall a b c.
    (a -> b -> c) -> Memoized a -> Memoized b -> Memoized c)
-> (forall a b. Memoized a -> Memoized b -> Memoized b)
-> (forall a b. Memoized a -> Memoized b -> Memoized a)
-> Applicative Memoized
Memoized a -> Memoized b -> Memoized b
Memoized a -> Memoized b -> Memoized a
Memoized (a -> b) -> Memoized a -> Memoized b
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
forall a. a -> Memoized a
forall a b. Memoized a -> Memoized b -> Memoized a
forall a b. Memoized a -> Memoized b -> Memoized b
forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Memoized a -> Memoized b -> Memoized a
$c<* :: forall a b. Memoized a -> Memoized b -> Memoized a
*> :: Memoized a -> Memoized b -> Memoized b
$c*> :: forall a b. Memoized a -> Memoized b -> Memoized b
liftA2 :: (a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
<*> :: Memoized (a -> b) -> Memoized a -> Memoized b
$c<*> :: forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
pure :: a -> Memoized a
$cpure :: forall a. a -> Memoized a
$cp1Applicative :: Functor Memoized
A.Applicative, Applicative Memoized
a -> Memoized a
Applicative Memoized
-> (forall a b. Memoized a -> (a -> Memoized b) -> Memoized b)
-> (forall a b. Memoized a -> Memoized b -> Memoized b)
-> (forall a. a -> Memoized a)
-> Monad Memoized
Memoized a -> (a -> Memoized b) -> Memoized b
Memoized a -> Memoized b -> Memoized b
forall a. a -> Memoized a
forall a b. Memoized a -> Memoized b -> Memoized b
forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Memoized a
$creturn :: forall a. a -> Memoized a
>> :: Memoized a -> Memoized b -> Memoized b
$c>> :: forall a b. Memoized a -> Memoized b -> Memoized b
>>= :: Memoized a -> (a -> Memoized b) -> Memoized b
$c>>= :: forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
$cp1Monad :: Applicative Memoized
Monad)
instance Show (Memoized a) where
  show :: Memoized a -> String
show Memoized a
_ = String
"<<Memoized>>"

-- | Extract a value from a 'Memoized', running an action if no cached value is
-- available.
runMemoized :: MonadIO m => Memoized a -> m a
runMemoized :: Memoized a -> m a
runMemoized (Memoized IO a
m) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
{-# INLINE runMemoized #-}

-- | Create a new 'Memoized' value using an 'IORef' under the surface. Note that
-- the action may be run in multiple threads simultaneously, so this may not be
-- thread safe (depending on the underlying action).
memoizeRef :: IO a -> IO (Memoized a)
memoizeRef :: IO a -> IO (Memoized a)
memoizeRef IO a
action = do
  IORef (Maybe (Either SomeException a))
ref <- Maybe (Either SomeException a)
-> IO (IORef (Maybe (Either SomeException a)))
forall a. a -> IO (IORef a)
newIORef Maybe (Either SomeException a)
forall a. Maybe a
Nothing
  Memoized a -> IO (Memoized a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memoized a -> IO (Memoized a)) -> Memoized a -> IO (Memoized a)
forall a b. (a -> b) -> a -> b
$ IO a -> Memoized a
forall a. IO a -> Memoized a
Memoized (IO a -> Memoized a) -> IO a -> Memoized a
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Either SomeException a)
mres <- IORef (Maybe (Either SomeException a))
-> IO (Maybe (Either SomeException a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Either SomeException a))
ref
    Either SomeException a
res <-
      case Maybe (Either SomeException a)
mres of
        Just Either SomeException a
res -> Either SomeException a -> IO (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
        Maybe (Either SomeException a)
Nothing -> do
          Either SomeException a
res <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException IO a
action
          IORef (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
ref (Maybe (Either SomeException a) -> IO ())
-> Maybe (Either SomeException a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just Either SomeException a
res
          Either SomeException a -> IO (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
    (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res