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

-- | Write 'Text' to files using UTF8 and ignoring native
-- line ending conventions.
module Ormolu.Utils.IO
  ( writeFileUtf8,
    readFileUtf8,
    getContentsUtf8,
    findClosestFileSatisfying,
    withIORefCache,
  )
where

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

-- | Write a 'Text' to a file using UTF8 and ignoring native
-- line ending conventions.
writeFileUtf8 :: (MonadIO m) => FilePath -> Text -> m ()
writeFileUtf8 :: forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
p = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> IO ()
B.writeFile FilePath
p (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

-- | Read an entire file strictly into a 'Text' using UTF8 and
-- ignoring native line ending conventions.
readFileUtf8 :: (MonadIO m) => FilePath -> m Text
readFileUtf8 :: forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
p = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
B.readFile FilePath
p) m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m Text
forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeUtf8

-- | Read stdin as UTF8-encoded 'Text' value.
getContentsUtf8 :: (MonadIO m) => m Text
getContentsUtf8 :: forall (m :: * -> *). MonadIO m => m Text
getContentsUtf8 = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
B.getContents m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m Text
forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeUtf8

-- | A helper function for decoding a strict 'ByteString' into 'Text'. It is
-- strict and fails immediately if decoding encounters a problem.
decodeUtf8 :: (MonadIO m) => ByteString -> m Text
decodeUtf8 :: forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeUtf8 = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text)
-> (ByteString -> IO Text) -> ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnicodeException -> IO Text)
-> (Text -> IO Text) -> Either UnicodeException Text -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UnicodeException -> IO Text
forall e a. Exception e => e -> IO a
throwIO Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnicodeException Text -> IO Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TE.decodeUtf8'

-- | 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
  FilePath
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
  [FilePath]
dirEntries <-
    FilePath -> IO [FilePath]
listDirectory FilePath
parentDir IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`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. Exception e => e -> IO a
throwIO IOError
e
  let searchAtParentDirLevel :: [FilePath] -> IO (Maybe FilePath)
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
  [FilePath] -> IO (Maybe FilePath)
searchAtParentDirLevel [FilePath]
dirEntries IO (Maybe FilePath)
-> (Maybe FilePath -> 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
    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

-- | Execute an 'IO' action but only if the given key is not found in the
-- 'IORef' cache.
withIORefCache :: (Ord k) => IORef (Map k v) -> k -> IO v -> IO v
withIORefCache :: forall k v. Ord k => IORef (Map k v) -> k -> IO v -> IO v
withIORefCache IORef (Map k v)
cacheRef k
k IO v
action = do
  Map k v
cache <- IORef (Map k v) -> IO (Map k v)
forall a. IORef a -> IO a
readIORef IORef (Map k v)
cacheRef
  case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k v
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
v <- IO v
action
      IORef (Map k v) -> (Map k v -> Map k v) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map k v)
cacheRef (k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k v
v)
      v -> IO v
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v