Add property confirming invalid statm content does not parse

mem-info.cabal

@@ -66,6 +66,7 @@ test-suite test
   main-is:          Spec.hs
   hs-source-dirs:   test
   other-modules:
+    MemInfo.ChoicesSpec
     MemInfo.OrphanInstances
     MemInfo.PrintSpec
     MemInfo.ProcSpec
@@ -80,8 +81,9 @@ test-suite test
     , genvalidity-hspec
     , genvalidity-text
     , hashable
-    , mem-info
     , hspec
+    , mem-info
+    , optparse-applicative  >=0.18.1 && <0.19
     , QuickCheck
     , text
     , unix

src/System/MemInfo/Choices.hs

@@ -1,3 +1,8 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+
 {- |
 Module      : System.MemInfo.Choices
 Copyright   : (c) 2022 Tim Emiola
@@ -13,6 +18,7 @@ module System.MemInfo.Choices (
   getChoices,
 ) where
 
+import GHC.Generics (Generic)
 import Options.Applicative (
   Parser,
   ParserInfo,
@@ -48,7 +54,7 @@ data Choices = Choices
   , choiceWatchSecs :: !(Maybe Natural)
   , choicePidsToShow :: !(Maybe (NonEmpty ProcessID))
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 
 
 -- | Specifies a command line that when parsed will provide 'Choices'

test/MemInfo/ChoicesSpec.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{- |
+Module      : MemInfo.ChoicesSpec
+Copyright   : (c) 2023 Tim Emiola
+Maintainer  : Tim Emiola <[email protected]>
+SPDX-License-Identifier: BSD3
+-}
+module MemInfo.ChoicesSpec where
+
+import Data.GenValidity (GenValid (..))
+import qualified Data.List.NonEmpty as NE
+import MemInfo.OrphanInstances ()
+import Options.Applicative (defaultPrefs, execParserPure, getParseResult)
+import System.MemInfo.Choices (Choices (..), cmdInfo)
+import Test.Hspec
+import Test.QuickCheck (Gen, Property, forAll, suchThat)
+
+
+spec :: Spec
+spec = describe "module System.MemInfo.Choices" $ do
+  it "should parse a Choices from the command line ok" prop_roundtripParseChoices
+
+
+prop_roundtripParseChoices :: Property
+prop_roundtripParseChoices =
+  forAll genCmdLine $
+    \(choices, args) -> Just choices == getParseResult (execParserPure defaultPrefs cmdInfo args)
+
+
+genCmdLine :: Gen (Choices, [String])
+genCmdLine = do
+  choices <- genValid `suchThat` ((/= Just 0) . choiceWatchSecs)
+  pure (choices, cmdlineOf choices)
+
+
+cmdlineOf :: Choices -> [String]
+cmdlineOf c =
+  let
+    splitArgs = if choiceSplitArgs c then ("-s" :) else id
+    onlyTotal = if choiceOnlyTotal c then ("-t" :) else id
+    byPid = if choiceByPid c then ("-d" :) else id
+    showSwap = if choiceShowSwap c then ("-S" :) else id
+    watchSecs = maybe id (\x -> (("-w " ++ show x) :)) $ choiceWatchSecs c
+    onePid x = "-p " ++ show x
+    manyPids xs = (map onePid (NE.toList xs) ++)
+    pidsToShow = maybe id manyPids $ choicePidsToShow c
+   in
+    pidsToShow $ splitArgs $ onlyTotal $ byPid $ showSwap $ watchSecs mempty

test/MemInfo/OrphanInstances.hs

@@ -19,8 +19,12 @@ module MemInfo.OrphanInstances where
 
 import Data.GenValidity (GenValid (..))
 import Data.GenValidity.Text ()
+import Data.List.NonEmpty (nonEmpty)
+import System.MemInfo.Choices (Choices (..))
 import System.MemInfo.Proc (ExeInfo (..), StatusInfo)
 import System.Posix.Types (CPid (..), ProcessID)
+import Test.QuickCheck (Gen, frequency, suchThat)
+import Test.QuickCheck.Gen (listOf)
 import Test.Validity (Validity)
 
 
@@ -32,10 +36,30 @@ instance GenValid ExeInfo where
     pure $ ExeInfo {eiDeleted, eiOriginal, eiTarget}
 
 
+genPositive :: (GenValid a, Num a, Ord a) => Gen a
+genPositive = genValid `suchThat` (> 0)
+
+
 deriving anyclass instance GenValid StatusInfo
 
 
 deriving newtype instance Validity ProcessID
 
 
 deriving newtype instance GenValid ProcessID
+
+
+deriving instance Validity Choices
+
+
+instance GenValid Choices where
+  genValid =
+    let genPositiveMb = frequency [(1, pure Nothing), (5, Just <$> genPositive)]
+        genPids = nonEmpty <$> listOf genPositive
+     in Choices
+          <$> genValid
+          <*> genValid
+          <*> genValid
+          <*> genValid
+          <*> genPositiveMb
+          <*> genPids

test/MemInfo/PrintSpec.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 {- |
-Module      : MemInfo.ProcSpec
+Module      : MemInfo.PrintSpec
 Copyright   : (c) 2023 Tim Emiola
 Maintainer  : Tim Emiola <[email protected]>
 SPDX-License-Identifier: BSD3

test/MemInfo/ProcSpec.hs

@@ -10,6 +10,7 @@ SPDX-License-Identifier: BSD3
 module MemInfo.ProcSpec (spec) where
 
 import Data.Hashable (hash)
+import Data.Maybe (isNothing)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Word (Word16)
@@ -82,6 +83,9 @@ fromStatmSpec = describe "parseFromStatm" $ do
   describe "when using a kernel version with known sharing" $ do
     it "should parse values to ProcUsage successfully" prop_roundtripStatmShared
 
+  describe "When the statm content is invalid" $ do
+    it "should not parse values to ProcUsage successfully" prop_roundtripInvalidStatm
+
 
 fromSmapSpec :: Spec
 fromSmapSpec = describe "parseFromSmap" $ do
@@ -101,6 +105,12 @@ prop_roundtripStatmNotShared =
     \(pp, txt) -> Just pp == parseFromStatm badSharedKernel txt
 
 
+prop_roundtripInvalidStatm :: Property
+prop_roundtripInvalidStatm =
+  forAll genNoSharedStatm $
+    \(_, txt) -> isNothing $ parseFromStatm badSharedKernel $ invalidateStatm txt
+
+
 prop_roundtripSmap :: Property
 prop_roundtripSmap = forAll genSmap $ \(pp, txt) -> pp == parseFromSmap txt
 
@@ -129,6 +139,10 @@ genNoSharedStatm = do
   pure (pp, content)
 
 
+invalidateStatm :: Text -> Text
+invalidateStatm = Text.replace " " "-"
+
+
 statmShared :: Word16 -> Word16 -> Text
 statmShared rss shared = "0 " +| toInteger rss |+ " " +| toInteger shared |+ " 1 2 3"
 

test/Spec.hs

@@ -2,6 +2,7 @@
 
 module Main where
 
+import qualified MemInfo.ChoicesSpec as Choices
 import qualified MemInfo.PrintSpec as Print
 import qualified MemInfo.ProcSpec as Proc
 import qualified MemInfo.SysInfoSpec as SysInfo
@@ -19,6 +20,7 @@ main = do
   hSetBuffering stdout NoBuffering
   hSetBuffering stderr NoBuffering
   hspec $ do
+    Choices.spec
     Proc.spec
     Print.spec
     SysInfo.spec