{-# LANGUAGE RecordWildCards #-}

module Ormolu.Utils.Fixity
  ( getFixityOverridesForSourceFile,
    parseFixityDeclarationStr,
  )
where

import Control.Exception (throwIO)
import Control.Monad.IO.Class
import Data.Bifunctor (first)
import Data.IORef
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Ormolu.Exception
import Ormolu.Fixity
import Ormolu.Fixity.Parser
import Ormolu.Utils.Cabal
import Ormolu.Utils.IO (readFileUtf8)
import System.Directory
import System.FilePath
import System.IO.Unsafe (unsafePerformIO)
import Text.Megaparsec (errorBundlePretty)

-- | Cache ref that stores fixity overrides per cabal file.
cacheRef :: IORef (Map FilePath FixityMap)
cacheRef :: IORef (Map FilePath FixityMap)
cacheRef = IO (IORef (Map FilePath FixityMap))
-> IORef (Map FilePath FixityMap)
forall a. IO a -> a
unsafePerformIO (Map FilePath FixityMap -> IO (IORef (Map FilePath FixityMap))
forall a. a -> IO (IORef a)
newIORef Map FilePath FixityMap
forall k a. Map k a
Map.empty)
{-# NOINLINE cacheRef #-}

-- | Attempt to locate and parse a @.ormolu@ file. If it does not exist,
-- empty fixity map is returned. This function maintains a cache of fixity
-- overrides where cabal file paths act as keys.
getFixityOverridesForSourceFile ::
  MonadIO m =>
  -- | 'CabalInfo' already obtained for this source file
  CabalInfo ->
  m FixityMap
getFixityOverridesForSourceFile :: CabalInfo -> m FixityMap
getFixityOverridesForSourceFile CabalInfo {[DynOption]
Maybe FilePath
Set FilePath
ciCabalFilePath :: CabalInfo -> Maybe FilePath
ciDependencies :: CabalInfo -> Set FilePath
ciDynOpts :: CabalInfo -> [DynOption]
ciPackageName :: CabalInfo -> Maybe FilePath
ciCabalFilePath :: Maybe FilePath
ciDependencies :: Set FilePath
ciDynOpts :: [DynOption]
ciPackageName :: Maybe FilePath
..} = IO FixityMap -> m FixityMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FixityMap -> m FixityMap) -> IO FixityMap -> m FixityMap
forall a b. (a -> b) -> a -> b
$ do
  case Maybe FilePath
ciCabalFilePath of
    Maybe FilePath
Nothing -> FixityMap -> IO FixityMap
forall (m :: * -> *) a. Monad m => a -> m a
return FixityMap
forall k a. Map k a
Map.empty
    Just FilePath
cabalPath -> do
      Map FilePath FixityMap
cache <- IORef (Map FilePath FixityMap) -> IO (Map FilePath FixityMap)
forall a. IORef a -> IO a
readIORef IORef (Map FilePath FixityMap)
cacheRef
      case FilePath -> Map FilePath FixityMap -> Maybe FixityMap
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
cabalPath Map FilePath FixityMap
cache of
        Maybe FixityMap
Nothing -> do
          let dotOrmolu :: FilePath
dotOrmolu = FilePath -> FilePath -> FilePath
replaceFileName FilePath
cabalPath FilePath
".ormolu"
          Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
dotOrmolu
          if Bool
exists
            then do
              FilePath
dotOrmoluRelative <- FilePath -> IO FilePath
makeRelativeToCurrentDirectory FilePath
dotOrmolu
              Text
contents <- FilePath -> IO Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
dotOrmolu
              case FilePath -> Text -> Either (ParseErrorBundle Text Void) FixityMap
parseFixityMap FilePath
dotOrmoluRelative Text
contents of
                Left ParseErrorBundle Text Void
errorBundle ->
                  OrmoluException -> IO FixityMap
forall e a. Exception e => e -> IO a
throwIO (ParseErrorBundle Text Void -> OrmoluException
OrmoluFixityOverridesParseError ParseErrorBundle Text Void
errorBundle)
                Right FixityMap
x -> do
                  IORef (Map FilePath FixityMap)
-> (Map FilePath FixityMap -> Map FilePath FixityMap) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map FilePath FixityMap)
cacheRef (FilePath
-> FixityMap -> Map FilePath FixityMap -> Map FilePath FixityMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
cabalPath FixityMap
x)
                  FixityMap -> IO FixityMap
forall (m :: * -> *) a. Monad m => a -> m a
return FixityMap
x
            else FixityMap -> IO FixityMap
forall (m :: * -> *) a. Monad m => a -> m a
return FixityMap
forall k a. Map k a
Map.empty
        Just FixityMap
x -> FixityMap -> IO FixityMap
forall (m :: * -> *) a. Monad m => a -> m a
return FixityMap
x

-- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity
-- definitions.
parseFixityDeclarationStr ::
  -- | Input to parse
  String ->
  -- | Parse result
  Either String [(String, FixityInfo)]
parseFixityDeclarationStr :: FilePath -> Either FilePath [(FilePath, FixityInfo)]
parseFixityDeclarationStr =
  (ParseErrorBundle Text Void -> FilePath)
-> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)]
-> Either FilePath [(FilePath, FixityInfo)]
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) [(FilePath, FixityInfo)]
 -> Either FilePath [(FilePath, FixityInfo)])
-> (FilePath
    -> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)])
-> FilePath
-> Either FilePath [(FilePath, FixityInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)]
parseFixityDeclaration (Text
 -> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)])
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack