Update test-ini-compat for better generation of safe abitrary text strings.
Kevin Quick
7 years ago
| 1 | {-# LANGUAGE TypeSynonymInstances #-} | |
| 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} | |
| 3 | ||
| 1 | 4 | module Main where |
| 2 | 5 | |
| 3 | import Data.Char | |
| 4 | 6 | import Data.HashMap.Strict (HashMap) |
| 5 | 7 | import qualified Data.HashMap.Strict as HM |
| 6 | 8 | import qualified Data.Ini as I1 |
| 7 | 9 | import qualified Data.Ini.Config.Raw as I2 |
| 10 | import Data.Monoid | |
| 8 | 11 | import Data.Text (Text) |
| 9 | 12 | import qualified Data.Text as T |
| 10 | 13 | |
| 28 | 31 | toMaps :: I2.Ini -> HashMap Text (HashMap Text Text) |
| 29 | 32 | toMaps (I2.Ini m) = fmap (fmap I2.vValue . I2.isVals) m |
| 30 | 33 | |
| 34 | type AlphaNumText = T.Text | |
| 35 | instance Arbitrary AlphaNumText where | |
| 36 | arbitrary = T.pack <$> (listOf1 $ elements $ | |
| 37 | ['a'..'z'] <> ['A'..'Z'] <> ['0'..'9'] <> [' ']) | |
| 38 | ||
| 31 | 39 | newtype ArbIni = ArbIni I1.Ini deriving (Show) |
| 32 | 40 | |
| 33 | 41 | instance Arbitrary ArbIni where |
| 34 | 42 | arbitrary = (ArbIni . I1.Ini . HM.fromList) `fmap` listOf sections |
| 35 | 43 | where sections = do |
| 36 |
name <- |
|
| 44 | name <- arbitrary :: Gen AlphaNumText | |
| 37 | 45 | sec <- section |
| 38 | 46 | return (name, sec) |
| 39 | str = (T.pack `fmap` arbitrary) `suchThat` (\ t -> | |
| 40 | T.all (\ c -> isAlphaNum c || c == ' ') | |
| 41 | t && not (T.null t)) | |
| 42 | 47 | section = HM.fromList `fmap` listOf kv |
| 43 | 48 | kv = do |
| 44 | name <- str | |
| 45 | val <- str | |
| 49 | name <- arbitrary :: Gen AlphaNumText | |
| 50 | val <- arbitrary :: Gen AlphaNumText | |
| 46 | 51 | return (name, val) |
| 47 | 52 | |
| 48 | 53 | main :: IO () |