module Splint.Settings where

import qualified Control.Concurrent.STM as Stm
import qualified Control.Exception as Exception
import qualified Data.Map as Map
import qualified Language.Haskell.HLint as HLint
import qualified Splint.RemoteData as RemoteData
import qualified System.IO.Unsafe as Unsafe

type Settings = (HLint.ParseFlags, [HLint.Classify], HLint.Hint)

-- | Getting settings is not instantaneous. Since settings are usually reused
-- between modules, it makes sense to cache them. However each module can
-- potentially customize its settings using the @OPTIONS_GHC@ pragma. This
-- variable is used as a cache of settings keyed on the command line options.
cache
  :: Stm.TVar
       (Map.Map [String] (RemoteData.RemoteData Exception.IOException Settings))
cache :: TVar (Map [String] (RemoteData IOException Settings))
cache = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TVar a)
Stm.newTVarIO forall k a. Map k a
Map.empty
{-# NOINLINE cache #-}

-- | Even though we cache settings based on command line options, we only want
-- to load settings one at a time. Practically this is to work around a bug in
-- GHC. But aside from that, loading settings calls @withArgs@ and doing that
-- simultaneously in separate threads is dubious.
-- <https://gitlab.haskell.org/ghc/ghc/issues/18261>
semaphore :: Stm.TMVar ()
semaphore :: TMVar ()
semaphore = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TMVar a)
Stm.newTMVarIO ()
{-# NOINLINE semaphore #-}

withTMVar :: Stm.TMVar a -> (a -> IO b) -> IO b
withTMVar :: forall a b. TMVar a -> (a -> IO b) -> IO b
withTMVar TMVar a
x = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket
  (forall a. STM a -> IO a
Stm.atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
Stm.takeTMVar TMVar a
x)
  (forall a. STM a -> IO a
Stm.atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TMVar a -> a -> STM ()
Stm.putTMVar TMVar a
x)

load :: [String] -> IO Settings
load :: [String] -> IO Settings
load [String]
commandLineOptions = do
  RemoteData IOException Settings
remoteData <- forall a. STM a -> IO a
Stm.atomically forall a b. (a -> b) -> a -> b
$ do
    Map [String] (RemoteData IOException Settings)
settings <- forall a. TVar a -> STM a
Stm.readTVar TVar (Map [String] (RemoteData IOException Settings))
cache
    let
      remoteData :: RemoteData IOException Settings
remoteData =
        forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall e a. RemoteData e a
RemoteData.NotAsked [String]
commandLineOptions Map [String] (RemoteData IOException Settings)
settings
    case RemoteData IOException Settings
remoteData of
      RemoteData IOException Settings
RemoteData.NotAsked ->
        forall a. TVar a -> (a -> a) -> STM ()
Stm.modifyTVar TVar (Map [String] (RemoteData IOException Settings))
cache forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [String]
commandLineOptions forall e a. RemoteData e a
RemoteData.Loading
      RemoteData IOException Settings
RemoteData.Loading -> forall a. STM a
Stm.retry
      RemoteData IOException Settings
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteData IOException Settings
remoteData
  case RemoteData IOException Settings
remoteData of
    RemoteData IOException Settings
RemoteData.NotAsked -> forall a b. TMVar a -> (a -> IO b) -> IO b
withTMVar TMVar ()
semaphore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
      Either IOException Settings
result <- forall e a. Exception e => IO a -> IO (Either e a)
Exception.try forall a b. (a -> b) -> a -> b
$ [String] -> IO Settings
HLint.argsSettings [String]
commandLineOptions
      case Either IOException Settings
result of
        Left IOException
ioException -> do
          forall a. STM a -> IO a
Stm.atomically
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> (a -> a) -> STM ()
Stm.modifyTVar TVar (Map [String] (RemoteData IOException Settings))
cache
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [String]
commandLineOptions
            forall a b. (a -> b) -> a -> b
$ forall e a. e -> RemoteData e a
RemoteData.Failure IOException
ioException
          forall e a. Exception e => e -> IO a
Exception.throwIO IOException
ioException
        Right Settings
settings -> do
          forall a. STM a -> IO a
Stm.atomically
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> (a -> a) -> STM ()
Stm.modifyTVar TVar (Map [String] (RemoteData IOException Settings))
cache
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [String]
commandLineOptions
            forall a b. (a -> b) -> a -> b
$ forall e a. a -> RemoteData e a
RemoteData.Success Settings
settings
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Settings
settings
    RemoteData IOException Settings
RemoteData.Loading -> [String] -> IO Settings
load [String]
commandLineOptions
    RemoteData.Failure IOException
ioException -> forall e a. Exception e => e -> IO a
Exception.throwIO IOException
ioException
    RemoteData.Success Settings
settings -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Settings
settings