Updates for new Hedgehog versions
Getty Ritter
8 years ago
| 1 | {-# LANGUAGE TypeSynonymInstances #-} | |
| 1 | 2 | {-# LANGUAGE TemplateHaskell #-} |
| 3 | {-# LANGUAGE OverloadedStrings #-} | |
| 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} | |
| 2 | 5 | |
| 3 | 6 | module Main where |
| 4 | 7 | |
| 5 | 8 | import qualified Data.Foldable as Fold |
| 9 | import Data.Function (on) | |
| 6 | 10 | import Data.HashMap.Strict (HashMap) |
| 7 | 11 | import qualified Data.HashMap.Strict as HM |
| 8 | 12 | import qualified Data.Ini as I1 |
| 9 | 13 | import qualified Data.Ini.Config.Raw as I2 |
| 10 |
import Data.List (nub |
|
| 14 | import Data.List (nubBy) | |
| 11 | 15 | import qualified Data.Sequence as Seq |
| 12 | 16 | import Data.Text (Text) |
| 13 | 17 | import qualified Data.Text as T |
| 16 | 20 | import qualified Hedgehog.Gen as Gen |
| 17 | 21 | import qualified Hedgehog.Range as Range |
| 18 | 22 | |
| 19 | prop_iniEquiv :: Property | |
| 20 | prop_iniEquiv = property $ do | |
| 23 | propIniEquiv :: Property | |
| 24 | propIniEquiv = property $ do | |
| 21 | 25 | raw <- forAll mkIni |
| 22 | 26 | let printed = I1.printIniWith I1.defaultWriteIniSettings raw |
| 23 | 27 | i1 = I1.parseIni printed |
| 29 | 33 | in i1'' === i2'' |
| 30 | 34 | _ -> failure |
| 31 | 35 | |
| 32 | prop_revIniEquiv :: Property | |
| 33 | prop_revIniEquiv = property $ do | |
| 36 | propRevIniEquiv :: Property | |
| 37 | propRevIniEquiv = property $ do | |
| 34 | 38 | raw <- forAll mkRichIni |
| 35 | 39 | let printed = I2.printIni raw |
| 36 | 40 | i1 = I1.parseIni printed |
| 40 | 44 | lower i1' === toMaps i2' |
| 41 | 45 | _ -> failure |
| 42 | 46 | |
| 43 | prop_iniSelfEquiv :: Property | |
| 44 | prop_iniSelfEquiv = property $ do | |
| 47 | propIniSelfEquiv :: Property | |
| 48 | propIniSelfEquiv = property $ do | |
| 45 | 49 | raw <- forAll mkRichIni |
| 46 | 50 | Right (toMaps raw) === fmap toMaps (I2.parseIni (I2.printIni raw)) |
| 47 | 51 | |
| 69 | 73 | return (I1.Ini (HM.fromList ss)) |
| 70 | 74 | |
| 71 | 75 | mkComments :: Monad m => Gen m (Seq.Seq I2.BlankLine) |
| 72 |
mkComments = fmap |
|
| 76 | mkComments = fmap Seq.fromList $ Gen.list (Range.linear 0 5) $ | |
| 73 | 77 | Gen.choice |
| 74 | 78 | [ return I2.BlankLine |
| 75 | 79 | , I2.CommentLine <$> Gen.element ";#" <*> textChunk |
| 77 | 81 | |
| 78 | 82 | mkRichIni :: Monad m => Gen m I2.Ini |
| 79 | 83 | mkRichIni = do |
| 80 |
ss <- Gen.list (Range.linear 0 10 |
|
| 84 | ss <- Gen.list (Range.linear 0 100) $ do | |
| 81 | 85 | name <- textChunk |
| 82 |
section <- Gen.list (Range.linear 0 10 |
|
| 86 | section <- Gen.list (Range.linear 0 100) $ do | |
| 83 | 87 | k <- textChunk |
| 84 | 88 | v <- textChunk |
| 85 | 89 | cs <- mkComments |
| 88 | 92 | ) |
| 89 | 93 | cs <- mkComments |
| 90 | 94 | return ( T.toLower name |
| 91 |
, I2.IniSection name (Seq.fromList |
|
| 95 | , I2.IniSection name (Seq.fromList (nubBy ((==) `on` fst) section)) 0 0 cs | |
| 92 | 96 | ) |
| 93 |
return (I2.Ini (Seq.fromList |
|
| 97 | return (I2.Ini (Seq.fromList (nubBy ((==) `on` fst) ss))) | |
| 94 | 98 | |
| 95 | 99 | main :: IO () |
| 96 | 100 | main = do |
| 97 |
_ <- |
|
| 101 | _ <- checkParallel $ Group "Test.Example" | |
| 102 | [ ("propIniEquiv", propIniEquiv) | |
| 103 | , ("propRevIniEquiv", propRevIniEquiv) | |
| 104 | , ("propIniSelfEquiv", propIniSelfEquiv) | |
| 105 | ] | |
| 98 | 106 | return () |