module AndroidLintSummary (
supportedLintFormatVersion
, AppEnv(..)
, AppArgs(..)
, LintSeverity(..)
, LintFormatter(..)
, LintLocation(..)
, LintIssue(..)
, Verbosity(..)
, readLintIssues
, openXMLFile
, indentWrap
, formatLintIssues
) where
import BasicPrelude hiding (fromString)
import Rainbow
import Text.XML.HXT.Core
import Control.Monad.Reader (ask, Reader())
import Data.Default (Default(), def)
import Data.Stringable (Stringable(..))
import System.FilePath.GlobPattern (GlobPattern)
import qualified Data.Text as T
import qualified System.Console.Terminal.Size as Terminal
supportedLintFormatVersion :: String
supportedLintFormatVersion = "4"
defaultLintResultsGlob :: GlobPattern
defaultLintResultsGlob = "**/build/outputs/lint-results.xml"
data LintSeverity = FatalSeverity
| ErrorSeverity
| WarningSeverity
| InformationalSeverity
deriving (Eq, Ord, Show, Bounded, Enum)
data LintLocation = LintLocation { filename :: FilePath
, line :: Maybe Int
, column :: Maybe Int
}
deriving (Eq, Show)
data LintIssue = LintIssue { severity :: LintSeverity
, summary :: T.Text
, priority :: Int
, explanation :: T.Text
, location :: LintLocation
}
deriving (Eq, Show)
data LintFormatter =
NullLintFormatter
| SimpleLintFormatter
deriving (Eq, Show, Bounded, Enum)
data Verbosity = Normal | Verbose
deriving (Show, Eq)
data AppArgs = AppArgs { pattern :: GlobPattern
, formatter :: LintFormatter
, verbose :: Verbosity
}
deriving (Show)
data AppEnv = AppEnv { args :: AppArgs
, terminalSize :: Maybe (Terminal.Window Int)
}
instance Default AppArgs where
def = AppArgs { pattern = defaultLintResultsGlob
, formatter = SimpleLintFormatter
, verbose = Normal
}
instance Stringable LintSeverity where
toString = formatSeverity
fromString s
| s == "Fatal" = FatalSeverity
| s == "Error" = ErrorSeverity
| s == "Warning" = WarningSeverity
| s == "Informational" = InformationalSeverity
| otherwise = error $ "Invalid severity " <> s
length _ = 0
instance Stringable LintFormatter where
toString NullLintFormatter = "null"
toString SimpleLintFormatter = "simple"
fromString s
| s == "null" = NullLintFormatter
| s == "simple" = SimpleLintFormatter
| otherwise = error "Invalid LintFormatter specification"
length _ = 0
formatSeverity :: LintSeverity -> String
formatSeverity FatalSeverity = "Fatal"
formatSeverity ErrorSeverity = "Error"
formatSeverity WarningSeverity = "Warning"
formatSeverity InformationalSeverity = "Informational"
colorSeverity :: LintSeverity -> Chunk a -> Chunk a
colorSeverity FatalSeverity a = a & fore red & bold
colorSeverity ErrorSeverity a = a & fore red
colorSeverity WarningSeverity a = a & fore yellow
colorSeverity InformationalSeverity a = a & fore white
formatLintIssues :: LintFormatter -> [LintIssue] -> Reader AppEnv [Chunk T.Text]
formatLintIssues NullLintFormatter _ = pure mempty
formatLintIssues SimpleLintFormatter issues = concat <$> mapM fmt sortedIssues
where
sortedIssues = sortOn ((* (1)) . priority) issues
fmt :: LintIssue -> Reader AppEnv [Chunk T.Text]
fmt i =
sequence [ pure $ label i
, pure $ chunk (" " <> summary i <> "\n") & bold
, pure $ chunk $ concat $ replicate 4 " "
, pure $ chunk ( T.pack (filename $ location i)
<> fmtLine (line $ location i)
<> "\n"
) & underline & fore blue
, fmtExplanation i
]
fmtExplanation :: LintIssue -> Reader AppEnv (Chunk T.Text)
fmtExplanation i = ask >>= \env -> return $ case verbose $ args env of
Normal -> mempty
Verbose -> chunk
( maybe
(explanation i)
(\size -> indentWrap size 4 $ explanation i)
(terminalSize env)
) & faint
fmtLine = maybe mempty ((":" <>) . show)
label i = dye i ( "["
<> T.take 1 (toText $ severity i)
<> "]" )
dye = (. chunk) . colorSeverity . severity
atTag :: ArrowXml a => String -> a XmlTree XmlTree
atTag tag = deep (isElem >>> hasName tag)
sread :: Read a => String -> a
sread = read . T.pack
sreadMay :: Read a => String -> Maybe a
sreadMay = readMay . T.pack
indentWrap :: Terminal.Window Int -> Int -> T.Text -> T.Text
indentWrap size indentation text = foldMap wrap lines'
where
lines' = filter (/= mempty) $ lines text
indent = concat $ replicate indentation " "
wrap t
| t == mempty = mempty
| otherwise = let (as, bs) = T.splitAt (Terminal.width size indentation) t
in indent <> as <> "\n" <> wrap bs
openXMLFile :: forall s b. FilePath -> IO (IOStateArrow s b XmlTree)
openXMLFile filepath = do
contents <- readFile filepath
return $ readString [withWarnings yes] $ T.unpack contents
readLintIssues :: IOSLA (XIOState ()) XmlTree XmlTree -> IO [LintIssue]
readLintIssues doc =
runX $ doc >>> selectIssues >>> parseIssues
where
parseIssues :: ArrowXml a => a XmlTree LintIssue
parseIssues = proc i -> do
severity' <- arr fromString <<< getAttrValue "severity" -< i
summary' <- arr T.pack <<< getAttrValue "summary" -< i
priority' <- arr sread <<< getAttrValue "priority" -< i
explanation' <- arr T.pack <<< getAttrValue "explanation" -< i
location' <- parseLocation -< i
returnA -< LintIssue { severity = severity'
, summary = summary'
, explanation = explanation'
, priority = priority'
, location = location'
}
parseLocation :: ArrowXml a => a XmlTree LintLocation
parseLocation = atTag "location" >>> proc l -> do
filename' <- getAttrValue "file" -< l
line' <- arr sreadMay <<< getAttrValue "line" -< l
column' <- arr sreadMay <<< getAttrValue "column" -< l
returnA -< LintLocation { filename = filename'
, line = line'
, column = column'
}
selectIssues :: ArrowXml a => a XmlTree XmlTree
selectIssues = getChildren
>>>
isElem >>> hasName "issues"
>>>
hasAttrValue "format" (== supportedLintFormatVersion)
>>>
atTag "issue"