never executed always true always false

    1 {-# LANGUAGE DeriveDataTypeable #-}
    2 
    3 {- |
    4 Module      : NITTA.Synthesis.MlBackend.FixedCache
    5 Description : Fixed version of thread-safe write-once cache from io-memoize package
    6 Copyright   : (c) Dan Burton <danburton.email@gmail.com>, 2014
    7 License     : BSD3
    8 Maintainer  : aleksandr.penskoi@gmail.com
    9 Stability   : experimental
   10 
   11 Taken as is from Control.Concurrent.Cache of io-memoize package,
   12 but with expoted Cache constructor, so we can use it in pattern matching.
   13 
   14 This was necessary not to rewrite similar functionality. Linter errors were
   15 fixed as well.
   16 -}
   17 module NITTA.Synthesis.MlBackend.FixedCache (Cache (..), newCache, fetch) where
   18 
   19 import Control.Concurrent.MVar
   20 import Data.Typeable (Typeable)
   21 
   22 {- | A thread-safe write-once cache. If you need more functionality,
   23 (e.g. multiple write, cache clearing) use an 'MVar' instead.
   24 -}
   25 newtype Cache a = Cache (MVar (Maybe a))
   26     deriving (Eq, Typeable)
   27 
   28 {- | Fetch the value stored in the cache,
   29 or call the supplied fallback and store the result,
   30 if the cache is empty.
   31 -}
   32 fetch :: Cache a -> IO a -> IO a
   33 fetch (Cache var) action = go
   34     where
   35         go =
   36             readMVar var >>= \case
   37                 Just a -> return a
   38                 Nothing -> do
   39                     modifyMVar_ var $ \case
   40                         Just a -> return (Just a)
   41                         Nothing -> fmap Just action
   42                     go
   43 
   44 -- | Create an empty cache.
   45 newCache :: IO (Cache a)
   46 newCache = do
   47     var <- newMVar Nothing
   48     return (Cache var)