| 1 |
{-# LANGUAGE TemplateHaskell #-}
|
| 2 |
|
| 1 | 3 |
module Main where
|
| 2 | 4 |
|
| 3 | |
import Data.Char
|
| 4 | 5 |
import qualified Data.Foldable as Fold
|
| 5 | 6 |
import Data.HashMap.Strict (HashMap)
|
| 6 | 7 |
import qualified Data.HashMap.Strict as HM
|
|
| 11 | 12 |
import Data.Text (Text)
|
| 12 | 13 |
import qualified Data.Text as T
|
| 13 | 14 |
|
| 14 | |
import Test.QuickCheck
|
| 15 |
import Hedgehog
|
| 16 |
import qualified Hedgehog.Gen as Gen
|
| 17 |
import qualified Hedgehog.Range as Range
|
| 15 | 18 |
|
| 16 | |
myArgs :: Args
|
| 17 | |
myArgs = stdArgs
|
| 18 | |
|
| 19 | |
iniEquiv :: ArbIni -> Bool
|
| 20 | |
iniEquiv (ArbIni raw) = case (i1, i2) of
|
| 19 |
prop_iniEquiv :: Property
|
| 20 |
prop_iniEquiv = property $ do
|
| 21 |
raw <- forAll mkIni
|
| 22 |
let printed = I1.printIniWith I1.defaultWriteIniSettings raw
|
| 23 |
i1 = I1.parseIni printed
|
| 24 |
i2 = I2.parseIni printed
|
| 25 |
case (i1, i2) of
|
| 21 | 26 |
(Right i1', Right i2') ->
|
| 22 | 27 |
let i1'' = lower i1'
|
| 23 | 28 |
i2'' = toMaps i2'
|
| 24 | |
in i1'' == i2''
|
| 25 | |
_ -> False
|
| 26 | |
where pr = I1.printIniWith I1.defaultWriteIniSettings raw
|
| 27 | |
i2 = I2.parseIni pr
|
| 28 | |
i1 = I1.parseIni pr
|
| 29 |
in i1'' === i2''
|
| 30 |
_ -> failure
|
| 29 | 31 |
|
| 30 | |
revIniEquiv :: RichIni -> Bool
|
| 31 | |
revIniEquiv (RichIni raw) = case (i1, i2) of
|
| 32 |
prop_revIniEquiv :: Property
|
| 33 |
prop_revIniEquiv = property $ do
|
| 34 |
raw <- forAll mkRichIni
|
| 35 |
let printed = I2.printIni raw
|
| 36 |
i1 = I1.parseIni printed
|
| 37 |
i2 = I2.parseIni printed
|
| 38 |
case (i1, i2) of
|
| 32 | 39 |
(Right i1', Right i2') ->
|
| 33 | |
let i1'' = lower i1'
|
| 34 | |
i2'' = toMaps i2'
|
| 35 | |
in i1'' == i2''
|
| 36 | |
_ -> False
|
| 37 | |
where pr = I2.printIni raw
|
| 38 | |
i1 = I1.parseIni pr
|
| 39 | |
i2 = I2.parseIni pr
|
| 40 |
lower i1' === toMaps i2'
|
| 41 |
_ -> failure
|
| 42 |
|
| 43 |
prop_iniSelfEquiv :: Property
|
| 44 |
prop_iniSelfEquiv = property $ do
|
| 45 |
raw <- forAll mkRichIni
|
| 46 |
Right (toMaps raw) === fmap toMaps (I2.parseIni (I2.printIni raw))
|
| 40 | 47 |
|
| 41 | 48 |
lower :: I1.Ini -> HashMap Text (HashMap Text Text)
|
| 42 | |
lower (I1.Ini hm) =
|
| 43 | |
HM.fromList [ (T.toLower k, v) | (k, v) <- HM.toList hm ]
|
| 49 |
lower (I1.Ini ini) = go (fmap go ini)
|
| 50 |
where go hm = HM.fromList [ (T.toLower k, v) | (k, v) <- HM.toList hm ]
|
| 44 | 51 |
|
| 45 | 52 |
toMaps :: I2.Ini -> HashMap Text (HashMap Text Text)
|
| 46 | 53 |
toMaps (I2.Ini m) = conv (fmap sectionToPair m)
|
| 47 | |
where sectionToPair (name, section) = ( name
|
| 48 | |
, conv (fmap valueToPair (I2.isVals section))
|
| 49 | |
)
|
| 50 | |
valueToPair (name, value) = (name, I2.vValue value)
|
| 54 |
where sectionToPair (name, section) =
|
| 55 |
(name, conv (fmap valueToPair (I2.isVals section)))
|
| 56 |
valueToPair (name, value) = (T.toLower name, T.strip (I2.vValue value))
|
| 51 | 57 |
conv = HM.fromList . Fold.toList
|
| 52 | 58 |
|
| 53 | |
newtype ArbText = ArbText { fromArbText :: Text } deriving (Show)
|
| 59 |
textChunk :: Monad m => Gen.Gen m Text
|
| 60 |
textChunk = fmap T.pack $ Gen.list (Range.linear 1 20) $ Gen.alphaNum
|
| 54 | 61 |
|
| 55 | |
instance Arbitrary ArbText where
|
| 56 | |
arbitrary = (ArbText . T.pack) `fmap` listOf1 (arbitrary `suchThat` isValid)
|
| 57 | |
where isValid ':' = False
|
| 58 | |
isValid '=' = False
|
| 59 | |
isValid '#' = False
|
| 60 | |
isValid ';' = False
|
| 61 | |
isValid '[' = False
|
| 62 | |
isValid ']' = False
|
| 63 | |
isValid c
|
| 64 | |
| isSpace c = False
|
| 65 | |
| otherwise = True
|
| 62 |
mkIni :: Monad m => Gen.Gen m I1.Ini
|
| 63 |
mkIni = do
|
| 64 |
ss <- Gen.list (Range.linear 0 10) $ do
|
| 65 |
name <- textChunk
|
| 66 |
section <- Gen.list (Range.linear 0 10) $
|
| 67 |
(,) <$> textChunk <*> textChunk
|
| 68 |
return (name, HM.fromList section)
|
| 69 |
return (I1.Ini (HM.fromList ss))
|
| 66 | 70 |
|
| 67 | |
newtype ArbIni = ArbIni I1.Ini deriving (Show)
|
| 71 |
mkComments :: Monad m => Gen.Gen m (Seq.Seq I2.BlankLine)
|
| 72 |
mkComments = fmap (Seq.fromList . nub) $ Gen.list (Range.linear 0 5) $
|
| 73 |
Gen.choice
|
| 74 |
[ return I2.BlankLine
|
| 75 |
, I2.CommentLine <$> Gen.element ";#" <*> textChunk
|
| 76 |
]
|
| 68 | 77 |
|
| 69 | |
instance Arbitrary ArbIni where
|
| 70 | |
arbitrary = (ArbIni . I1.Ini . HM.fromList) `fmap` listOf sections
|
| 71 | |
where sections = do
|
| 72 | |
name <- str
|
| 73 | |
sec <- section
|
| 74 | |
return (name, sec)
|
| 75 | |
str = fromArbText `fmap` arbitrary
|
| 76 | |
section = HM.fromList `fmap` listOf kv
|
| 77 | |
kv = do
|
| 78 | |
name <- str
|
| 79 | |
val <- str
|
| 80 | |
return (name, val)
|
| 81 | |
|
| 82 | |
newtype RichIni = RichIni (I2.Ini) deriving (Show)
|
| 83 | |
|
| 84 | |
instance Arbitrary RichIni where
|
| 85 | |
arbitrary = (RichIni . I2.Ini . Seq.fromList . nub) `fmap` listOf sections
|
| 86 | |
where sections = do
|
| 87 | |
name <- (T.toLower . T.strip) `fmap` str
|
| 88 | |
sec <- section name
|
| 89 | |
return (name, sec)
|
| 90 | |
str = fromArbText `fmap` arbitrary
|
| 91 | |
section n = do
|
| 92 | |
vals <- listOf kv
|
| 93 | |
cs <- Seq.fromList `fmap` listOf comment
|
| 94 | |
return (I2.IniSection n (Seq.fromList $ nub vals) 0 0 cs)
|
| 95 | |
kv = do
|
| 96 | |
name <- T.strip `fmap` str
|
| 97 | |
val <- str
|
| 98 | |
cs <- Seq.fromList `fmap` listOf comment
|
| 99 | |
return (name, I2.IniValue 0 name val cs False '=')
|
| 100 | |
comment = oneof [ return I2.BlankLine
|
| 101 | |
, do { c <- elements ";#"
|
| 102 | |
; txt <- str
|
| 103 | |
; return (I2.CommentLine c txt)
|
| 104 | |
}
|
| 105 | |
]
|
| 78 |
mkRichIni :: Monad m => Gen.Gen m I2.Ini
|
| 79 |
mkRichIni = do
|
| 80 |
ss <- Gen.list (Range.linear 0 10) $ do
|
| 81 |
name <- textChunk
|
| 82 |
section <- Gen.list (Range.linear 0 10) $ do
|
| 83 |
k <- textChunk
|
| 84 |
v <- textChunk
|
| 85 |
cs <- mkComments
|
| 86 |
return ( T.toLower k
|
| 87 |
, I2.IniValue 0 k v cs False '='
|
| 88 |
)
|
| 89 |
cs <- mkComments
|
| 90 |
return ( T.toLower name
|
| 91 |
, I2.IniSection name (Seq.fromList section) 0 0 cs
|
| 92 |
)
|
| 93 |
return (I2.Ini (Seq.fromList ss))
|
| 106 | 94 |
|
| 107 | 95 |
main :: IO ()
|
| 108 | 96 |
main = do
|
| 109 | |
quickCheckWith myArgs revIniEquiv
|
| 110 | |
quickCheckWith myArgs iniEquiv
|
| 97 |
_ <- $$(checkConcurrent)
|
| 98 |
return ()
|