{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFoldable #-}
module Internal.Types
  ( ModuleFile
  , Warning(..)
  , showWarning
  , MonoidMap(..)
  , SrcSpanKey
  , WarningsWithModDate(..)
  ) where

import qualified Data.Map.Strict as M
import           Data.Ord (comparing)
import qualified Data.Set as S
import           Data.Time

import qualified Internal.GhcFacade as Ghc

type ModuleFile = String

newtype Warning = Warning
  { Warning -> MsgEnvelope DecoratedSDoc
unWarning
#if MIN_VERSION_ghc(9,4,0)
      :: Ghc.MsgEnvelope Ghc.DiagnosticMessage
#elif MIN_VERSION_ghc(9,2,0)
      :: Ghc.MsgEnvelope Ghc.DecoratedSDoc
#else
      :: Ghc.WarnMsg
#endif
  }

showWarning :: Warning -> String
showWarning :: Warning -> String
showWarning =
#if MIN_VERSION_ghc(9,4,0)
  let sdocCtx = Ghc.defaultSDocContext
              { Ghc.sdocPrintUnicodeSyntax = True
              , Ghc.sdocCanUseUnicode = True
              }
   in foldMap (Ghc.showSDocOneLine sdocCtx)
      . Ghc.unDecorated
#if MIN_VERSION_ghc(9,6,0)
      . Ghc.diagnosticMessage Ghc.NoDiagnosticOpts
#else
      . Ghc.diagnosticMessage
#endif
      . Ghc.errMsgDiagnostic . unWarning
#elif MIN_VERSION_ghc(9,2,0)
  let sdocCtx :: SDocContext
sdocCtx = SDocContext
Ghc.defaultSDocContext
              { sdocPrintUnicodeSyntax :: Bool
Ghc.sdocPrintUnicodeSyntax = Bool
True
              , sdocCanUseUnicode :: Bool
Ghc.sdocCanUseUnicode = Bool
True
              }
   in forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SDocContext -> SDoc -> String
Ghc.showSDocOneLine SDocContext
sdocCtx)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoratedSDoc -> [SDoc]
Ghc.unDecorated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. MsgEnvelope e -> e
Ghc.errMsgDiagnostic forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warning -> MsgEnvelope DecoratedSDoc
unWarning
#else
  show . unWarning
#endif

instance Eq Warning where
  Warning MsgEnvelope DecoratedSDoc
a == :: Warning -> Warning -> Bool
== Warning MsgEnvelope DecoratedSDoc
b = forall a. Show a => a -> String
show MsgEnvelope DecoratedSDoc
a forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> String
show MsgEnvelope DecoratedSDoc
b

instance Ord Warning where
  compare :: Warning -> Warning -> Ordering
compare = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warning -> MsgEnvelope DecoratedSDoc
unWarning)

newtype MonoidMap k a = MonoidMap (M.Map k a)
  deriving forall a. MonoidMap k a -> Bool
forall k a. Eq a => a -> MonoidMap k a -> Bool
forall k a. Num a => MonoidMap k a -> a
forall k a. Ord a => MonoidMap k a -> a
forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k m. Monoid m => MonoidMap k m -> m
forall k a. MonoidMap k a -> Bool
forall k a. MonoidMap k a -> Int
forall k a. MonoidMap k a -> [a]
forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall k a. (a -> a -> a) -> MonoidMap k a -> a
forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => MonoidMap k a -> a
$cproduct :: forall k a. Num a => MonoidMap k a -> a
sum :: forall a. Num a => MonoidMap k a -> a
$csum :: forall k a. Num a => MonoidMap k a -> a
minimum :: forall a. Ord a => MonoidMap k a -> a
$cminimum :: forall k a. Ord a => MonoidMap k a -> a
maximum :: forall a. Ord a => MonoidMap k a -> a
$cmaximum :: forall k a. Ord a => MonoidMap k a -> a
elem :: forall a. Eq a => a -> MonoidMap k a -> Bool
$celem :: forall k a. Eq a => a -> MonoidMap k a -> Bool
length :: forall a. MonoidMap k a -> Int
$clength :: forall k a. MonoidMap k a -> Int
null :: forall a. MonoidMap k a -> Bool
$cnull :: forall k a. MonoidMap k a -> Bool
toList :: forall a. MonoidMap k a -> [a]
$ctoList :: forall k a. MonoidMap k a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MonoidMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldr1 :: forall a. (a -> a -> a) -> MonoidMap k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
fold :: forall m. Monoid m => MonoidMap k m -> m
$cfold :: forall k m. Monoid m => MonoidMap k m -> m
Foldable

instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where
  MonoidMap Map k a
a <> :: MonoidMap k a -> MonoidMap k a -> MonoidMap k a
<> MonoidMap Map k a
b = forall k a. Map k a -> MonoidMap k a
MonoidMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map k a
a Map k a
b

instance (Ord k, Semigroup a) => Monoid (MonoidMap k a) where
  mempty :: MonoidMap k a
mempty = forall k a. Map k a -> MonoidMap k a
MonoidMap forall k a. Map k a
M.empty

type SrcSpanKey = (Ghc.RealSrcLoc, Ghc.RealSrcLoc) -- start and end of span

data WarningsWithModDate =
  MkWarningsWithModDate
    { WarningsWithModDate -> UTCTime
lastUpdated :: !UTCTime -- Last time the module was modified
    , WarningsWithModDate -> MonoidMap SrcSpanKey (Set Warning)
warningsMap :: !(MonoidMap SrcSpanKey (S.Set Warning))
    }

instance Semigroup WarningsWithModDate where
  WarningsWithModDate
a <> :: WarningsWithModDate -> WarningsWithModDate -> WarningsWithModDate
<> WarningsWithModDate
b = UTCTime
-> MonoidMap SrcSpanKey (Set Warning) -> WarningsWithModDate
MkWarningsWithModDate
             (forall a. Ord a => a -> a -> a
max (WarningsWithModDate -> UTCTime
lastUpdated WarningsWithModDate
a) (WarningsWithModDate -> UTCTime
lastUpdated WarningsWithModDate
b))
             (WarningsWithModDate -> MonoidMap SrcSpanKey (Set Warning)
warningsMap WarningsWithModDate
a forall a. Semigroup a => a -> a -> a
<> WarningsWithModDate -> MonoidMap SrcSpanKey (Set Warning)
warningsMap WarningsWithModDate
b)