summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorkoral <>2019-02-13 18:23:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-02-13 18:23:00 (GMT)
commit5dafef5a54e88fd65ef6a01adc2a1c210db542ab (patch)
tree0dbac350a584fb818c61d2ec0420c0b0c4f6810f /test
parent814967f39542fb170164daa961fc8a76be236734 (diff)
version 0.7.0.00.7.0.0
Diffstat (limited to 'test')
-rw-r--r--test/Arbitrary.hs24
-rw-r--r--test/Main.hs16
2 files changed, 17 insertions, 23 deletions
diff --git a/test/Arbitrary.hs b/test/Arbitrary.hs
index 2e6f5c6..6660c0c 100644
--- a/test/Arbitrary.hs
+++ b/test/Arbitrary.hs
@@ -14,22 +14,15 @@ import Data.ByteString (ByteString)
import Data.Char
import Data.List.NonEmpty
import Data.Maybe
-import Data.MonoTraversable (Element)
-import Data.NonNull
-import Data.Sequences (SemiSequence)
-import Data.Text (Text, find, pack)
+import Data.Text as Text (Text, find, null, pack)
import Data.Text.Encoding
import Data.Time.Clock
import Data.Tree
import Data.Version
-
-import GHC.Generics
-
+import Refined hiding (NonEmpty)
import Test.QuickCheck
import Test.QuickCheck.Instances ()
-
import Text.OPML.Types
-
import URI.ByteString
-- }}}
@@ -94,17 +87,18 @@ genTime = do
-- | Generates 'OutlineBase''s categories.
-- This generator makes sure that the result has no @,@ nor @/@ characters, since those are used as separators.
-genCategoryPath :: Gen (NonEmpty (NonNull Text))
+genCategoryPath :: Gen (NonEmpty (Refined (Not Null) Text))
genCategoryPath = (:|) <$> genCategory <*> listOf genCategory where
- genCategory = genNonNull `suchThat` (isNothing . find (\c -> c == ',' || c == '/') . toNullable)
+ genCategory = arbitrary `suchThat` (isNothing . find (\c -> c == ',' || c == '/') . unrefine)
-- | Alpha-numeric generator.
genAlphaNum :: Gen Char
genAlphaNum = oneof [choose('a', 'z'), suchThat arbitrary isDigit]
--- | Non-empty mono-foldable
-genNonNull :: (SemiSequence a, Arbitrary (Element a), Arbitrary a) => Gen (NonNull a)
-genNonNull = ncons <$> arbitrary <*> arbitrary
+instance Arbitrary (Refined (Not Null) Text) where
+ arbitrary = do
+ ~(Right t) <- refine <$> arbitrary `suchThat` (not . Text.null)
+ return t
instance Arbitrary OpmlHead where
@@ -124,7 +118,7 @@ instance Arbitrary OpmlHead where
shrink = genericShrink
instance Arbitrary OutlineBase where
- arbitrary = OutlineBase <$> genNonNull
+ arbitrary = OutlineBase <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> (Just <$> genTime)
diff --git a/test/Main.hs b/test/Main.hs
index 0c43911..7b39cb9 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -49,7 +49,7 @@ properties = testGroup "Properties"
categoriesCase :: TestTree
categoriesCase = testCase "Parse categories list" $ do
dataFile <- fromString <$> getDataFileName "data/category.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "Illustrating the category attribute"
@@ -61,7 +61,7 @@ categoriesCase = testCase "Parse categories list" $ do
directoryCase :: TestTree
directoryCase = testCase "Parse directory tree" $ do
dataFile <- fromString <$> getDataFileName "data/directory.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "scriptingNewsDirectory.opml"
@@ -82,7 +82,7 @@ directoryCase = testCase "Parse directory tree" $ do
placesCase :: TestTree
placesCase = testCase "Parse places list" $ do
dataFile <- fromString <$> getDataFileName "data/placesLived.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "placesLived.opml"
@@ -104,7 +104,7 @@ placesCase = testCase "Parse places list" $ do
scriptCase :: TestTree
scriptCase = testCase "Parse script" $ do
dataFile <- fromString <$> getDataFileName "data/simpleScript.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "workspace.userlandsamples.doSomeUpstreaming"
@@ -125,7 +125,7 @@ scriptCase = testCase "Parse script" $ do
statesCase :: TestTree
statesCase = testCase "Parse states list" $ do
dataFile <- fromString <$> getDataFileName "data/states.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "states.opml"
@@ -146,7 +146,7 @@ statesCase = testCase "Parse states list" $ do
subscriptionsCase :: TestTree
subscriptionsCase = testCase "Parse subscriptions list" $ do
dataFile <- fromString <$> getDataFileName "data/subscriptionList.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "mySubscriptions.opml"
@@ -162,7 +162,7 @@ subscriptionsCase = testCase "Parse subscriptions list" $ do
length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineSubscription) @?= 13
inverseHeadProperty :: TestTree
-inverseHeadProperty = testProperty "parse . render = id (on OpmlHead)" $ \opmlHead -> either (const False) (opmlHead ==) (runConduit $ renderOpmlHead opmlHead =$= force "Invalid <head>" parseOpmlHead)
+inverseHeadProperty = testProperty "parse . render = id (on OpmlHead)" $ \opmlHead -> either (const False) (opmlHead ==) (runConduit $ renderOpmlHead opmlHead .| force "Invalid <head>" parseOpmlHead)
-- inverseProperty :: TestTree
--- inverseProperty = testProperty "parse . render = id" $ \opml -> either (const False) (opml ==) (runIdentity . runCatchT . runConduit $ renderOpml opml =$= force "Invalid OPML" parseOpml)
+-- inverseProperty = testProperty "parse . render = id" $ \opml -> either (const False) (opml ==) (runIdentity . runCatchT . runConduit $ renderOpml opml .| force "Invalid OPML" parseOpml)