Add property confirming the parse of the command line args

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,50 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
+
+{- |
+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/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