{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
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)
writeFileUtf8 :: (MonadIO m) => FilePath -> Text -> m ()
writeFileUtf8 :: forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> IO ()
B.writeFile FilePath
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
readFileUtf8 :: (MonadIO m) => FilePath -> m Text
readFileUtf8 :: forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
B.readFile FilePath
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeUtf8
getContentsUtf8 :: (MonadIO m) => m Text
getContentsUtf8 :: forall (m :: * -> *). MonadIO m => m Text
getContentsUtf8 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
B.getContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeUtf8
decodeUtf8 :: (MonadIO m) => ByteString -> m Text
decodeUtf8 :: forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeUtf8 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TE.decodeUtf8'
findClosestFileSatisfying ::
(MonadIO m) =>
(FilePath -> Bool) ->
FilePath ->
m (Maybe FilePath)
findClosestFileSatisfying :: forall (m :: * -> *).
MonadIO m =>
(FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
findClosestFileSatisfying FilePath -> Bool
isRightFile FilePath
rootOfSearch = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath
parentDir <- FilePath -> FilePath
takeDirectory 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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \case
(IOError -> Bool
isDoesNotExistError -> Bool
True) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
IOError
e -> forall e a. Exception e => e -> IO a
throwIO IOError
e
let searchAtParentDirLevel :: [FilePath] -> IO (Maybe FilePath)
searchAtParentDirLevel = \case
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
foundFile -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
parentDir FilePath -> FilePath -> FilePath
</> FilePath
foundFile
Maybe FilePath
Nothing ->
if FilePath -> Bool
isDrive FilePath
parentDir
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (m :: * -> *).
MonadIO m =>
(FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
findClosestFileSatisfying FilePath -> Bool
isRightFile FilePath
parentDir
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 <- forall a. IORef a -> IO a
readIORef IORef (Map k v)
cacheRef
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k v
cache of
Just v
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
Maybe v
Nothing -> do
v
v <- IO v
action
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map k v)
cacheRef (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k v
v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v