{-# LANGUAGE LambdaCase #-}
module Ormolu.Utils.Fixity
( getDotOrmoluForSourceFile,
parseFixityDeclarationStr,
parseModuleReexportDeclarationStr,
)
where
import Control.Exception (throwIO)
import Control.Monad.IO.Class
import Data.Bifunctor (first)
import Data.IORef
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Distribution.ModuleName (ModuleName)
import Distribution.Types.PackageName (PackageName)
import Ormolu.Exception
import Ormolu.Fixity
import Ormolu.Fixity.Parser
import Ormolu.Utils.IO (findClosestFileSatisfying, readFileUtf8, withIORefCache)
import System.Directory
import System.IO.Unsafe (unsafePerformIO)
import Text.Megaparsec (errorBundlePretty)
getDotOrmoluForSourceFile ::
(MonadIO m) =>
FilePath ->
m (FixityOverrides, ModuleReexports)
getDotOrmoluForSourceFile :: forall (m :: * -> *).
MonadIO m =>
FilePath -> m (FixityOverrides, ModuleReexports)
getDotOrmoluForSourceFile FilePath
sourceFile =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findDotOrmoluFile FilePath
sourceFile) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
dotOrmoluFile -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => IORef (Map k v) -> k -> IO v -> IO v
withIORefCache IORef (Map FilePath (FixityOverrides, ModuleReexports))
cacheRef FilePath
dotOrmoluFile forall a b. (a -> b) -> a -> b
$ do
FilePath
dotOrmoluRelative <- FilePath -> IO FilePath
makeRelativeToCurrentDirectory FilePath
dotOrmoluFile
Text
contents <- forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
dotOrmoluFile
case FilePath
-> Text
-> Either
(ParseErrorBundle Text Void) (FixityOverrides, ModuleReexports)
parseDotOrmolu FilePath
dotOrmoluRelative Text
contents of
Left ParseErrorBundle Text Void
errorBundle ->
forall e a. Exception e => e -> IO a
throwIO (ParseErrorBundle Text Void -> OrmoluException
OrmoluFixityOverridesParseError ParseErrorBundle Text Void
errorBundle)
Right (FixityOverrides, ModuleReexports)
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (FixityOverrides, ModuleReexports)
x
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (FixityOverrides
defaultFixityOverrides, ModuleReexports
defaultModuleReexports)
findDotOrmoluFile ::
(MonadIO m) =>
FilePath ->
m (Maybe FilePath)
findDotOrmoluFile :: forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findDotOrmoluFile = forall (m :: * -> *).
MonadIO m =>
(FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
findClosestFileSatisfying forall a b. (a -> b) -> a -> b
$ \FilePath
x ->
FilePath
x forall a. Eq a => a -> a -> Bool
== FilePath
".ormolu"
cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))
cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))
cacheRef = forall a. IO a -> a
unsafePerformIO (forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty)
{-# NOINLINE cacheRef #-}
parseFixityDeclarationStr ::
String ->
Either String [(OpName, FixityInfo)]
parseFixityDeclarationStr :: FilePath -> Either FilePath [(OpName, FixityInfo)]
parseFixityDeclarationStr =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
parseFixityDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
parseModuleReexportDeclarationStr ::
String ->
Either String (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
parseModuleReexportDeclarationStr :: FilePath
-> Either
FilePath (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
parseModuleReexportDeclarationStr =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either
(ParseErrorBundle Text Void)
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
parseModuleReexportDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack