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

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

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

import           Data.Maybe                (mapMaybe)
import           Types

-- | a monad to collect hints. If it yields Left, then the
-- map is flawed in some fundamental way which prevented us
-- from getting any hints at all except whatever broke it
type LintWriter a = WriterT [Lint] (Either Lint) a

-- this is wrapped in a newtype because Aeson is silly and wants
-- to serialise Either as { "Right" : … } or { "Left" : … } ...
type LintResult' a = Either Lint (a, [Lint])
newtype LintResult a = LintResult (LintResult' a)

-- 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 r) = toJson' r
    where toJson' (Left hint)        = toJSON [hint]
          toJson' (Right (_, hints)) = toJSON hints

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

lintResultToDeps :: LintResult a -> [Dep]
lintResultToDeps (LintResult a) = case a of
  Left (Depends dep) -> [dep]
  Left _             -> []
  Right (_, lints)   -> mapMaybe lintToDep lints

-- | 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) = case res of
  Left l           -> [l]
  Right (_, lints) -> lints

-- | Confusingly, this returns lints, not a …
runLintWriter :: LintWriter a -> [Lint]
runLintWriter = resultToLints . LintResult . runWriterT

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

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

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



-- TODO: all these functions should probably also just operate on LintWriter

-- | converts a Maybe to an Either, with a default value for Left
unwrap :: b -> Maybe a  -> Either b a
unwrap hint maybe = case maybe of
  Just a  -> Right a
  Nothing -> Left hint

-- | unwrap and produce a warning if the value was Nothing
unwrapWarn :: Text -> Maybe a -> Either Lint a
unwrapWarn msg = unwrap $ hint Warning msg

-- | same as unwrapWarn, but for booleans
assertWarn :: Text -> Bool -> LintWriter ()
assertWarn msg cond = lift $ if cond then Right () else Left $ hint Warning msg