{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

{-# OPTIONS_GHC -Wall            #-}

{- |
Module      :  Camfort.Analysis
Description :  Analysis on fortran files.
Copyright   :  (c) 2017, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish
License     :  Apache-2.0

Maintainer  :  dom.orchard@gmail.com
Stability   :  experimental

This module defines the 'AnalysisT' monad transformer, which encapsulates common
functionality for analyses:

- Logging via the 'MonadLogger' class
- Early exit via 'failAnalysis' or 'failAnalysis\''
- Error recovery via 'catchAnalysisT' or 'loggingAnalysisError'
- Providing access to the analysis environment via 'analysisModFiles'

-}

module Camfort.Analysis
  (
  -- * Analysis monad
    AnalysisT
  , PureAnalysis
  -- * Combinators
  , mapAnalysisT
  , generalizePureAnalysis
  , MonadAnalysis(..)
  , failAnalysis'
  , catchAnalysisT
  , loggingAnalysisError
  , analysisLiftLogger
  -- * Analysis results
  , AnalysisResult(..)
  , _ARFailure
  , _ARSuccess
  , AnalysisReport(..)
  , arMessages
  , arResult
  , describeReport
  , putDescribeReport
  -- * Running analyses
  , runAnalysisT
  -- * Logging
  -- | See "Camfort.Analysis.Logger" for more detailed documentation.

  , MonadLogger
    ( logError
    , logError'
    , logWarn
    , logWarn'
    , logInfo
    , logInfo'
    , logInfoNoOrigin
    , logDebug
    , logDebug'
    )
  -- ** Message origins
  , Origin(..)
  , atSpanned
  , atSpannedInFile
  -- ** Log outputs
  , LogOutput
  , logOutputStd
  , logOutputNone
  -- ** Log levels
  , LogLevel(..)
  -- ** 'Describe' class
  , Describe(..)
  , describeShow
  , (<>)

  -- ** Exit Code of reports
  , ExitCodeOfReport(..)
  ) where

import           Control.Monad.Except
import           Control.Monad.Morph
import           Control.Monad.Reader
import           Control.Monad.RWS
import qualified Control.Monad.State            as Lazy
import           Control.Monad.State.Strict
import           Control.Monad.Writer
import           Control.Monad.Fail
import           Control.DeepSeq
import           GHC.Generics                   (Generic)

import           Control.Lens

import qualified Data.Text.Lazy                 as Lazy
import qualified Data.Text.Lazy.Builder         as Builder
import qualified Data.Text.Lazy.IO              as Lazy
import           Data.List (maximumBy)
import           Data.Ord (comparing)

import qualified Language.Fortran.Util.ModFile  as F
import qualified Language.Fortran.Util.Position as F

import           Camfort.Analysis.Logger

--------------------------------------------------------------------------------
--  Analysis Monad
--------------------------------------------------------------------------------

-- | The analysis monad transformer. Will usually be based on 'Identity' (see
-- 'PureAnalysis') or 'IO'.
--
-- Has error messages of type @e@ and warnings of type @w@.
newtype AnalysisT e w m a =
  AnalysisT
  { AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
getAnalysisT ::
      ExceptT (LogMessage e) (ReaderT F.ModFiles (LoggerT e w m)) a
  }
  deriving
    ( a -> AnalysisT e w m b -> AnalysisT e w m a
(a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
(forall a b. (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b)
-> (forall a b. a -> AnalysisT e w m b -> AnalysisT e w m a)
-> Functor (AnalysisT e w m)
forall a b. a -> AnalysisT e w m b -> AnalysisT e w m a
forall a b. (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
forall e w (m :: * -> *) a b.
Functor m =>
a -> AnalysisT e w m b -> AnalysisT e w m a
forall e w (m :: * -> *) a b.
Functor m =>
(a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AnalysisT e w m b -> AnalysisT e w m a
$c<$ :: forall e w (m :: * -> *) a b.
Functor m =>
a -> AnalysisT e w m b -> AnalysisT e w m a
fmap :: (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
$cfmap :: forall e w (m :: * -> *) a b.
Functor m =>
(a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
Functor
    , Functor (AnalysisT e w m)
a -> AnalysisT e w m a
Functor (AnalysisT e w m)
-> (forall a. a -> AnalysisT e w m a)
-> (forall a b.
    AnalysisT e w m (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b)
-> (forall a b c.
    (a -> b -> c)
    -> AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m c)
-> (forall a b.
    AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b)
-> (forall a b.
    AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m a)
-> Applicative (AnalysisT e w m)
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m a
AnalysisT e w m (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
(a -> b -> c)
-> AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m c
forall a. a -> AnalysisT e w m a
forall a b.
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m a
forall a b.
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
forall a b.
AnalysisT e w m (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
forall a b c.
(a -> b -> c)
-> AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m c
forall e w (m :: * -> *). Monad m => Functor (AnalysisT e w m)
forall e w (m :: * -> *) a. Monad m => a -> AnalysisT e w m a
forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m a
forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
forall e w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m a
$c<* :: forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m a
*> :: AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
$c*> :: forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
liftA2 :: (a -> b -> c)
-> AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m c
$cliftA2 :: forall e w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m c
<*> :: AnalysisT e w m (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
$c<*> :: forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m (a -> b) -> AnalysisT e w m a -> AnalysisT e w m b
pure :: a -> AnalysisT e w m a
$cpure :: forall e w (m :: * -> *) a. Monad m => a -> AnalysisT e w m a
$cp1Applicative :: forall e w (m :: * -> *). Monad m => Functor (AnalysisT e w m)
Applicative
    , Applicative (AnalysisT e w m)
a -> AnalysisT e w m a
Applicative (AnalysisT e w m)
-> (forall a b.
    AnalysisT e w m a -> (a -> AnalysisT e w m b) -> AnalysisT e w m b)
-> (forall a b.
    AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b)
-> (forall a. a -> AnalysisT e w m a)
-> Monad (AnalysisT e w m)
AnalysisT e w m a -> (a -> AnalysisT e w m b) -> AnalysisT e w m b
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
forall a. a -> AnalysisT e w m a
forall a b.
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
forall a b.
AnalysisT e w m a -> (a -> AnalysisT e w m b) -> AnalysisT e w m b
forall e w (m :: * -> *). Monad m => Applicative (AnalysisT e w m)
forall e w (m :: * -> *) a. Monad m => a -> AnalysisT e w m a
forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> (a -> AnalysisT e w m b) -> AnalysisT e w m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> AnalysisT e w m a
$creturn :: forall e w (m :: * -> *) a. Monad m => a -> AnalysisT e w m a
>> :: AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
$c>> :: forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> AnalysisT e w m b -> AnalysisT e w m b
>>= :: AnalysisT e w m a -> (a -> AnalysisT e w m b) -> AnalysisT e w m b
$c>>= :: forall e w (m :: * -> *) a b.
Monad m =>
AnalysisT e w m a -> (a -> AnalysisT e w m b) -> AnalysisT e w m b
$cp1Monad :: forall e w (m :: * -> *). Monad m => Applicative (AnalysisT e w m)
Monad
    , Monad (AnalysisT e w m)
Monad (AnalysisT e w m)
-> (forall a. IO a -> AnalysisT e w m a)
-> MonadIO (AnalysisT e w m)
IO a -> AnalysisT e w m a
forall a. IO a -> AnalysisT e w m a
forall e w (m :: * -> *). MonadIO m => Monad (AnalysisT e w m)
forall e w (m :: * -> *) a. MonadIO m => IO a -> AnalysisT e w m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> AnalysisT e w m a
$cliftIO :: forall e w (m :: * -> *) a. MonadIO m => IO a -> AnalysisT e w m a
$cp1MonadIO :: forall e w (m :: * -> *). MonadIO m => Monad (AnalysisT e w m)
MonadIO
    , MonadState s
    , MonadWriter w'
    , MonadLogger e w
    , Monad (AnalysisT e w m)
Monad (AnalysisT e w m)
-> (forall a. FilePath -> AnalysisT e w m a)
-> MonadFail (AnalysisT e w m)
FilePath -> AnalysisT e w m a
forall a. FilePath -> AnalysisT e w m a
forall e w (m :: * -> *). MonadFail m => Monad (AnalysisT e w m)
forall e w (m :: * -> *) a.
MonadFail m =>
FilePath -> AnalysisT e w m a
forall (m :: * -> *).
Monad m -> (forall a. FilePath -> m a) -> MonadFail m
fail :: FilePath -> AnalysisT e w m a
$cfail :: forall e w (m :: * -> *) a.
MonadFail m =>
FilePath -> AnalysisT e w m a
$cp1MonadFail :: forall e w (m :: * -> *). MonadFail m => Monad (AnalysisT e w m)
MonadFail
    )

-- | A pure analysis computation which cannot do any 'IO'.
type PureAnalysis e w = AnalysisT e w Identity

instance MonadTrans (AnalysisT e w) where
  lift :: m a -> AnalysisT e w m a
lift = ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> AnalysisT e w m a)
-> (m a
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> m a
-> AnalysisT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ModFiles (LoggerT e w m) a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ModFiles (LoggerT e w m) a
 -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> (m a -> ReaderT ModFiles (LoggerT e w m) a)
-> m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerT e w m a -> ReaderT ModFiles (LoggerT e w m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggerT e w m a -> ReaderT ModFiles (LoggerT e w m) a)
-> (m a -> LoggerT e w m a)
-> m a
-> ReaderT ModFiles (LoggerT e w m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> LoggerT e w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | As per the 'MFunctor' instance for 'LoggerT', a hoisted analysis cannot
-- output logs on the fly.
instance MFunctor (AnalysisT e w) where
  hoist :: (forall a. m a -> n a) -> AnalysisT e w m b -> AnalysisT e w n b
hoist forall a. m a -> n a
f (AnalysisT ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) b
x) = ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w n)) b
-> AnalysisT e w n b
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT ((forall a.
 ReaderT ModFiles (LoggerT e w m) a
 -> ReaderT ModFiles (LoggerT e w n) a)
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) b
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w n)) b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. LoggerT e w m a -> LoggerT e w n a)
-> ReaderT ModFiles (LoggerT e w m) a
-> ReaderT ModFiles (LoggerT e w n) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a) -> LoggerT e w m a -> LoggerT e w n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f)) ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) b
x)

instance MonadError e' m => MonadError e' (AnalysisT e w m) where
  throwError :: e' -> AnalysisT e w m a
throwError = m a -> AnalysisT e w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AnalysisT e w m a)
-> (e' -> m a) -> e' -> AnalysisT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: AnalysisT e w m a -> (e' -> AnalysisT e w m a) -> AnalysisT e w m a
catchError AnalysisT e w m a
action e' -> AnalysisT e w m a
handle = ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> AnalysisT e w m a)
-> (ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> AnalysisT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
 -> AnalysisT e w m a)
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> AnalysisT e w m a
forall a b. (a -> b) -> a -> b
$
    let run :: AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
run = ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a))
-> (AnalysisT e w m a
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
getAnalysisT
    in ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> (e'
    -> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a))
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
run AnalysisT e w m a
action) (AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
run (AnalysisT e w m a
 -> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a))
