{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Tokstyle.Linter
    ( analyse
    , analyseLocal
    , analyseGlobal
    , allWarnings
    , markdown
    ) where

import           Control.Parallel.Strategies      (parMap, rpar)
import qualified Data.List                        as List
import           Data.Text                        (Text)
import qualified Data.Text                        as Text
import           Language.Cimple                  (Lexeme, Node)

import qualified Tokstyle.Linter.Assert           as Assert
import qualified Tokstyle.Linter.BooleanReturn    as BooleanReturn
import qualified Tokstyle.Linter.Booleans         as Booleans
import qualified Tokstyle.Linter.CallbackNames    as CallbackNames
import qualified Tokstyle.Linter.CallocArgs       as CallocArgs
import qualified Tokstyle.Linter.CallocType       as CallocType
import qualified Tokstyle.Linter.CompoundInit     as CompoundInit
import qualified Tokstyle.Linter.Constness        as Constness
import qualified Tokstyle.Linter.EnumDefines      as EnumDefines
import qualified Tokstyle.Linter.EnumNames        as EnumNames
import qualified Tokstyle.Linter.FuncPrototypes   as FuncPrototypes
import qualified Tokstyle.Linter.FuncScopes       as FuncScopes
import qualified Tokstyle.Linter.GlobalFuncs      as GlobalFuncs
import qualified Tokstyle.Linter.LoggerCalls      as LoggerCalls
import qualified Tokstyle.Linter.LoggerConst      as LoggerConst
import qualified Tokstyle.Linter.LoggerNoEscapes  as LoggerNoEscapes
import qualified Tokstyle.Linter.MallocCall       as MallocCall
import qualified Tokstyle.Linter.MallocType       as MallocType
import qualified Tokstyle.Linter.MemcpyStructs    as MemcpyStructs
import qualified Tokstyle.Linter.MissingNonNull   as MissingNonNull
import qualified Tokstyle.Linter.Nesting          as Nesting
import qualified Tokstyle.Linter.NonNull          as NonNull
import qualified Tokstyle.Linter.Parens           as Parens
import qualified Tokstyle.Linter.SwitchIf         as SwitchIf
import qualified Tokstyle.Linter.TypedefName      as TypedefName
import qualified Tokstyle.Linter.UnsafeFunc       as UnsafeFunc
import qualified Tokstyle.Linter.VarUnusedInScope as VarUnusedInScope

import qualified Tokstyle.Linter.Callgraph        as Callgraph
import qualified Tokstyle.Linter.DeclaredOnce     as DeclaredOnce
import qualified Tokstyle.Linter.DeclsHaveDefns   as DeclsHaveDefns
import qualified Tokstyle.Linter.DocComments      as DocComments
import qualified Tokstyle.Linter.TypeCheck        as TypeCheck
import qualified Tokstyle.SemFmt.EnumFromInt      as EnumFromInt
import qualified Tokstyle.SemFmt.EnumToString     as EnumToString
import qualified Tokstyle.SemFmt.EnumUnpack       as EnumUnpack
import qualified Tokstyle.SemFmt.StructPack       as StructPack


type TranslationUnit = (FilePath, [Node (Lexeme Text)])

run :: [(t -> [Text], (Text, Text))] -> [Text] -> t -> [Text]
run :: [(t -> [Text], (Text, Text))] -> [Text] -> t -> [Text]
run [(t -> [Text], (Text, Text))]
linters [Text]
flags t
tu =
    [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> ([(t -> [Text], (Text, Text))] -> [[Text]])
-> [(t -> [Text], (Text, Text))]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy [Text]
-> ((t -> [Text], (Text, Text)) -> [Text])
-> [(t -> [Text], (Text, Text))]
-> [[Text]]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy [Text]
forall a. Strategy a
rpar (t -> [Text], (Text, Text)) -> [Text]
forall b b. (Semigroup b, IsString b) => (t -> [b], (b, b)) -> [b]
apply ([(t -> [Text], (Text, Text))] -> [[Text]])
-> ([(t -> [Text], (Text, Text))] -> [(t -> [Text], (Text, Text))])
-> [(t -> [Text], (Text, Text))]
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t -> [Text], (Text, Text)) -> Bool)
-> [(t -> [Text], (Text, Text))] -> [(t -> [Text], (Text, Text))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
flags) (Text -> Bool)
-> ((t -> [Text], (Text, Text)) -> Text)
-> (t -> [Text], (Text, Text))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> ((t -> [Text], (Text, Text)) -> (Text, Text))
-> (t -> [Text], (Text, Text))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> [Text], (Text, Text)) -> (Text, Text)
forall a b. (a, b) -> b
snd) ([(t -> [Text], (Text, Text))] -> [Text])
-> [(t -> [Text], (Text, Text))] -> [Text]
forall a b. (a -> b) -> a -> b
$ [(t -> [Text], (Text, Text))]
linters
  where
    apply :: (t -> [b], (b, b)) -> [b]
apply (t -> [b]
f, (b
flag, b
_)) = (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
" [-W" b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
flag b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
"]") ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ t -> [b]
f t
tu

type LocalLinter = (TranslationUnit -> [Text], (Text, Text))

