    {-# 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)

    -- | Attempt to locate and parse an @.ormolu@ file. If it does not exist,
    -- default fixity map and module reexports are returned. This function
    -- maintains a cache of fixity overrides and module re-exports where cabal
    -- file paths act as keys.
    getDotOrmoluForSourceFile ::
      (MonadIO m) =>
      -- | 'CabalInfo' already obtained for this source file
      FilePath ->
      m (FixityOverrides, ModuleReexports)
    getDotOrmoluForSourceFile :: forall (m :: * -> *).
    MonadIO m =>
    FilePath -> m (FixityOverrides, ModuleReexports)
    getDotOrmoluForSourceFile FilePath
    sourceFile =
      IO (Maybe FilePath) -> m (Maybe FilePath)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FilePath -> IO (Maybe FilePath)
    forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
    findDotOrmoluFile FilePath
    sourceFile) m (Maybe FilePath)
    -> (Maybe FilePath -> m (FixityOverrides, ModuleReexports))
    -> m (FixityOverrides, ModuleReexports)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just FilePath
    dotOrmoluFile -> IO (FixityOverrides, ModuleReexports)
    -> m (FixityOverrides, ModuleReexports)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (FixityOverrides, ModuleReexports)
     -> m (FixityOverrides, ModuleReexports))
    -> IO (FixityOverrides, ModuleReexports)
    -> m (FixityOverrides, ModuleReexports)
    forall a b. (a -> b) -> a -> b
    $ IORef (Map FilePath (FixityOverrides, ModuleReexports))
    -> FilePath
    -> IO (FixityOverrides, ModuleReexports)
    -> IO (FixityOverrides, ModuleReexports)
    forall k v. Ord k => IORef (Map k v) -> k -> IO v -> IO v
    withIORefCache IORef (Map FilePath (FixityOverrides, ModuleReexports))
    cacheRef FilePath
    dotOrmoluFile (IO (FixityOverrides, ModuleReexports)
     -> IO (FixityOverrides, ModuleReexports))
    -> IO (FixityOverrides, ModuleReexports)
    -> IO (FixityOverrides, ModuleReexports)
    forall a b. (a -> b) -> a -> b
    $ do
          FilePath
    dotOrmoluRelative <- FilePath -> IO FilePath
    makeRelativeToCurrentDirectory FilePath
    dotOrmoluFile
          Text
    contents <- FilePath -> IO Text
    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 ->
              OrmoluException -> IO (FixityOverrides, ModuleReexports)
    forall e a. Exception e => e -> IO a
    throwIO (ParseErrorBundle Text Void -> OrmoluException
    OrmoluFixityOverridesParseError ParseErrorBundle Text Void
    errorBundle)
            Right (FixityOverrides, ModuleReexports)
    x -> (FixityOverrides, ModuleReexports)
    -> IO (FixityOverrides, ModuleReexports)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FixityOverrides, ModuleReexports)
    x
        Maybe FilePath
    Nothing -> (FixityOverrides, ModuleReexports)
    -> m (FixityOverrides, ModuleReexports)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FixityOverrides
    defaultFixityOverrides, ModuleReexports
    defaultModuleReexports)

    -- | Find the path to an appropriate @.ormolu@ file for a Haskell source
    -- file, if available.
    findDotOrmoluFile ::
      (MonadIO m) =>
      -- | Path to a Haskell source file
      FilePath ->
      -- | Absolute path to the closest @.ormolu@ file, if available
      m (Maybe FilePath)
    findDotOrmoluFile :: forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
    findDotOrmoluFile = (FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
    forall (m :: * -> *).
    MonadIO m =>
    (FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
    findClosestFileSatisfying ((FilePath -> Bool) -> FilePath -> m (Maybe FilePath))
    -> (FilePath -> Bool) -> FilePath -> m (Maybe FilePath)
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    x ->
      FilePath
    x FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    ".ormolu"

    -- | Cache ref that maps names of @.ormolu@ files to their contents.
    cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))
    cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))
    cacheRef = IO (IORef (Map FilePath (FixityOverrides, ModuleReexports)))
    -> IORef (Map FilePath (FixityOverrides, ModuleReexports))
    forall a. IO a -> a
    unsafePerformIO (Map FilePath (FixityOverrides, ModuleReexports)
    -> IO (IORef (Map FilePath (FixityOverrides, ModuleReexports)))
    forall a. a -> IO (IORef a)
    newIORef Map FilePath (FixityOverrides, ModuleReexports)
    forall k a. Map k a
    Map.empty)
    {-# NOINLINE cacheRef #-}

    -- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity
    -- definitions.
    parseFixityDeclarationStr ::
      -- | Input to parse
      String ->
      -- | Parse result
      Either String [(OpName, FixityInfo)]
    parseFixityDeclarationStr :: FilePath -> Either FilePath [(OpName, FixityInfo)]
    parseFixityDeclarationStr =
      (ParseErrorBundle Text Void -> FilePath)
    -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
    -> Either FilePath [(OpName, FixityInfo)]
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ParseErrorBundle Text Void -> FilePath
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> FilePath
    errorBundlePretty (Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
     -> Either FilePath [(OpName, FixityInfo)])
    -> (FilePath
        -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)])
    -> FilePath
    -> Either FilePath [(OpName, FixityInfo)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
    parseFixityDeclaration (Text
     -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)])
    -> (FilePath -> Text)
    -> FilePath
    -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text
    T.pack

    -- | A wrapper around 'parseModuleReexportDeclaration' for parsing
    -- a individual module reexport.
    parseModuleReexportDeclarationStr ::
      -- | Input to parse
      String ->
      -- | Parse result
      Either String (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    parseModuleReexportDeclarationStr :: FilePath
    -> Either
         FilePath (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    parseModuleReexportDeclarationStr =
      (ParseErrorBundle Text Void -> FilePath)
    -> Either
         (ParseErrorBundle Text Void)
         (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    -> Either
         FilePath (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ParseErrorBundle Text Void -> FilePath
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> FilePath
    errorBundlePretty (Either
       (ParseErrorBundle Text Void)
       (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
     -> Either
          FilePath (ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
    -> (FilePath
        -> Either
             (ParseErrorBundle Text Void)
             (ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
    -> FilePath
    -> Either
         FilePath (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text
    -> Either
         (ParseErrorBundle Text Void)
         (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    parseModuleReexportDeclaration (Text
     -> Either
          (ParseErrorBundle Text Void)
          (ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
    -> (FilePath -> Text)
    -> FilePath
    -> Either
         (ParseErrorBundle Text Void)
         (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text
    T.pack