{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}

-- | a monad that collects warnings, outputs, etc,
module LintWriter where

import           Control.Monad.Trans.Maybe  ()
import           Control.Monad.Writer       (MonadWriter (tell), WriterT,
                                             runWriterT)
import           Data.Aeson                 (ToJSON (toJSON))
import           Data.Text                  (Text)

import           Control.Monad.Trans.Reader (Reader, runReader)
import           Data.Maybe                 (mapMaybe)
import           Types
import GHC.Generics (Generic)

-- | a monad to collect hints, with some context
type LintWriter ctxt = WriterT [Lint] (Reader ctxt) ()

-- wrapped to allow for manual writing of Aeson instances
type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint])
newtype LintResult ctxt = LintResult (LintResult' ctxt)

data LayerContext = LayerContext ()
  deriving (Generic, ToJSON)

-- better, less confusing serialisation of an Either Hint (a, [Hint]).
-- Note that Left hint is also serialised as a list to make the resulting
-- json schema more regular.
instance ToJSON a => ToJSON (LintResult a) where
  toJSON (LintResult res) = toJSON $ snd res

lintToDep :: Lint -> Maybe Dep
lintToDep = \case
  Depends dep -> Just dep
  _           -> Nothing

resultToDeps :: LintResult a -> [Dep]
resultToDeps (LintResult a) = mapMaybe lintToDep $ snd a

-- | convert a lint result into a flat list of lints
-- (throwing away information on if a single error was fatal)
resultToLints :: LintResult a -> [Lint]
resultToLints (LintResult res) = snd res

-- | run a linter
runLintWriter :: ctxt -> LintWriter ctxt -> LintResult ctxt
runLintWriter c linter =  LintResult (c, lints)
  where lints = snd $ flip runReader c $ runWriterT linter

-- | write a hint into the LintWriter monad
lint :: Level -> Text -> LintWriter a
lint level = tell . (: []) . hint level

dependsOn :: Dep -> LintWriter a
dependsOn dep = tell . (: []) $ Depends dep


info = lint Info
suggest = lint Suggestion
warn = lint Warning
forbid = lint Forbidden
complain = lint Error