-> (e' -> AnalysisT e w m a)
-> e'
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> AnalysisT e w m a
handle)

instance MonadReader r m => MonadReader r (AnalysisT e w m) where
  ask :: AnalysisT e w m r
ask = m r -> AnalysisT e w m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask

  local :: (r -> r) -> AnalysisT e w m a -> AnalysisT e w m a
local r -> r
f (AnalysisT (ExceptT (ReaderT ModFiles -> LoggerT e w m (Either (LogMessage e) a)
k))) =
    ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> AnalysisT e w m a)
-> ((ModFiles -> LoggerT e w m (Either (LogMessage e) a))
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> (ModFiles -> LoggerT e w m (Either (LogMessage e) a))
-> AnalysisT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
 -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> ((ModFiles -> LoggerT e w m (Either (LogMessage e) a))
    -> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a))
-> (ModFiles -> LoggerT e w m (Either (LogMessage e) a))
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFiles -> LoggerT e w m (Either (LogMessage e) a))
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((ModFiles -> LoggerT e w m (Either (LogMessage e) a))
 -> AnalysisT e w m a)
-> (ModFiles -> LoggerT e w m (Either (LogMessage e) a))
-> AnalysisT e w m a
forall a b. (a -> b) -> a -> b
$ (r -> r)
-> LoggerT e w m (Either (LogMessage e) a)
-> LoggerT e w m (Either (LogMessage e) a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (LoggerT e w m (Either (LogMessage e) a)
 -> LoggerT e w m (Either (LogMessage e) a))
-> (ModFiles -> LoggerT e w m (Either (LogMessage e) a))
-> ModFiles
-> LoggerT e w m (Either (LogMessage e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModFiles -> LoggerT e w m (Either (LogMessage e) a)
k

--------------------------------------------------------------------------------
--  Liftable functions
--------------------------------------------------------------------------------

class (MonadLogger e w m) => MonadAnalysis e w m where
  -- | Report a critical error in the analysis at a particular source location
  -- and exit early.
  failAnalysis :: Origin -> e -> m a

  -- | Get the 'F.ModFiles' from the analysis environment.
  analysisModFiles :: m F.ModFiles

  default failAnalysis
    :: (MonadTrans t, MonadAnalysis e w m', m ~ t m') => Origin -> e -> m a

  default analysisModFiles
    :: (MonadTrans t, MonadAnalysis e w m', m ~ t m') => m F.ModFiles

  failAnalysis Origin
o = m' a -> t m' a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' a -> t m' a) -> (e -> m' a) -> e -> t m' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin -> e -> m' a
forall e w (m :: * -> *) a.
MonadAnalysis e w m =>
Origin -> e -> m a
failAnalysis Origin
o
  analysisModFiles = m' ModFiles -> t m' ModFiles
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' ModFiles
forall e w (m :: * -> *). MonadAnalysis e w m => m ModFiles
analysisModFiles

instance (Describe e, Describe w, Monad m) => MonadAnalysis e w (AnalysisT e w m) where
  analysisModFiles :: AnalysisT e w m ModFiles
analysisModFiles = ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) ModFiles
-> AnalysisT e w m ModFiles
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) ModFiles
forall r (m :: * -> *). MonadReader r m => m r
ask

  failAnalysis :: Origin -> e -> AnalysisT e w m a
failAnalysis Origin
origin e
e = do
    let msg :: LogMessage e
msg = Maybe Origin -> e -> LogMessage e
forall a1. Maybe Origin -> a1 -> LogMessage a1
LogMessage (Origin -> Maybe Origin
forall a. a -> Maybe a
Just Origin
origin) e
e
    ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (LogMessage e
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError LogMessage e
msg)

instance MonadAnalysis e w m => MonadAnalysis e w (ReaderT r m)
instance MonadAnalysis e w m => MonadAnalysis e w (ExceptT e' m)
instance MonadAnalysis e w m => MonadAnalysis e w (StateT s m)
instance (MonadAnalysis e w m, Monoid w') => MonadAnalysis e w (WriterT w' m)
instance MonadAnalysis e w m => MonadAnalysis e w (Lazy.StateT s m)
instance (MonadAnalysis e w m, Monoid w') => MonadAnalysis e w (RWST r w' s m)

--------------------------------------------------------------------------------
--  Combinators
--------------------------------------------------------------------------------

-- | Change the error and warning types in an analysis. To change the
-- underlying monad use 'hoist'.
mapAnalysisT :: (Monad m) => (e -> e') -> (w -> w') -> AnalysisT e w m a -> AnalysisT e' w' m a
mapAnalysisT :: (e -> e') -> (w -> w') -> AnalysisT e w m a -> AnalysisT e' w' m a
mapAnalysisT e -> e'
mapError w -> w'
mapWarn =
  ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a
-> AnalysisT e' w' m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a
 -> AnalysisT e' w' m a)
-> (AnalysisT e w m a
    -> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a)
-> AnalysisT e w m a
-> AnalysisT e' w' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((forall a.
 ReaderT ModFiles (LoggerT e w m) a
 -> ReaderT ModFiles (LoggerT e' w' m) a)
-> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e w m)) a
-> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. LoggerT e w m a -> LoggerT e' w' m a)
-> ReaderT ModFiles (LoggerT e w m) a
-> ReaderT ModFiles (LoggerT e' w' m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((e -> e') -> (w -> w') -> LoggerT e w m a -> LoggerT e' w' m a
forall (m :: * -> *) e e' w w' a.
Functor m =>
(e -> e') -> (w -> w') -> LoggerT e w m a -> LoggerT e' w' m a
mapLoggerT e -> e'
mapError w -> w'
mapWarn)) (ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e w m)) a
 -> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a)
