content: {-# LANGUAGE BangPatterns               #-}
  {-# LANGUAGE CPP                        #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE RecordWildCards            #-}
  {-# LANGUAGE TemplateHaskell            #-}
  -- | Classifying messages by severity and filtering them.
  module Language.Haskell.Homplexity.Message (
      Log
    , Message
    , Severity (..)
    , severityOptions
    , critical
    , warn
    , info
    , debug
    , message
    , extract
    ) where
  
  import           Control.Arrow
  import           Control.DeepSeq
  import           Data.Foldable                      as Foldable
  import           Data.Function                      (on)
  #if __GLASGOW_HASKELL__ >= 800
  import           Data.Semigroup                     (Semigroup (..))
  #else
  import           Data.Monoid
  #endif
  import           Data.Sequence                      as Seq
  import           HFlags
  import           Language.Haskell.Exts              hiding (style)
  import           Language.Haskell.TH.Syntax         (Lift (..))
  #ifdef HTML_OUTPUT
  import           Prelude                            hiding (div, head, id, span)
  import           Text.Blaze.Html4.Strict            hiding (map, style)
  import           Text.Blaze.Html4.Strict.Attributes hiding (span, title)
  --import           Text.Blaze.Renderer.Utf8           (renderMarkup)
  #endif
  
  -- | Keeps a set of messages
  newtype Log = Log { unLog :: Seq Message }
    deriving(Monoid
  #if __GLASGOW_HASKELL__ >= 800
            ,Semigroup
  #endif
                      )
  
  instance NFData Log where
    rnf = rnf . unLog
  
  -- | Message from analysis
  data Message = Message { msgSeverity :: !Severity
                         , msgText     :: !String
                         , msgSrc      :: !SrcLoc
                         }
    deriving (Eq)
  
  instance NFData Message where
    rnf Message {msgSrc=SrcLoc{..},..} =
      rnf msgSeverity `seq` rnf msgText `seq`
      rnf srcFilename `seq` rnf srcLine `seq` rnf srcColumn
  
  instance Show Message where
    showsPrec _ Message {msgSrc=loc@SrcLoc{..}, ..} = shows msgSeverity
                                                    . (':':)
                                                    . (srcFilename++)
                                                    . (':':)
                                                    . shows loc
                                                    -- . shows srcLine
                                                    -- . shows srcColumn
                                                    . (": "++)
                                                    . (msgText++)
                                                    . ('\n':)
  
  #ifdef HTML_OUTPUT
  instance ToMarkup Message where
    toMarkup Message {msgSrc=SrcLoc{..}, ..} =
      p ! classId $
       (toMarkup msgSeverity
         <> string ": "
         <> (a ! href (toValue srcFilename) $ (string srcFilename))
         <> string ": "
         <> string msgText)
      where
        classId = case msgSeverity of
                       Debug    -> class_ "debug"
                       Info     -> class_ "info"
                       Warning  -> class_ "warning"
                       Critical -> class_ "critical"
  
  instance ToMarkup Severity where
    toMarkup Debug    = span   ! class_ "severity" $ string (show Debug)
    toMarkup Info     = span   ! class_ "severity" $ string (show Info)
    toMarkup Warning  = strong ! class_ "severity" $ string (show Warning)
    toMarkup Critical = strong ! class_ "severity" $ string (show Critical)
  #endif
  
  -- | Message severity
  data Severity = Debug
                | Info
                | Warning
                | Critical
    deriving (Eq, Ord, Read, Show, Enum, Bounded)
  
  instance NFData Severity where
    rnf !_a = ()
  
  -- | String showing all possible values for @Severity@.
  severityOptions :: String
  severityOptions  = unwords $ map show [minBound..(maxBound::Severity)]
  
  instance Lift Severity where
    lift Debug    = [| Debug    |]
    lift Info     = [| Info     |]
    lift Warning  = [| Warning  |]
    lift Critical = [| Critical |]
  
  instance FlagType Severity where
    defineFlag n v = defineEQFlag n [| v :: Severity |] "{Debug|Info|Warning|Critical}"
  
  -- | Helper for logging a message with given severity.
  message ::  Severity -> SrcLoc -> String -> Log
  message msgSeverity msgSrc msgText = Log $ Seq.singleton Message {..}
  
  -- | TODO: automatic inference of the srcLine
  -- | Log a certain error
  critical :: SrcLoc -> String -> Log
  critical  = message Critical
  
  -- | Log a warning
  warn  ::  SrcLoc -> String -> Log
  warn   = message Warning
  
  -- | Log informational message
  info  ::  SrcLoc -> String -> Log
  info   = message Info
  
  -- | Log debugging message
  debug ::  SrcLoc -> String -> Log
  debug  = message Debug
  
  -- TODO: check if this is not too slow
  msgOrdering ::  Message -> Message -> Ordering
  msgOrdering = compare `on` ((srcFilename &&& srcLine) . msgSrc)
  
  -- | Convert @Log@ into ordered sequence (@Seq@).
  orderedMessages                  :: Severity -> Log -> Seq Message
  orderedMessages severity Log {..} = Seq.unstableSortBy         msgOrdering  $
                                        Seq.filter ((severity<=) . msgSeverity)   unLog
  
  -- | Extract an ordered sequence of messages from the @Log@.
  extract ::  Severity -> Log -> [Message]
  extract severity = Foldable.toList
                   . orderedMessages severity
  
  instance Show Log where
    showsPrec _ l e = Foldable.foldr  shows e $
                      orderedMessages Debug l
  