    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE ViewPatterns #-}

    module Ormolu.Utils.IO
      ( findClosestFileSatisfying,
        Cache,
        newCache,
        withCache,
      )
    where

    import Control.Exception (catch, throwIO)
    import Control.Monad (void)
    import Control.Monad.IO.Class
    import Data.IORef
    import Data.Map.Lazy (Map)
    import Data.Map.Lazy qualified as M
    import System.Directory
    import System.FilePath
    import System.IO.Error (isDoesNotExistError)

    -- | Find the path to the closest file higher in the file hierarchy that
    -- satisfies a given predicate.
    findClosestFileSatisfying ::
      (MonadIO m) =>
      -- | The predicate that determines what we are looking for
      (FilePath -> Bool) ->
      -- | Path to the starting point for the search
      FilePath ->
      -- | Absolute path to the found file if available
      m (Maybe FilePath)
    findClosestFileSatisfying :: forall (m :: * -> *).
    MonadIO m =>
    (FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
    findClosestFileSatisfying FilePath -> Bool
    isRightFile FilePath
    rootOfSearch = IO (Maybe FilePath) -> m (Maybe FilePath)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe FilePath) -> m (Maybe FilePath))
    -> IO (Maybe FilePath) -> m (Maybe FilePath)
    forall a b. (a -> b) -> a -> b
    $ do
      parentDir <- FilePath -> FilePath
    takeDirectory (FilePath -> FilePath) -> IO FilePath -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO FilePath
    makeAbsolute FilePath
    rootOfSearch
      dirEntries <-
        listDirectory parentDir `catch` \case
          (IOError -> Bool
    isDoesNotExistError -> Bool
    True) -> [FilePath] -> IO [FilePath]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
          IOError
    e -> IOError -> IO [FilePath]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO IOError
    e
      let searchAtParentDirLevel = \case
            [] -> Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe FilePath
    forall a. Maybe a
    Nothing
            FilePath
    x : [FilePath]
    xs ->
              if FilePath -> Bool
    isRightFile FilePath
    x
                then
                  FilePath -> IO Bool
    doesFileExist (FilePath
    parentDir FilePath -> FilePath -> FilePath
    </> FilePath
    x) IO Bool -> (Bool -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                    Bool
    True -> Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    x)
                    Bool
    False -> [FilePath] -> IO (Maybe FilePath)
    searchAtParentDirLevel [FilePath]
    xs
                else [FilePath] -> IO (Maybe FilePath)
    searchAtParentDirLevel [FilePath]
    xs
      searchAtParentDirLevel dirEntries >>= \case
        Just FilePath
    foundFile -> Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe FilePath -> IO (Maybe FilePath))
    -> (FilePath -> Maybe FilePath) -> FilePath -> IO (Maybe FilePath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> IO (Maybe FilePath))
    -> FilePath -> IO (Maybe FilePath)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    parentDir FilePath -> FilePath -> FilePath
    </> FilePath
    foundFile
        Maybe FilePath
    Nothing ->
          if FilePath -> Bool
    isDrive FilePath
    parentDir
            then Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe FilePath
    forall a. Maybe a
    Nothing
            else (FilePath -> Bool) -> FilePath -> IO (Maybe FilePath)
    forall (m :: * -> *).
    MonadIO m =>
    (FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
    findClosestFileSatisfying FilePath -> Bool
    isRightFile FilePath
    parentDir

    newtype Cache k v = Cache (IORef (Map k v))

    newCache :: (Ord k) => IO (Cache k v)
    newCache :: forall k v. Ord k => IO (Cache k v)
    newCache = do
      var <- Map k v -> IO (IORef (Map k v))
    forall a. a -> IO (IORef a)
    newIORef Map k v
    forall a. Monoid a => a
    mempty
      pure (Cache var)

    -- | Execute an 'IO' action but only if the given key is not found in the
    -- cache.
    withCache :: (Ord k) => Cache k v -> k -> IO v -> IO v
    withCache :: forall k v. Ord k => Cache k v -> k -> IO v -> IO v
    withCache (Cache IORef (Map k v)
    cacheVar) k
    k IO v
    action = do
      cache <- IORef (Map k v) -> IO (Map k v)
    forall a. IORef a -> IO a
    readIORef IORef (Map k v)
    cacheVar
      case M.lookup k cache of
        Just v
    v -> v -> IO v
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure v
    v
        Maybe v
    Nothing -> do
          v <- IO v
    action
          void $ atomicModifyIORef cacheVar (pure . M.insert k v)
          pure v