-> (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
    -> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e w m)) a)
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMessage e -> LogMessage e')
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e w m)) a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (ASetter (LogMessage e) (LogMessage e') e e'
-> (e -> e') -> LogMessage e -> LogMessage e'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (LogMessage e) (LogMessage e') e e'
forall a1 a2. Lens (LogMessage a1) (LogMessage a2) a1 a2
lmMsg e -> e'
mapError)) (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a)
-> (AnalysisT e w m a
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> AnalysisT e w m a
-> ExceptT (LogMessage e') (ReaderT ModFiles (LoggerT e' w' m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
getAnalysisT

-- | Given a pure analysis action, it can be generalized to run in any 'Monad'.
-- Since the original analysis was pure, it could not have logged anything as it
-- ran. The new analysis cannot log anything as it runs either, even it is based
-- on 'IO'.
generalizePureAnalysis :: (Monad m) => PureAnalysis e w a -> AnalysisT e w m a
generalizePureAnalysis :: PureAnalysis e w a -> AnalysisT e w m a
generalizePureAnalysis = (forall a. Identity a -> m a)
-> PureAnalysis e w a -> AnalysisT e w m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. Identity a -> m a
forall (m :: * -> *) a. Monad m => Identity a -> m a
generalize

-- | Report a critical failure in the analysis at no particular source location
-- and exit early.
failAnalysis'
  :: (MonadAnalysis e w m, F.Spanned o)
  => o -> e -> m a
failAnalysis' :: o -> e -> m a
failAnalysis' o
originElem e
e = do
  Origin
origin <- o -> m Origin
forall e w (m :: * -> *) a.
(MonadLogger e w m, Spanned a) =>
a -> m Origin
atSpanned o
originElem
  Origin -> e -> m a
forall e w (m :: * -> *) a.
MonadAnalysis e w m =>
Origin -> e -> m a
failAnalysis Origin
origin e
e

-- | Run the given analysis and recover with the given handler function if it
-- fails.
catchAnalysisT
  :: (Monad m)
  => (LogMessage e -> AnalysisT e w m a) -> AnalysisT e w m a -> AnalysisT e w m a
catchAnalysisT :: (LogMessage e -> AnalysisT e w m a)
-> AnalysisT e w m a -> AnalysisT e w m a
catchAnalysisT LogMessage e -> AnalysisT e w m a
handle AnalysisT e w m a
action =
  ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> (LogMessage e
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
getAnalysisT AnalysisT e w m a
action) (AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
getAnalysisT (AnalysisT e w m a
 -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> (LogMessage e -> AnalysisT e w m a)
-> LogMessage e
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage e -> AnalysisT e w m a
handle))

-- | Run the given analysis. If it succeeds, return its result value. Otherwise,
-- log the error it creates and return 'Nothing'.
--
-- This allows errors in analysis sub-programs to be collected rather than
-- halting the entire analysis.
loggingAnalysisError
  :: (Monad m, Describe w, Describe e)
  => AnalysisT e w m a -> AnalysisT e w m (Maybe a)
loggingAnalysisError :: AnalysisT e w m a -> AnalysisT e w m (Maybe a)
loggingAnalysisError =
  (LogMessage e -> AnalysisT e w m (Maybe a))
-> AnalysisT e w m (Maybe a) -> AnalysisT e w m (Maybe a)
forall (m :: * -> *) e w a.
Monad m =>
(LogMessage e -> AnalysisT e w m a)
-> AnalysisT e w m a -> AnalysisT e w m a
catchAnalysisT ( (() -> Maybe a) -> AnalysisT e w m () -> AnalysisT e w m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)
                 (AnalysisT e w m () -> AnalysisT e w m (Maybe a))
-> (LogMessage e -> AnalysisT e w m ())
-> LogMessage e
-> AnalysisT e w m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage e w -> AnalysisT e w m ()
forall e w (m :: * -> *).
MonadLogger e w m =>
SomeMessage e w -> m ()
recordLogMessage
                 (SomeMessage e w -> AnalysisT e w m ())
-> (LogMessage e -> SomeMessage e w)
-> LogMessage e
-> AnalysisT e w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage e -> SomeMessage e w
forall e w1. LogMessage e -> SomeMessage e w1
MsgError)
  (AnalysisT e w m (Maybe a) -> AnalysisT e w m (Maybe a))
-> (AnalysisT e w m a -> AnalysisT e w m (Maybe a))
-> AnalysisT e w m a
-> AnalysisT e w m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> AnalysisT e w m a -> AnalysisT e w m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just

-- | Given a logging computation, lift it into an analysis monad.
analysisLiftLogger
  :: (Monad m, Describe w, Describe e)
  => LoggerT e w m a -> AnalysisT e w m a
analysisLiftLogger :: LoggerT e w m a -> AnalysisT e w m a
analysisLiftLogger = ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
forall e w (m :: * -> *) a.
ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> AnalysisT e w m a
AnalysisT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> AnalysisT e w m a)
-> (LoggerT e w m a
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> LoggerT e w m a
-> AnalysisT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ModFiles (LoggerT e w m) a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ModFiles (LoggerT e w m) a
 -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> (LoggerT e w m a -> ReaderT ModFiles (LoggerT e w m) a)
-> LoggerT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerT e w m a -> ReaderT ModFiles (LoggerT e w m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

--------------------------------------------------------------------------------
--  Analysis Results
--------------------------------------------------------------------------------

data AnalysisResult e r
  = ARFailure Origin e
  | ARSuccess r
  deriving (Int -> AnalysisResult e r -> ShowS
[AnalysisResult e r] -> ShowS
AnalysisResult e r -> FilePath
(Int -> AnalysisResult e r -> ShowS)
-> (AnalysisResult e r -> FilePath)
-> ([AnalysisResult e r] -> ShowS)
-> Show (AnalysisResult e r)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall e r. (Show e, Show r) => Int -> AnalysisResult e r -> ShowS
forall e r. (Show e, Show r) => [AnalysisResult e r] -> ShowS
forall e r. (Show e, Show r) => AnalysisResult e r -> FilePath
showList :: [AnalysisResult e r] -> ShowS
$cshowList :: forall e r. (Show e, Show r) => [AnalysisResult e r] -> ShowS
show :: AnalysisResult e r -> FilePath
$cshow :: forall e r. (Show e, Show r) => AnalysisResult e r -> FilePath
showsPrec :: Int -> AnalysisResult e r -> ShowS
$cshowsPrec :: forall e r. (Show e, Show r) => Int -> AnalysisResult e r -> ShowS
Show, AnalysisResult e r -> AnalysisResult e r -> Bool
(AnalysisResult e r -> AnalysisResult e r -> Bool)
-> (AnalysisResult e r -> AnalysisResult e r -> Bool)
-> Eq (AnalysisResult e r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e r.
(Eq e, Eq r) =>
AnalysisResult e r -> AnalysisResult e r -> Bool
/= :: AnalysisResult e r -> AnalysisResult e r -> Bool
$c/= :: forall e r.
(Eq e, Eq r) =>
AnalysisResult e r -> AnalysisResult e r -> Bool
== :: AnalysisResult e r -> AnalysisResult e r -> Bool
$c== :: forall e r.
(Eq e, Eq r) =>
AnalysisResult e r -> AnalysisResult e r -> Bool
Eq, a -> AnalysisResult e b -> AnalysisResult e a
(a -> b) -> AnalysisResult e a -> AnalysisResult e b
(forall a b. (a -> b) -> AnalysisResult e a -> AnalysisResult e b)
-> (forall a b. a -> AnalysisResult e b -> AnalysisResult e a)
-> Functor (AnalysisResult e)
forall a b. a -> AnalysisResult e b -> AnalysisResult e a
forall a b. (a -> b) -> AnalysisResult e a -> AnalysisResult e b
forall e a b. a -> AnalysisResult e b -> AnalysisResult e a
forall e a b. (a -> b) -> AnalysisResult e a -> AnalysisResult e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AnalysisResult e b -> AnalysisResult e a
$c<$ :: forall e a b. a -> AnalysisResult e b -> AnalysisResult e a
fmap :: (a -> b) -> AnalysisResult e a -> AnalysisResult e b
$cfmap :: forall e a b. (a -> b) -> AnalysisResult e a -> AnalysisResult e b
Functor, (forall x. AnalysisResult e r -> Rep (AnalysisResult e r) x)
-> (forall x. Rep (AnalysisResult e r) x -> AnalysisResult e r)
-> Generic (AnalysisResult e r)
forall x. Rep (AnalysisResult e r) x -> AnalysisResult e r
forall x. AnalysisResult e r -> Rep (AnalysisResult e r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e r x. Rep (AnalysisResult e r) x -> AnalysisResult e r
forall e r x. AnalysisResult e r -> Rep (AnalysisResult e r) x
$cto :: forall e r x. Rep (AnalysisResult e r) x -> AnalysisResult e r
$cfrom :: forall e r x. AnalysisResult e r -> Rep (AnalysisResult e r) x
Generic)

makePrisms ''AnalysisResult

instance (NFData e, NFData r) => NFData (AnalysisResult e r)

-- | When an analysis is run, it produces a report consisting of the logs it
-- collect as it ran. In addition, it either fails at a certain location or
-- succeeds with a result value.
data AnalysisReport e w r =
  AnalysisReport
  { AnalysisReport e w r -> FilePath
_arSourceFile :: !FilePath
  , AnalysisReport e w r -> [SomeMessage e w]
_arMessages   :: ![SomeMessage e w]
  , AnalysisReport e w r -> AnalysisResult e r
_arResult     :: !(AnalysisResult e r)
  }
  deriving (Int -> AnalysisReport e w r -> ShowS
[AnalysisReport e w r] -> ShowS
AnalysisReport e w r -> FilePath
(Int -> AnalysisReport e w r -> ShowS)
-> (AnalysisReport e w r -> FilePath)
-> ([AnalysisReport e w r] -> ShowS)
-> Show (AnalysisReport e w r)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall e w r.
(Show e, Show w, Show r) =>
Int -> AnalysisReport e w r -> ShowS
forall e w r.
(Show e, Show w, Show r) =>
[AnalysisReport e w r] -> ShowS
forall e w r.
(Show e, Show w, Show r) =>
AnalysisReport e w r -> FilePath
showList :: [AnalysisReport e w r] -> ShowS
$cshowList :: forall e w r.
(Show e, Show w, Show r) =>
[AnalysisReport e w r] -> ShowS
show :: AnalysisReport e w r -> FilePath
$cshow :: forall e w r.
(Show e, Show w, Show r) =>
AnalysisReport e w r -> FilePath
showsPrec :: Int -> AnalysisReport e w r -> ShowS
$cshowsPrec :: forall e w r.
(Show e, Show w, Show r) =>
Int -> AnalysisReport e w r -> ShowS
Show, AnalysisReport e w r -> AnalysisReport e w r -> Bool
(AnalysisReport e w r -> AnalysisReport e w r -> Bool)
-> (AnalysisReport e w r -> AnalysisReport e w r -> Bool)
-> Eq (AnalysisReport e w r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e w r.
(Eq e, Eq w, Eq r) =>
AnalysisReport e w r -> AnalysisReport e w r -> Bool
/= :: AnalysisReport e w r -> AnalysisReport e w r -> Bool
$c/= :: forall e w r.
(Eq e, Eq w, Eq r) =>
AnalysisReport e w r -> AnalysisReport e w r -> Bool
== :: AnalysisReport e w r -> AnalysisReport e w r -> Bool
$c== :: forall e w r.
(Eq e, Eq w, Eq r) =>
AnalysisReport e w r -> AnalysisReport e w r -> Bool
Eq, a -> AnalysisReport e w b -> AnalysisReport e w a
(a -> b) -> AnalysisReport e w a -> AnalysisReport e w b
(forall a b.
 (a -> b) -> AnalysisReport e w a -> AnalysisReport e w b)
-> (forall a b. a -> AnalysisReport e w b -> AnalysisReport e w a)
-> Functor (AnalysisReport e w)
forall a b. a -> AnalysisReport e w b -> AnalysisReport e w a
forall a b.
(a -> b) -> AnalysisReport e w a -> AnalysisReport e w b
forall e w a b. a -> AnalysisReport e w b -> AnalysisReport e w a
forall e w a b.
(a -> b) -> AnalysisReport e w a -> AnalysisReport e w b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AnalysisReport e w b -> AnalysisReport e w a
$c<$ :: forall e w a b. a -> AnalysisReport e w b -> AnalysisReport e w a
fmap :: (a -> b) -> AnalysisReport e w a -> AnalysisReport e w b
$cfmap :: forall e w a b.
(a -> b) -> AnalysisReport e w a -> AnalysisReport e w b
Functor, (forall x. AnalysisReport e w r -> Rep (AnalysisReport e w r) x)
-> (forall x. Rep (AnalysisReport e w r) x -> AnalysisReport e w r)
-> Generic (AnalysisReport e w r)
forall x. Rep (AnalysisReport e w r) x -> AnalysisReport e w r
forall x. AnalysisReport e w r -> Rep (AnalysisReport e w r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e w r x.
Rep (AnalysisReport e w r) x -> AnalysisReport e w r
forall e w r x.
AnalysisReport e w r -> Rep (AnalysisReport e w r) x
$cto :: forall e w r x.
Rep (AnalysisReport e w r) x -> AnalysisReport e w r
$cfrom :: forall e w r x.
AnalysisReport e w r -> Rep (AnalysisReport e w r) x
Generic)

makeLenses ''AnalysisReport

instance (NFData e, NFData w, NFData r) => NFData (AnalysisReport e w r)

-- | Produce a human-readable version of an 'AnalysisReport', at the given
-- verbosity level. Giving 'Nothing' for the log level hides all logs.
describeReport
  :: (Describe e, Describe w, Describe r)
  => Text -> Maybe LogLevel -> AnalysisReport e w r -> Lazy.Text
describeReport :: Text -> Maybe LogLevel -> AnalysisReport e w r -> Text
describeReport Text
analysisName Maybe LogLevel
level AnalysisReport e w r
report = Builder -> Text
Builder.toLazyText (Builder -> Text)
-> (Writer Builder () -> Builder) -> Writer Builder () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer Builder () -> Builder
forall w a. Writer w a -> w
execWriter (Writer Builder () -> Text) -> Writer Builder () -> Text
forall a b. (a -> b) -> a -> b
$ do
  let describeMessage :: LogLevel -> SomeMessage e w -> m ()
describeMessage LogLevel
lvl SomeMessage e w
msg = do
        let tell' :: a -> m ()
tell' a
x = do
              Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
" -"
              a -> m ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tellDescribe a
x
              Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
"\n"
        case SomeMessage e w
msg of
          m :: SomeMessage e w
m@(MsgError LogMessage e
_) -> SomeMessage e w -> m ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tell' SomeMessage e w
m
          m :: SomeMessage e w
m@(MsgWarn  LogMessage w
_) | LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
LogWarn -> SomeMessage e w -> m ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tell' SomeMessage e w
m
          m :: SomeMessage e w
m@(MsgInfo  LogMessage Text
_) | LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
LogInfo -> SomeMessage e w -> m ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tell' SomeMessage e w
m
          m :: SomeMessage e w
m@(MsgDebug LogMessage Text
_) | LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
LogDebug -> SomeMessage e w -> m ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tell' SomeMessage e w
m
          SomeMessage e w
_              -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Output file name
  Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
"Finished running "
  Text -> Writer Builder ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tellDescribe Text
analysisName
  Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
" on input '"
  FilePath -> Writer Builder ()
forall (m :: * -> *) a.
(MonadWriter Builder m, Describe a) =>
a -> m ()
tellDescribe (AnalysisReport e w r
report AnalysisReport e w r
-> Getting FilePath (AnalysisReport e w r) FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath (AnalysisReport e w r) FilePath
forall e w r. Lens' (AnalysisReport e w r) FilePath
arSourceFile)
  Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
"' ...\n"

  -- Output logs if requested
  case Maybe LogLevel
level of
    Just LogLevel
lvl | Bool -> Bool
not ([SomeMessage e w] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AnalysisReport e w r
report AnalysisReport e w r
-> Getting
     [SomeMessage e w] (AnalysisReport e w r) [SomeMessage e w]
-> [SomeMessage e w]
forall s a. s -> Getting a s a -> a
^. Getting [SomeMessage e w] (AnalysisReport e w r) [SomeMessage e w]
forall e w r w.
Lens
  (AnalysisReport e w r)
  (AnalysisReport e w r)
  [SomeMessage e w]
  [SomeMessage e w]
arMessages)) -> do
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Writer Builder ()) -> Builder -> Writer Builder ()
forall a b. (a -> b) -> a -> b
$ Builder
"Logs:\n"
      [SomeMessage e w]
-> (SomeMessage e w -> Writer Builder ()) -> Writer Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (AnalysisReport e w r
report AnalysisReport e w r
-> Getting
     [SomeMessage e w] (AnalysisReport e w r) [SomeMessage e w]
-> [SomeMessage e w]
forall s a. s -> Getting a s a -> a
^. Getting [SomeMessage e w] (AnalysisReport e w r) [SomeMessage e w]
forall e w r w.
Lens
  (AnalysisReport e w r)
  (AnalysisReport e w r)
  [SomeMessage e w]
  [SomeMessage e w]
arMessages) (LogLevel -> SomeMessage e w -> Writer Builder ()
forall (m :: * -> *) e w.
(MonadWriter Builder m, Describe e, Describe w) =>
LogLevel -> SomeMessage e w -> m ()
describeMessage LogLevel
lvl)
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
"\n"
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
"Result... "
    Maybe LogLevel
_ -> () -> Writer Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  let loggedWarnings :: (LogMessage w -> Const Any (LogMessage w))
-> AnalysisReport e w r -> Const Any (AnalysisReport e w r)
loggedWarnings = ([SomeMessage e w] -> Const Any [SomeMessage e w])
-> AnalysisReport e w r -> Const Any (AnalysisReport e w r)
forall e w r w.
Lens
  (AnalysisReport e w r)
  (AnalysisReport e w r)
  [SomeMessage e w]
  [SomeMessage e w]
arMessages (([SomeMessage e w] -> Const Any [SomeMessage e w])
 -> AnalysisReport e w r -> Const Any (AnalysisReport e w r))
-> ((LogMessage w -> Const Any (LogMessage w))
    -> [SomeMessage e w] -> Const Any [SomeMessage e w])
-> (LogMessage w -> Const Any (LogMessage w))
-> AnalysisReport e w r
-> Const Any (AnalysisReport e w r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage e w -> Const Any (SomeMessage e w))
-> [SomeMessage e w] -> Const Any [SomeMessage e w]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((SomeMessage e w -> Const Any (SomeMessage e w))
 -> [SomeMessage e w] -> Const Any [SomeMessage e w])
-> ((LogMessage w -> Const Any (LogMessage w))
    -> SomeMessage e w -> Const Any (SomeMessage e w))
-> (LogMessage w -> Const Any (LogMessage w))
-> [SomeMessage e w]
-> Const Any [SomeMessage e w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMessage w -> Const Any (LogMessage w))
-> SomeMessage e w -> Const Any (SomeMessage e w)
forall e w1 w2.
Prism
  (SomeMessage e w2)
  (SomeMessage e w1)
  (LogMessage w2)
  (LogMessage w1)
_MsgWarn
      loggedErrors :: (LogMessage e -> Const Any (LogMessage e))
-> AnalysisReport e w r -> Const Any (AnalysisReport e w r)
loggedErrors = ([SomeMessage e w] -> Const Any [SomeMessage e w])
-> AnalysisReport e w r -> Const Any (AnalysisReport e w r)
forall e w r w.
Lens
  (AnalysisReport e w r)
  (AnalysisReport e w r)
  [SomeMessage e w]
  [SomeMessage e w]
arMessages (([SomeMessage e w] -> Const Any [SomeMessage e w])
 -> AnalysisReport e w r -> Const Any (AnalysisReport e w r))
-> ((LogMessage e -> Const Any (LogMessage e))
    -> [SomeMessage e w] -> Const Any [SomeMessage e w])
-> (LogMessage e -> Const Any (LogMessage e))
-> AnalysisReport e w r
-> Const Any (AnalysisReport e w r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage e w -> Const Any (SomeMessage e w))
-> [SomeMessage e w] -> Const Any [SomeMessage e w]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((SomeMessage e w -> Const Any (SomeMessage e w))
 -> [SomeMessage e w] -> Const Any [SomeMessage e w])
-> ((LogMessage e -> Const Any (LogMessage e))
    -> SomeMessage e w -> Const Any (SomeMessage e w))
-> (LogMessage e -> Const Any (LogMessage e))
-> [SomeMessage e w]
-> Const Any [SomeMessage e w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMessage e -> Const Any (LogMessage e))
-> SomeMessage e w -> Const Any (SomeMessage e w)
forall e w1 e2.
Prism
  (SomeMessage e2 w1)
  (SomeMessage e w1)
  (LogMessage e2)
  (LogMessage e)
_MsgError

      hadErrors :: Bool
hadErrors = Getting Any (AnalysisReport e w r) (LogMessage e)
-> AnalysisReport e w r -> Bool
forall s a. Getting Any s a -> s -> Bool
notNullOf Getting Any (AnalysisReport e w r) (LogMessage e)
forall e w r.
(LogMessage e -> Const Any (LogMessage e))
-> AnalysisReport e w r -> Const Any (AnalysisReport e w r)
loggedErrors AnalysisReport e w r
report
      hadWarnings :: Bool
hadWarnings = Getting Any (AnalysisReport e w r) (LogMessage w)
-> AnalysisReport e w r -> Bool
forall s a. Getting Any s a -> s -> Bool
notNullOf Getting Any (AnalysisReport e w r) (LogMessage w)
forall w w e r.
(LogMessage w -> Const Any (LogMessage w))
-> AnalysisReport e w r -> Const Any (AnalysisReport e w r)
loggedWarnings AnalysisReport e w r
report

  case AnalysisReport e w r
report AnalysisReport e w r
-> Getting
     (AnalysisResult e r) (AnalysisReport e w r) (AnalysisResult e r)
-> AnalysisResult e r
forall s a. s -> Getting a s a -> a
^. Getting
  (AnalysisResult e r) (AnalysisReport e w r) (AnalysisResult e r)
forall e w r r.
Lens
  (AnalysisReport e w r)
  (AnalysisReport e w r)
  (AnalysisResult e r)
  (AnalysisResult e r)
arResult of
    ARFailure Origin
origin e
e -> do
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Writer Builder ()) -> Builder -> Writer Builder ()
forall a b. (a -> b) -> a -> b
$ Builder
"CRITICAL ERROR:\n"
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Writer Builder ()) -> Builder -> Writer Builder ()
forall a b. (a -> b) -> a -> b
$ Origin -> Builder
forall a. Describe a => a -> Builder
describeBuilder Origin
origin
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
": "
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Writer Builder ()) -> Builder -> Writer Builder ()
forall a b. (a -> b) -> a -> b
$ e -> Builder
forall a. Describe a => a -> Builder
describeBuilder e
e
    ARSuccess r
r -> do
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Writer Builder ()) -> Builder -> Writer Builder ()
forall a b. (a -> b) -> a -> b
$ case (Bool
hadErrors, Bool
hadWarnings) of
        (Bool
True, Bool
_) -> Builder
"OK, but with errors:"
        (Bool
False, Bool
True) -> Builder
"OK, but with warnings:"
        (Bool
False, Bool
False) -> Builder
"OK:"
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
"\n"
      Builder -> Writer Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Writer Builder ()) -> Builder -> Writer Builder ()
forall a b. (a -> b) -> a -> b
$ r -> Builder
forall a. Describe a => a -> Builder
describeBuilder r
r


putDescribeReport
  :: (Describe e, Describe w, Describe r, MonadIO m)
  => Text -> Maybe LogLevel -> Bool -> AnalysisReport e w r -> m ()
putDescribeReport :: Text -> Maybe LogLevel -> Bool -> AnalysisReport e w r -> m ()
putDescribeReport Text
analysisName Maybe LogLevel
level Bool
snippets AnalysisReport e w r
report = do
  let output :: Text
output = Text -> Maybe LogLevel -> AnalysisReport e w r -> Text
forall e w r.
(Describe e, Describe w, Describe r) =>
Text -> Maybe LogLevel -> AnalysisReport e w r -> Text
describeReport Text
analysisName Maybe LogLevel
level AnalysisReport e w r
report
  Text
output' <- if Bool -> Bool
not Bool
snippets then Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
output else Text -> m Text
forall (m :: * -> *). MonadIO m => Text -> m Text
insertSnippets Text
output
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Lazy.putStrLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
output'

-- Insert snippets of code where source spans are referenced.
insertSnippets :: MonadIO m => Lazy.Text -> m Lazy.Text
insertSnippets :: Text -> m Text
insertSnippets Text
output = do
  let maxLines :: Int
maxLines = Int
5
  let findLines :: Int -> Int -> Text -> Maybe [Text]
findLines Int
n Int
cnt Text
str
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, [Text]
ls <- Text -> [Text]
Lazy.lines Text
str, ls' :: [Text]
ls'@(Text
_:[Text]
_) <- Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Text]
ls = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
cnt [Text]
ls')
        | Bool
