Merge pull request #14 from memowe/property-tests

Add property tests / Use stricter String types

CHANGELOG.md

@@ -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:

src/Trivialini.hs

@@ -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:
@@ -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 }
@@ -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 (==' ')

src/Trivialini/SafeTypes.hs

@@ -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)
+          &&& (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

test/Main.hs

@@ -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\
@@ -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

test/TestSafeTypes.hs

@@ -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
+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 (&&)