{-# LANGUAGE OverloadedStrings #-}
-- | What the linters built on the interval analysis share.
module Tokstyle.C.IntervalLinter
    ( analysedFunctions
    , exprDoc
    , valuesDoc
    , recordWrap
    ) where

import           Language.C.Analysis.SemRep    (FunDef)
import           Language.C.Analysis.TravMonad (Trav, getUserState)
import           Language.C.Data.Node          (NodeInfo, posOfNode)
import           Language.C.Data.Position      (isSourcePos)
import qualified Language.C.Pretty             as C
import           Language.C.Syntax.AST         (CExpr, annotation)
import           Language.Cimple.Diagnostics   (DiagnosticSpan (..))
import           Prettyprinter                 (Doc, pretty, (<+>))
import           Prettyprinter.Render.Terminal (AnsiStyle)
import           Tokstyle.C.Analysis.CFG       (Node)
import           Tokstyle.C.Analysis.Interval  (Facts, Range (..), Term (..))
import           Tokstyle.C.Analysis.Program   (analysedWith)
import           Tokstyle.C.Env                (DiagnosticLevel (..), Env (..),
                                                posAndLen, recordRichError)
import           Tokstyle.C.TravUtils          (backticks)

-- | The functions of the translation unit a linter looks at, with the facts
-- before each of their nodes.
analysedFunctions :: (FunDef -> Bool) -> Trav Env [(FunDef, [(Node, Facts, [Term])])]
analysedFunctions :: (FunDef -> Bool) -> Trav Env [(FunDef, [(Node, Facts, [Term])])]
analysedFunctions FunDef -> Bool
looksAt = do
    Env
env <- Trav Env Env
forall s. Trav s s
getUserState
    [(FunDef, [(Node, Facts, [Term])])]
-> Trav Env [(FunDef, [(Node, Facts, [Term])])]
forall a. a -> TravT Env Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (FunDef
fd, Program -> Analysed -> [(Node, Facts, [Term])]
analysedWith (Env -> Program
program Env
env) Analysed
a) | a :: Analysed
a@(FunDef
fd, Function
_, [(Node, Facts, [Term])]
_) <- Env -> [Analysed]
analysed Env
env, FunDef -> Bool
looksAt FunDef
fd ]

exprDoc :: CExpr -> Doc a
exprDoc :: forall a. CExpr -> Doc a
exprDoc = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
backticks (Doc a -> Doc a) -> (CExpr -> Doc a) -> CExpr -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc a
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc a) -> (CExpr -> String) -> CExpr -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (CExpr -> Doc) -> CExpr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall p. Pretty p => p -> Doc
C.pretty

valuesDoc :: Range -> Doc a
valuesDoc :: forall a. Range -> Doc a
valuesDoc (Range Integer
l Integer
h Origin
_)
    | Integer
l Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
h = Integer -> Doc a
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
l
    | Bool
otherwise = Doc a
"values from" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc a
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
l Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"to" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc a
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
h

-- | Records an error at a term, pointing at where its value wrapped around if
-- that was elsewhere.
recordWrap :: Term -> NodeInfo -> Doc AnsiStyle -> Trav Env ()
recordWrap :: Term -> NodeInfo -> Doc AnsiStyle -> Trav Env ()
recordWrap Term
t NodeInfo
site Doc AnsiStyle
msg = NodeInfo
-> DiagnosticLevel
-> Doc AnsiStyle
-> [DiagnosticSpan Position]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Trav Env ()
recordRichError NodeInfo
ni DiagnosticLevel
ErrorLevel Doc AnsiStyle
msg [DiagnosticSpan Position]
spans []
  where
    ni :: NodeInfo
ni = CExpr -> NodeInfo
forall a. CExpression a -> a
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation (Term -> CExpr
termExpr Term
t)
    spans :: [DiagnosticSpan Position]
spans =
        [ Position -> Int -> [Doc AnsiStyle] -> DiagnosticSpan Position
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan Position
pos Int
len [Doc AnsiStyle
"wraps around here"]
        | NodeInfo -> Position
posOfNode NodeInfo
site Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
/= NodeInfo -> Position
posOfNode NodeInfo
ni, Position -> Bool
isSourcePos (NodeInfo -> Position
posOfNode NodeInfo
site)
        , let (Position
pos, Int
len) = NodeInfo -> (Position, Int)
posAndLen NodeInfo
site ]