otherwise                                               = Maybe [Text]
forall a. Maybe a
Nothing
  let doLine :: Text -> m [Text]
doLine Text
l
        | Just (ParsedOrigin FilePath
fn (Int
l1, Int
_) (Int
l2, Int
_)) <- FilePath -> Maybe ParsedOrigin
parseOrigin (Text -> FilePath
Lazy.unpack Text
l) = do
            Text
f <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
Lazy.readFile FilePath
fn
            case Int -> Int -> Text -> Maybe [Text]
findLines Int
l1 (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
f of
              Just [Text]
fLines -> do
                let fLines' :: [Text]
fLines' | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
maxLines [Text]
fLines) = [Text]
fLines
                            | Bool
otherwise = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
maxLines [Text]
fLines [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"[...]"]
                [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ [Text
l, Text
Lazy.empty] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
fLines' [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Lazy.empty]
              Maybe [Text]
Nothing     -> [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
l]
        | Bool
otherwise = [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
l]
  [Text] -> Text
Lazy.unlines ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> Text) -> m [[Text]] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> m [Text]) -> [Text] -> m [[Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> m [Text]
doLine (Text -> [Text]
Lazy.lines Text
output)

--------------------------------------------------------------------------------
--  Running Analyses
--------------------------------------------------------------------------------

-- | Run an analysis computation and collect the report.
runAnalysisT
  :: (Monad m, Describe e, Describe w)
  => FilePath
  -- ^ The name of the file the analysis is being run on. This is only used for
  -- logging.
  -> LogOutput m
  -- ^ The logging output function, e.g. 'logOutputStd' for standard output or
  -- 'logOutputNone' for no output.
  -> LogLevel
  -- ^ The logging verbosity level.
  -> F.ModFiles
  -- ^ The list of analysis modfiles.
  -> AnalysisT e w m a
  -- ^ The analysis transformer to run.
  -> m (AnalysisReport e w a)
runAnalysisT :: FilePath
-> LogOutput m
-> LogLevel
-> ModFiles
-> AnalysisT e w m a
-> m (AnalysisReport e w a)
runAnalysisT FilePath
fileName LogOutput m
output LogLevel
logLevel ModFiles
mfs AnalysisT e w m a
analysis = do

  (Either (LogMessage e) a
res1, [SomeMessage e w]
messages) <-
    FilePath
-> LogOutput m
-> LogLevel
-> LoggerT e w m (Either (LogMessage e) a)
-> m (Either (LogMessage e) a, [SomeMessage e w])
forall (m :: * -> *) e w a.
(Monad m, Describe e, Describe w) =>
FilePath
-> LogOutput m
-> LogLevel
-> LoggerT e w m a
-> m (a, [SomeMessage e w])
runLoggerT FilePath
fileName LogOutput m
output LogLevel
logLevel (LoggerT e w m (Either (LogMessage e) a)
 -> m (Either (LogMessage e) a, [SomeMessage e w]))
-> (AnalysisT e w m a -> LoggerT e w m (Either (LogMessage e) a))
-> AnalysisT e w m a
-> m (Either (LogMessage e) a, [SomeMessage e w])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
 -> ModFiles -> LoggerT e w m (Either (LogMessage e) a))
-> ModFiles
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> LoggerT e w m (Either (LogMessage e) a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
-> ModFiles -> LoggerT e w m (Either (LogMessage e) a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ModFiles
mfs (ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
 -> LoggerT e w m (Either (LogMessage e) a))
-> (AnalysisT e w m a
    -> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a))
-> AnalysisT e w m a
-> LoggerT e w m (Either (LogMessage e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
 -> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a))
-> (AnalysisT e w m a
    -> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a)
-> AnalysisT e w m a
-> ReaderT ModFiles (LoggerT e w m) (Either (LogMessage e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
forall e w (m :: * -> *) a.
AnalysisT e w m a
-> ExceptT (LogMessage e) (ReaderT ModFiles (LoggerT e w m)) a
getAnalysisT (AnalysisT e w m a
 -> m (Either (LogMessage e) a, [SomeMessage e w]))
-> AnalysisT e w m a
-> m (Either (LogMessage e) a, [SomeMessage e w])
forall a b. (a -> b) -> a -> b
$
    AnalysisT e w m a
analysis

  let result :: AnalysisResult e a
result = case Either (LogMessage e) a
res1 of
        Right a
x -> a -> AnalysisResult e a
forall e r. r -> AnalysisResult e r
ARSuccess a
x
        Left (LogMessage (Just Origin
origin) e
e) -> Origin -> e -> AnalysisResult e a
forall e r. Origin -> e -> AnalysisResult e r
ARFailure Origin
origin e
e
        Left LogMessage e
_ -> FilePath -> AnalysisResult e a
forall a. HasCallStack => FilePath -> a
error FilePath
"impossible: failure without origin"

  AnalysisReport e w a -> m (AnalysisReport e w a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnalysisReport e w a -> m (AnalysisReport e w a))
-> AnalysisReport e w a -> m (AnalysisReport e w a)
forall a b. (a -> b) -> a -> b
$ AnalysisReport :: forall e w r.
FilePath
-> [SomeMessage e w] -> AnalysisResult e r -> AnalysisReport e w r
AnalysisReport
    { _arSourceFile :: FilePath
_arSourceFile = FilePath
fileName
    , _arMessages :: [SomeMessage e w]
_arMessages = [SomeMessage e w]
messages
    , _arResult :: AnalysisResult e a
_arResult = AnalysisResult e a
result
    }



--------------------------------------------------------------------------------
--  Exit codes
--------------------------------------------------------------------------------

class ExitCodeOfReport a where
  -- | Interpret an exit code from report (default 0)
  exitCodeOf :: a -> Int
  exitCodeOf a
_ = Int
0
  -- | Interpret an exit code from a set of reports (default: maximises absolute value)
  exitCodeOfSet :: [a] -> Int
  exitCodeOfSet [] = Int
0
  exitCodeOfSet [a]
s = (Int -> Int -> Ordering) -> [Int] -> Int
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((Int -> Int) -> Int -> Int -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Int -> Int
forall a. Num a => a -> a
abs) ([Int] -> Int) -> ([a] -> [Int]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. ExitCodeOfReport a => a -> Int
exitCodeOf ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [a]
s

instance ExitCodeOfReport r => ExitCodeOfReport (AnalysisReport e w r) where
  exitCodeOf :: AnalysisReport e w r -> Int
exitCodeOf AnalysisReport e w r
report = case AnalysisReport e w r
report AnalysisReport e w r
-> Getting
     (AnalysisResult e r) (AnalysisReport e w r) (AnalysisResult e r)
-> AnalysisResult e r
forall s a. s -> Getting a s a -> a
^. Getting
  (AnalysisResult e r) (AnalysisReport e w r) (AnalysisResult e r)
forall e w r r.
Lens
  (AnalysisReport e w r)
  (AnalysisReport e w r)
  (AnalysisResult e r)
  (AnalysisResult e r)
arResult of
    ARFailure Origin
_ e
_ -> Int
1
    ARSuccess r
r -> r -> Int
forall a. ExitCodeOfReport a => a -> Int
exitCodeOf r
r

instance ExitCodeOfReport () where
  exitCodeOf :: () -> Int
exitCodeOf () = Int
0

instance ExitCodeOfReport Text where
  exitCodeOf :: Text -> Int
exitCodeOf Text
_ = Int
0