{-# LANGUAGE BlockArguments #-}
module HLint.Plugin.Settings
(
argsSettings
) where
import Control.Concurrent.MVar (MVar)
import Data.IORef (IORef)
import Data.Map (Map)
import Language.Haskell.HLint (Classify, Hint, ParseFlags)
import qualified Control.Concurrent.MVar as MVar
import qualified Data.IORef as IORef
import qualified Data.Map as Map
import qualified Language.Haskell.HLint as HLint
import qualified System.IO.Unsafe as Unsafe
cache :: IORef (Map [String] (IO (ParseFlags, [Classify], Hint)))
cache :: IORef (Map [String] (IO (ParseFlags, [Classify], Hint)))
cache = IO (IORef (Map [String] (IO (ParseFlags, [Classify], Hint))))
-> IORef (Map [String] (IO (ParseFlags, [Classify], Hint)))
forall a. IO a -> a
Unsafe.unsafePerformIO (Map [String] (IO (ParseFlags, [Classify], Hint))
-> IO (IORef (Map [String] (IO (ParseFlags, [Classify], Hint))))
forall a. a -> IO (IORef a)
IORef.newIORef Map [String] (IO (ParseFlags, [Classify], Hint))
forall k a. Map k a
Map.empty)
{-# NOINLINE cache #-}
semaphore :: MVar ()
semaphore :: MVar ()
semaphore = IO (MVar ()) -> MVar ()
forall a. IO a -> a
Unsafe.unsafePerformIO (() -> IO (MVar ())
forall a. a -> IO (MVar a)
MVar.newMVar ())
{-# NOINLINE semaphore #-}
argsSettings
:: [String]
-> IO (ParseFlags, [Classify], Hint)
argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint)
argsSettings [String]
key = do
IO (ParseFlags, [Classify], Hint)
io <- IORef (Map [String] (IO (ParseFlags, [Classify], Hint)))
-> (Map [String] (IO (ParseFlags, [Classify], Hint))
-> (Map [String] (IO (ParseFlags, [Classify], Hint)),
IO (ParseFlags, [Classify], Hint)))
-> IO (IO (ParseFlags, [Classify], Hint))
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef (Map [String] (IO (ParseFlags, [Classify], Hint)))
cache \Map [String] (IO (ParseFlags, [Classify], Hint))
m -> do
case [String]
-> Map [String] (IO (ParseFlags, [Classify], Hint))
-> Maybe (IO (ParseFlags, [Classify], Hint))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [String]
key Map [String] (IO (ParseFlags, [Classify], Hint))
m of
Maybe (IO (ParseFlags, [Classify], Hint))
Nothing -> do
let io :: IO (ParseFlags, [Classify], Hint)
io =
IO (ParseFlags, [Classify], Hint)
-> IO (ParseFlags, [Classify], Hint)
forall a. IO a -> IO a
Unsafe.unsafeInterleaveIO do
MVar ()
-> (() -> IO (ParseFlags, [Classify], Hint))
-> IO (ParseFlags, [Classify], Hint)
forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar ()
semaphore \()
_ -> [String] -> IO (ParseFlags, [Classify], Hint)
HLint.argsSettings [String]
key
([String]
-> IO (ParseFlags, [Classify], Hint)
-> Map [String] (IO (ParseFlags, [Classify], Hint))
-> Map [String] (IO (ParseFlags, [Classify], Hint))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [String]
key IO (ParseFlags, [Classify], Hint)
io Map [String] (IO (ParseFlags, [Classify], Hint))
m, IO (ParseFlags, [Classify], Hint)
io)
Just IO (ParseFlags, [Classify], Hint)
io ->
(Map [String] (IO (ParseFlags, [Classify], Hint))
m, IO (ParseFlags, [Classify], Hint)
io)
IO (ParseFlags, [Classify], Hint)
io