diff --git a/mem-info.cabal b/mem-info.cabal index 2f6dae7..ff496ef 100644 --- a/mem-info.cabal +++ b/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 diff --git a/src/System/MemInfo/Choices.hs b/src/System/MemInfo/Choices.hs index 2355063..98d8af2 100644 --- a/src/System/MemInfo/Choices.hs +++ b/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' diff --git a/test/MemInfo/ChoicesSpec.hs b/test/MemInfo/ChoicesSpec.hs new file mode 100644 index 0000000..119d5ce --- /dev/null +++ b/test/MemInfo/ChoicesSpec.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- | +Module : MemInfo.ChoicesSpec +Copyright : (c) 2023 Tim Emiola +Maintainer : Tim Emiola +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 diff --git a/test/MemInfo/OrphanInstances.hs b/test/MemInfo/OrphanInstances.hs index bec7830..e1f1e26 100644 --- a/test/MemInfo/OrphanInstances.hs +++ b/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,6 +36,10 @@ 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 @@ -39,3 +47,19 @@ 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 diff --git a/test/MemInfo/PrintSpec.hs b/test/MemInfo/PrintSpec.hs index 3473f3f..3b068fc 100644 --- a/test/MemInfo/PrintSpec.hs +++ b/test/MemInfo/PrintSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {- | -Module : MemInfo.ProcSpec +Module : MemInfo.PrintSpec Copyright : (c) 2023 Tim Emiola Maintainer : Tim Emiola SPDX-License-Identifier: BSD3 diff --git a/test/Spec.hs b/test/Spec.hs index 9498b43..4b96ec5 100644 --- a/test/Spec.hs +++ b/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