{-# LANGUAGE LambdaCase #-}

module ImportStylePlugin.Yaml where

import Control.Monad.IO.Class (MonadIO (..))
import Data.Functor (($>))
import Data.String (IsString (..))
import Data.Yaml (decodeFileEither, prettyPrintParseException)
import qualified GHC.Plugins as Ghc
import ImportStylePlugin (importPlugin)
import ImportStylePlugin.Compat (report)
import ImportStylePlugin.Config (Severity (..))

plugin :: Ghc.Plugin
plugin :: Plugin
plugin =
  Plugin
Ghc.defaultPlugin
    { Ghc.typeCheckResultAction = \[CommandLineOption]
opts ModSummary
_ TcGblEnv
a -> do
        case [CommandLineOption]
opts of
          [CommandLineOption
filepath] -> do
            IO (Either ParseException ImportsStyle)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Either ParseException ImportsStyle)
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CommandLineOption -> IO (Either ParseException ImportsStyle)
forall a.
FromJSON a =>
CommandLineOption -> IO (Either ParseException a)
decodeFileEither CommandLineOption
filepath) IOEnv (Env TcGblEnv TcLclEnv) (Either ParseException ImportsStyle)
-> (Either ParseException ImportsStyle -> TcM TcGblEnv)
-> TcM TcGblEnv
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> (a -> IOEnv (Env TcGblEnv TcLclEnv) b)
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Right ImportsStyle
style -> ImportsStyle -> TcGblEnv -> TcM TcGblEnv
importPlugin ImportsStyle
style TcGblEnv
a
              Left ParseException
err -> Severity -> SDoc -> Maybe SrcSpan -> TcRn ()
report Severity
Warning (CommandLineOption -> SDoc
forall a. IsString a => CommandLineOption -> a
fromString (CommandLineOption -> SDoc) -> CommandLineOption -> SDoc
forall a b. (a -> b) -> a -> b
$ ParseException -> CommandLineOption
prettyPrintParseException ParseException
err) Maybe SrcSpan
forall a. Maybe a
Nothing TcRn () -> TcGblEnv -> TcM TcGblEnv
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TcGblEnv
a
          [CommandLineOption]
_ -> TcGblEnv -> TcM TcGblEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TcGblEnv
a
    }