Skip to content

Commit

Permalink
Merge pull request #14 from memowe/property-tests
Browse files Browse the repository at this point in the history
Add property tests / Use stricter String types
  • Loading branch information
memowe authored May 3, 2024
2 parents 3afba8d + c8e35ce commit 897038e
Show file tree
Hide file tree
Showing 6 changed files with 268 additions and 57 deletions.
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# Revision history for trivialini

## 0.5.0.0 -- 2024-03-05

* Breaking changes:
* Use safer types

## 0.4.0.0 -- 2021-09-02

* Breaking changes:
Expand Down
26 changes: 16 additions & 10 deletions src/Trivialini.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,10 +17,12 @@ module Trivialini
, Ini(..)
) where

import Data.Map ( assocs, Map, fromList )
import Data.List ( dropWhileEnd )
import Trivialini.SafeTypes
import Data.Map (Map, fromList, assocs)
import Data.List
import Data.Maybe
import Text.ParserCombinators.ReadP
( between, char, many, munch1, readP_to_S, skipMany1 )
import Control.Monad

{- $intro
Consider a simple ini file @config.ini@ like this:
Expand All @@ -47,8 +49,10 @@ readIniFile file = sections . read <$> readFile file

-- | As ini files consist of sections with a name, each with a list of
-- key-value pairs, A "two-dimensional" 'Map' of 'String's seems to be very
-- natural.
type IniMap = Map String (Map String String)
-- natural. However, since the formatting of ini files doesn't allow arbitrary
-- arbitrary characters, restricted types are used here, that are thin wrappers
-- around 'String's:
type IniMap = Map IniHeading (Map IniKey IniValue)

-- | A wrapper type around an 'IniMap' with 'Show' and 'Read' instances.
newtype Ini = Ini { sections :: IniMap }
Expand All @@ -60,20 +64,22 @@ newtype Ini = Ini { sections :: IniMap }
-- data.
instance Show Ini where
show = unlines . map section . assocs . sections
where section (name, sec) = "[" ++ name ++ "]\n" ++ pairs sec
where section (name, sec) = "[" ++ getHeading name ++ "]\n" ++ pairs sec
pairs = unlines . map pair . assocs
pair (k, v) = k ++ " = " ++ v
pair (k, v) = getKey k ++ " = " ++ getValue v

-- | Parsing of Ini strings.
instance Read Ini where
readsPrec _ = readP_to_S parser
where parser = Ini . fromList <$> many section
section = do name <- trim <$> between (char '[') (char ']' >> nls) (no "=\n]")
section = do name <- trim <$> between (char '[') (char ']' >> nls) (no "=\n]")
guard $ isValidHeading name
pairs <- many pair
return (name, fromList pairs)
return (fromJust (mkHdg name), fromList pairs)
pair = do key <- trim <$> no "\n[="
val <- trim <$> between (char '=') nls (no "\n")
return (key, val)
guard $ isValidKey key && isValidValue val
return (fromJust (mkKey key), fromJust (mkVal val))
nls = munch1 (=='\n')
no = munch1 . flip notElem
trim = dropWhile (==' ') . dropWhileEnd (==' ')
80 changes: 80 additions & 0 deletions src/Trivialini/SafeTypes.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,80 @@
{- |
Ini data essentially consists of 'String's, that cannot contain every character
because of the simple format it is contained in. The types in this module are
restricted to contain only allowed characters. They also can not be empty or
start or end with whitespace. Values of these types can not be created with
data constructors. Use the @mk*@ functions instead!
-}

module Trivialini.SafeTypes
(
-- * Safe 'String' types
IniHeading(getHeading), IniKey(getKey), IniValue(getValue)
-- (No data constructors!)
-- ** Value creation
, mkHdg, mkKey, mkVal
-- ** Validity predicates
, isValidHeading, isValidKey, isValidValue
-- ** Invalid character lists (useful for parsers)
, invalidHdgChars, invalidKeyChars, invalidValChars
-- ** Utility predicate
, isValidStr
) where

import Data.Bool
import Data.Char
import Data.String
import Data.Maybe
import Control.Applicative

-- Utility function
guarded :: Alternative m => (a -> Bool) -> a -> m a
guarded = liftA2 (bool empty) pure

-- | A section heading
newtype IniHeading = Hdg { getHeading :: String } deriving (Eq, Ord)
-- | A key of a key-value pair
newtype IniKey = Key { getKey :: String } deriving (Eq, Ord)
-- | A value of a key-value pair
newtype IniValue = Val { getValue :: String } deriving (Eq, Ord)

invalidHdgChars :: String
invalidKeyChars :: String
invalidValChars :: String
invalidHdgChars = "=]\n"
invalidKeyChars = "=[\n"
invalidValChars = "\n"

isValidHeading :: String -> Bool
isValidKey :: String -> Bool
isValidValue :: String -> Bool
isValidHeading = all (`notElem` invalidHdgChars) &&& isValidStr
isValidKey = all (`notElem` invalidKeyChars) &&& isValidStr
isValidValue = all (`notElem` invalidValChars) &&& isValidStr

isValidStr :: String -> Bool
isValidStr = (not . null)
&&& (not . any isControl)
&&& (not . isSpace . head)

Check warning on line 58 in src/Trivialini/SafeTypes.hs

View workflow job for this annotation

GitHub Actions / GHC 9.8 on ubuntu-latest

In the use of ‘head’

Check warning on line 58 in src/Trivialini/SafeTypes.hs

View workflow job for this annotation

GitHub Actions / GHC 9.8 on ubuntu-latest

In the use of ‘head’
&&& (not . isSpace . last)

(&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
(&&&) = liftA2 (&&)

mkHdg :: String -> Maybe IniHeading
mkKey :: String -> Maybe IniKey
mkVal :: String -> Maybe IniValue
mkHdg = fmap Hdg . guarded isValidHeading
mkKey = fmap Key . guarded isValidKey
mkVal = fmap Val . guarded isValidValue

instance Show IniHeading where show = getHeading
instance Show IniKey where show = getKey
instance Show IniValue where show = getValue

instance IsString IniHeading where
fromString = fromMaybe <$> error . ("Not a heading: " ++) <*> mkHdg
instance IsString IniKey where
fromString = fromMaybe <$> error . ("Not a key: " ++) <*> mkKey
instance IsString IniValue where
fromString = fromMaybe <$> error . ("Not a value: " ++) <*> mkVal
73 changes: 40 additions & 33 deletions test/Main.hs
Original file line number Diff line number Diff line change
@@ -1,12 +1,17 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Test.Tasty ( defaultMain, testGroup, TestTree, withResource )
import Test.Tasty.HUnit ( testCase, (@?=) )
import Trivialini ( Ini(..), IniMap, readIniFile )
import Data.Map ( fromList )
import System.FilePath ( (</>) )
import System.Directory ( getTemporaryDirectory, removeFile )
import Test.Hspec
import Test.QuickCheck
import Test.Hspec.QuickCheck
import TestSafeTypes

import Trivialini
import Data.Map (empty, elems, fromList)
import System.IO.Temp
import System.IO

exampleIni :: String
exampleIni = "[xnorfzt]\n\
\foo = bar\n\
\\n\
Expand All @@ -16,37 +21,39 @@ exampleIni = "[xnorfzt]\n\
\ baz quux = quuux\n\
\"

expectedIni :: Ini
expectedIni = Ini $ fromList [
("xnorfzt", fromList [("foo", "bar"), ("x", "17"), ("answer", "42")]),
("section name", fromList [("baz quux", "quuux")])
]

testIniParsing = testGroup "Ini parsing"
[ testCase "Complex ini data" $
read exampleIni @?= expectedIni
, testCase "parse . show . parse = parse" $
let intermediatini = read exampleIni :: Ini
in (read . show) intermediatini @?= expectedIni
]
testIniParsingExample :: Spec
testIniParsingExample = describe "Example data parsing" $ do
it "Correct INI data" $
read exampleIni `shouldBe` expectedIni
it "read . show changes nothing" $
let intermediatini = read exampleIni :: Ini
in (read . show) intermediatini `shouldBe` expectedIni

testIniIO :: IO (FilePath, IniMap) -> TestTree
testIniIO ioData = testGroup "Read ini file"
[ testCase "Expected complete ini data" $ do
iniMap <- snd <$> ioData
iniMap @?= sections expectedIni
]
testIniParsingArbitrary :: Spec
testIniParsingArbitrary = describe "Arbitrary data parsing" $ do
modifyMaxSuccess (const 20) $
prop "read . show changes nothing" $ \iniMap ->
(iniMap /= empty && (empty `notElem` elems iniMap)) ==>
let ini = Ini iniMap
in (sections . read . show) ini `shouldBe` iniMap

testIniFileReading = withResource io cleanup testIniIO
where io = do name <- write
ini <- readIniFile name
return (name, ini)
write = do name <- tmpFile
writeFile name exampleIni
return name
tmpFile = (</> "trivialini-test.ini") <$> getTemporaryDirectory
cleanup = removeFile . fst

main = defaultMain $ testGroup "Unit tests"
[ testIniParsing
, testIniFileReading
]
testIniFileReading :: Spec
testIniFileReading = describe "Read ini file" $ do
loadedIni <- runIO $ withSystemTempFile "trivialini-test.ini" $ \fp h -> do
hPutStr h exampleIni >> hClose h
readIniFile fp
it "Correct example INI data" $
loadedIni `shouldBe` sections expectedIni

main :: IO ()
main = hspec $ describe "Ini tests" $ do
testArbinitrary
testIniParsingExample
testIniParsingArbitrary
testIniFileReading
110 changes: 110 additions & 0 deletions test/TestSafeTypes.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,110 @@
{-# OPTIONS_GHC -Wno-orphans #-}
module TestSafeTypes where

import Trivialini.SafeTypes
import Test.Hspec
import Test.QuickCheck
import Test.Hspec.QuickCheck

import Data.String
import Control.Applicative

Check warning on line 10 in test/TestSafeTypes.hs

View workflow job for this annotation

GitHub Actions / GHC 9.6 on ubuntu-latest

The import of ‘Control.Applicative’ is redundant

Check warning on line 10 in test/TestSafeTypes.hs

View workflow job for this annotation

GitHub Actions / GHC 9.8 on ubuntu-latest

The import of ‘Control.Applicative’ is redundant
import Control.Exception

instance Arbitrary IniHeading where
arbitrary = arbitrary `suchThatMap` mkHdg

instance Arbitrary IniKey where
arbitrary = arbitrary `suchThatMap` mkKey

instance Arbitrary IniValue where
arbitrary = arbitrary `suchThatMap` mkVal

testArbinitrary :: Spec
testArbinitrary = describe "Safe types tests" $ do
modifyMaxDiscardRatio (const 1000) $ do -- Neccessary, but tests are fast

context "Ini headings" $ do

it "Correct invalid characters" $
invalidHdgChars `shouldBe` "=]\n"

describe "Validity predicates" $ do
prop "valid" $ \s -> safeHdg s ==>
isValidHeading s `shouldBe` True
prop "invalid" $ \s -> not (safeHdg s) ==>
isValidHeading s `shouldBe` False

describe "Data construction" $ do
prop "valid" $ \s -> safeHdg s ==>
getHeading <$> mkHdg s `shouldBe` Just s
prop "invalid" $ \s -> not (safeHdg s) ==>
mkHdg s `shouldBe` Nothing

prop "Show instance" $ \s -> safeHdg s ==>
show <$> mkHdg s `shouldBe` Just s

describe "IsString instance" $ do
prop "valid" $ \s -> safeHdg s ==>
getHeading (fromString s) `shouldBe` s
prop "invalid" $ \s -> not (safeHdg s) ==>
evaluate (fromString s :: IniHeading)
`shouldThrow` errorCall ("Not a heading: " ++ s)

context "Ini keys" $ do

it "Correct invalid characters" $
invalidKeyChars `shouldBe` "=[\n"

describe "Validity predicates" $ do
prop "valid" $ \s -> safeKey s ==>
isValidKey s `shouldBe` True
prop "invalid" $ \s -> not (safeKey s) ==>
isValidKey s `shouldBe` False

describe "Data construction" $ do
prop "valid" $ \s -> safeKey s ==>
getKey <$> mkKey s `shouldBe` Just s
prop "invalid" $ \s -> not (safeKey s) ==>
mkKey s `shouldBe` Nothing

prop "Show instance" $ \s -> safeKey s ==>
show <$> mkKey s `shouldBe` Just s

describe "IsString instance" $ do
prop "valid" $ \s -> safeKey s ==>
getKey (fromString s) `shouldBe` s
prop "invalid" $ \s -> not (safeKey s) ==>
evaluate (fromString s :: IniKey)
`shouldThrow` errorCall ("Not a key: " ++ s)

context "Ini values" $ do

it "Correct invalid characters" $
invalidValChars `shouldBe` "\n"

describe "Validity predicates" $ do
prop "valid" $ \s -> safeVal s ==>
isValidValue s `shouldBe` True
prop "invalid" $ \s -> not (safeVal s) ==>
isValidValue s `shouldBe` False

describe "Data construction" $ do
prop "valid" $ \s -> safeVal s ==>
getValue <$> mkVal s `shouldBe` Just s
prop "invalid" $ \s -> not (safeVal s) ==>
mkVal s `shouldBe` Nothing

prop "Show instance" $ \s -> safeVal s ==>
show <$> mkVal s `shouldBe` Just s

describe "IsString instance" $ do
prop "valid" $ \s -> safeVal s ==>
getValue (fromString s) `shouldBe` s
prop "invalid" $ \s -> not (safeVal s) ==>
evaluate (fromString s :: IniValue)
`shouldThrow` errorCall ("Not a value: " ++ s)

where safeHdg = all (`notElem` invalidHdgChars) &&& isValidStr
safeKey = all (`notElem` invalidKeyChars) &&& isValidStr
safeVal = all (`notElem` invalidValChars) &&& isValidStr
(&&&) = liftA2 (&&)
Loading

0 comments on commit 897038e

Please sign in to comment.