localLinters :: [LocalLinter]
localLinters :: [LocalLinter]
localLinters =
    [ LocalLinter
Assert.descr
    , LocalLinter
Booleans.descr
    , LocalLinter
BooleanReturn.descr
    , LocalLinter
CallbackNames.descr
    , LocalLinter
CallocArgs.descr
    , LocalLinter
CallocType.descr
    , LocalLinter
CompoundInit.descr
    , LocalLinter
Constness.descr
    , LocalLinter
EnumDefines.descr
    , LocalLinter
EnumNames.descr
    , LocalLinter
FuncPrototypes.descr
    , LocalLinter
FuncScopes.descr
    , LocalLinter
GlobalFuncs.descr
    , LocalLinter
LoggerCalls.descr
    , LocalLinter
LoggerConst.descr
    , LocalLinter
LoggerNoEscapes.descr
    , LocalLinter
MallocCall.descr
    , LocalLinter
MallocType.descr
    , LocalLinter
MemcpyStructs.descr
    , LocalLinter
MissingNonNull.descr
    , LocalLinter
Nesting.descr
    , LocalLinter
NonNull.descr
    , LocalLinter
Parens.descr
    , LocalLinter
SwitchIf.descr
    , LocalLinter
TypedefName.descr
    , LocalLinter
UnsafeFunc.descr
    , LocalLinter
VarUnusedInScope.descr
    ]

type GlobalLinter = ([TranslationUnit] -> [Text], (Text, Text))

globalLinters :: [GlobalLinter]
globalLinters :: [GlobalLinter]
globalLinters =
    [ GlobalLinter
Callgraph.descr
    , GlobalLinter
DeclaredOnce.descr
    , GlobalLinter
DeclsHaveDefns.descr
    , GlobalLinter
DocComments.descr
    , GlobalLinter
TypeCheck.descr
    -- Semantic formatters:
    , GlobalLinter
EnumFromInt.descr
    , GlobalLinter
EnumToString.descr
    , GlobalLinter
EnumUnpack.descr
    , GlobalLinter
StructPack.descr
    ]

analyseLocal :: [Text] -> TranslationUnit -> [Text]
analyseLocal :: [Text] -> TranslationUnit -> [Text]
analyseLocal = [LocalLinter] -> [Text] -> TranslationUnit -> [Text]
forall t. [(t -> [Text], (Text, Text))] -> [Text] -> t -> [Text]
run [LocalLinter]
localLinters

analyseGlobal :: [Text] -> [TranslationUnit] -> [Text]
analyseGlobal :: [Text] -> [TranslationUnit] -> [Text]
analyseGlobal = [GlobalLinter] -> [Text] -> [TranslationUnit] -> [Text]
forall t. [(t -> [Text], (Text, Text))] -> [Text] -> t -> [Text]
run [GlobalLinter]
globalLinters

analyse :: [Text] -> [TranslationUnit] -> [Text]
analyse :: [Text] -> [TranslationUnit] -> [Text]
analyse [Text]
linters [TranslationUnit]
tus = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [TranslationUnit] -> [Text]
analyseGlobal [Text]
linters [TranslationUnit]
tus [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: Strategy [Text]
-> (TranslationUnit -> [Text]) -> [TranslationUnit] -> [[Text]]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy [Text]
forall a. Strategy a
rpar ([Text] -> TranslationUnit -> [Text]
analyseLocal [Text]
linters) [TranslationUnit]
tus

allWarnings :: [Text]
allWarnings :: [Text]
allWarnings = (LocalLinter -> Text) -> [LocalLinter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (LocalLinter -> (Text, Text)) -> LocalLinter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalLinter -> (Text, Text)
forall a b. (a, b) -> b
snd) [LocalLinter]
localLinters [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (GlobalLinter -> Text) -> [GlobalLinter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (GlobalLinter -> (Text, Text)) -> GlobalLinter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalLinter -> (Text, Text)
forall a b. (a, b) -> b
snd) [GlobalLinter]
globalLinters

class LinterType a where
    linterType :: a -> Text

instance LinterType LocalLinter where linterType :: LocalLinter -> Text
linterType = Text -> LocalLinter -> Text
forall a b. a -> b -> a
const Text
""
instance LinterType GlobalLinter where linterType :: GlobalLinter -> Text
linterType = Text -> GlobalLinter -> Text
forall a b. a -> b -> a
const Text
" (global)"

markdown :: Text
markdown :: Text
markdown = Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text)
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text]
prelude [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++) ([Text] -> [Text])
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd ([(Text, Text)] -> [Text])
-> ([(Text, Text)] -> [(Text, Text)]) -> [(Text, Text)] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> [(Text, Text)]
forall a. Ord a => [a] -> [a]
List.sort ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall a b. (a -> b) -> a -> b
$ (LocalLinter -> (Text, Text)) -> [LocalLinter] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map LocalLinter -> (Text, Text)
forall a.
LinterType (a, (Text, Text)) =>
(a, (Text, Text)) -> (Text, Text)
mkDoc [LocalLinter]
localLinters [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ (GlobalLinter -> (Text, Text)) -> [GlobalLinter] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map GlobalLinter -> (Text, Text)
forall a.
LinterType (a, (Text, Text)) =>
(a, (Text, Text)) -> (Text, Text)
mkDoc [GlobalLinter]
globalLinters
  where
    prelude :: [Text]
prelude =
        [ Text
"# Cimple-based linters (`check-cimple`)"
        , Text
""
        , Text
"There are currently " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [LocalLinter] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocalLinter]
localLinters Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GlobalLinter] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalLinter]
globalLinters) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" linters implemented,"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of which " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [GlobalLinter] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalLinter]
globalLinters) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" perform global analyses."
        , Text
"In the list below, the global ones are marked specially."
        , Text
""
        ]
    mkDoc :: (a, (Text, Text)) -> (Text, Text)
mkDoc (a, (Text, Text))
lnt =
        let (Text
flag, Text
doc) = (a, (Text, Text)) -> (Text, Text)
forall a b. (a, b) -> b
snd (a, (Text, Text))
lnt in
        (Text
flag, Text
"## `-W" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
flag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (a, (Text, Text)) -> Text
forall a. LinterType a => a -> Text
linterType (a, (Text, Text))
lnt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
doc)