packages feed

network-arbitrary (empty) → 0.1.0.0

raw patch · 9 files changed

+355/−0 lines, 9 filesdep +QuickCheckdep +basedep +hspecsetup-changed

Dependencies added: QuickCheck, base, hspec, network-uri

Files

@@ -0,0 +1,1 @@+Copyright 2018 Alex Brandt <alunduil@alunduil.com>
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for network-arbitrary++## 0.1.0.0  -- 2018-01-05++* First version.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2018 Alex Brandt++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,33 @@+# Description++[Arbitrary] Instances for [Network][network-category] Types++# Getting Started++Documentation is available on [Hackage].  A great guide to [QuickCheck] is+<https://begriffs.com/posts/2017-01-14-design-use-quickcheck.html>.++# Reporting Issues++Any issues discovered should be recorded on [github][issues].  If you believe+you've found an error or have a suggestion for a new feature; please, ensure+that it is reported.++If you would like to contribute a fix or new feature; please, submit a pull+request.  This project follows [git flow] and utilizes [travis] to automatically+check pull requests before a manual review.++# Contributors++The `COPYRIGHT` file contains a list of contributors with their respective+copyrights and other information.  If you submit a pull request and would like+attribution; please, add yourself to the `COPYRIGHT` file.++[Arbitrary]: https://hackage.haskell.org/package/QuickCheck/docs/Test-QuickCheck-Arbitrary.html#t:Arbitrary+[git flow]: http://nvie.com/posts/a-successful-git-branching-model/+[Hackage]: https://hackage.haskell.org/package/network-uri-json+[Haskell]: https://www.haskell.org/+[issues]: https://github.com/alunduil/network-arbitrary/issues+[network-category]: https://hackage.haskell.org/packages/#cat:Network+[QuickCheck]: https://hackage.haskell.org/package/QuickCheck+[travis]: https://travis-ci.org/alunduil/network-arbitrary
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ network-arbitrary.cabal view
@@ -0,0 +1,77 @@+name:                network-arbitrary+version:             0.1.0.0+synopsis:            Arbitrary Instances for Network Types++description:         +  Arbitrary instances for Network types.++homepage:            https://github.com/alunduil/network-arbitrary+bug-reports:         https://github.com/alunduil/network-arbitrary/issues+license:             MIT+license-file:        LICENSE+author:              Alex Brandt+maintainer:          alunduil@alunduil.com+copyright:           (c) 2018 Alex Brandt+category:            Testing+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC >= 7.6 && < 9.0++extra-source-files:+    ChangeLog.md+  , COPYRIGHT+  , LICENSE+  , README.md+  , Setup.hs++source-repository head+  type:     git+  location: https://github.com/alunduil/network-arbitrary+  branch:   develop++library+  default-language:    Haskell2010++  ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction+               -fwarn-unused-do-bind++  hs-source-dirs:+      src++  exposed-modules:+      Network.URI.Arbitrary++  other-modules:++  build-depends:+      base        >= 4.6 && < 4.12+    , network-uri == 2.6.*+    , QuickCheck  >= 2.9 && < 2.11++  other-extensions:++test-suite network-arbitrary-tests+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs++  ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction+               -fwarn-unused-do-bind++  hs-source-dirs:+      src+    , test++  other-modules:+      Network.URI.ArbitrarySpec++  build-tool-depends:+      hspec-discover:hspec-discover == 2.4.*++  build-depends:+      base        >= 4.6 && < 4.12+    , hspec       == 2.4.*+    , network-uri == 2.6.*+    , QuickCheck  >= 2.9 && < 2.11++  other-extensions:
+ src/Network/URI/Arbitrary.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE RecordWildCards #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module      : Network.URI.Arbitrary+Description : Arbitrary Instances for Network.URI+Copyright   : (c) Alex Brandt, 2018+License     : MIT++Arbitrary instances for "Network.URI".+-}+module Network.URI.Arbitrary () where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (replicateM)+import Data.List (intercalate)+import Network.URI (URI (..), URIAuth (..))+import Test.QuickCheck (Arbitrary (arbitrary, shrink), choose, elements, Gen, listOf, listOf1, oneof, suchThat)++instance Arbitrary URI where+  arbitrary =+    do uriScheme    <- scheme+       uriAuthority <- arbitrary :: Gen (Maybe URIAuth)+       uriPath      <- path (null uriScheme) $ maybe True emptyAuthority uriAuthority+       uriQuery     <- oneof [query, return ""]+       uriFragment  <- oneof [fragment, return ""]++       return URI {..}+    where emptyAuthority URIAuth{..} = all null [uriUserInfo, uriRegName, uriPort]++  shrink URI{..} = [ URI uriScheme' uriAuthority' uriPath' uriQuery' uriFragment' | (uriScheme', uriAuthority', uriPath', uriQuery', uriFragment') <- shrink (uriScheme, uriAuthority, uriPath, uriQuery, uriFragment) ]++instance Arbitrary URIAuth where+  arbitrary = URIAuth <$> userinfo+                      <*> host `suchThat` (not . null)+                      <*> port++  shrink URIAuth{..} = [ URIAuth uriUserInfo' uriRegName' uriPort' | (uriUserInfo', uriRegName', uriPort') <- shrink (uriUserInfo, uriRegName, uriPort) ]++-- * RFC 3986 Generators+--+--   Some generators are handled by the 'Arbitrary' instances above, and others+--   are folded into symbols that are preceeded or followed by identifying+--   tokens.++scheme :: Gen String+scheme =+  do a <- alpha+     r <- listOf $ oneof [alpha, digit, elements ['+', '-', '.']]+     return $ a : (r ++ ":")++userinfo :: Gen String+userinfo =+  do u <- concat <$> userinfo'+     if null u+        then return ""+        else return $ u ++ "@"+  where userinfo' = listOf $ oneof [ replicateM 1 $ oneof [unreserved, subDelims, return ':']+                                   , percentEncoded+                                   ]++host :: Gen String+host = oneof [ ipLiteral+             , ipv4Address+             , regName+             ]++port :: Gen String+port =+  do p <- listOf digit+     if null p+        then return ""+        else return $ ':':p++ipLiteral :: Gen String+ipLiteral =+  do x <- oneof [ ipv6Address+                --, ipvFuture+                ]+     return $ "[" ++ x ++ "]"++{- TODO Check that "Network.URI" implements this correctly.+ipvFuture :: Gen String+ipvFuture =+  do h <- hexdig+     o <- oneof [ unreserved, subDelims, return ':' ]+     return ['v', h, '.', o]+-}++ipv6Address :: Gen String+ipv6Address = concat <$> oneof [ sequence                        [b 6, ls32]+                               , sequence           [return "::", b 5, ls32]+                               , sequence      [h16, return "::", b 4, ls32]+                               , sequence [b 1, h16, return "::", b 3, ls32]+                               , sequence [b 2, h16, return "::", b 2, ls32]+                               , sequence [b 3, h16, return "::", b 1, ls32]+                               , sequence [b 4, h16, return "::",      ls32]+                               , sequence [b 5, h16, return "::",       h16]+                               , sequence [b 6, h16, return "::"]+                               ]+  where b n = fmap concat $ replicateM n $ fmap (++ ":") h16 :: Gen String++h16 :: Gen String+h16 = replicateM 4 hexdig++ls32 :: Gen String+ls32 = oneof [ intercalate ":" <$> replicateM 2 h16+             , ipv4Address+             ]++ipv4Address :: Gen String+ipv4Address = intercalate "." <$> replicateM 4 decOctet++decOctet :: Gen String+decOctet = (show :: Int -> String) <$> choose (0, 255)++regName :: Gen String+regName = fmap concat $ listOf $ oneof [ replicateM 1 unreserved+                                       , percentEncoded+                                       , replicateM 1 subDelims+                                       ]++path :: Bool -> Bool -> Gen String+path emptyScheme emptyURIAuth = if emptyURIAuth+                                   then oneof [ pathAbsolute+                                              , if emptyScheme then pathNoScheme else pathRootless+                                              , return ""+                                              ]+                                   else pathAbEmpty++pathAbEmpty :: Gen String+pathAbEmpty = concat <$> listOf ((('/':) . concat) <$> listOf pchar)++pathAbsolute :: Gen String+pathAbsolute = ('/':) <$> oneof [return "", pathRootless]++pathNoScheme :: Gen String+pathNoScheme = concat <$> sequence [segment1nc, pathAbEmpty]++pathRootless :: Gen String+pathRootless = concat <$> sequence [ concat <$> listOf1 pchar+                                   , pathAbEmpty+                                   ]++segment1nc :: Gen String+segment1nc = oneof [ replicateM 1 unreserved+                   , percentEncoded+                   , replicateM 1 subDelims+                   , replicateM 1 $ return '@'+                   ] ++pchar :: Gen String+pchar = oneof [ replicateM 1 unreserved+              , percentEncoded+              , replicateM 1 subDelims+              , replicateM 1 $ return ':'+              , replicateM 1 $ return '@'+              ]++query :: Gen String+query = fmap (('?':) . concat) $ listOf $ oneof [ pchar+                                                , return "/"+                                                , return "?"+                                                ]++fragment :: Gen String+fragment = fmap (('#':) . concat) $ listOf $ oneof [ pchar+                                                   , return "/"+                                                   , return "?"+                                                   ]++percentEncoded :: Gen String+percentEncoded = ('%':) <$> replicateM 2 hexdig++unreserved :: Gen Char+unreserved = oneof [ alpha, digit, elements ['-', '.', '_', '~']]++subDelims :: Gen Char+subDelims = elements ['!', '$', '&', '\'', '(', ')', '*', '+', ',', ';', '=']++-- * RFC 2234 Generators++alpha :: Gen Char+alpha = elements $ ['a'..'z'] ++ ['A'..'Z']++digit :: Gen Char+digit = elements ['0'..'9']++hexdig :: Gen Char+hexdig = oneof [digit, elements ['A'..'F']]
+ test/Network/URI/ArbitrarySpec.hs view
@@ -0,0 +1,25 @@+{-|+Module      : Network.URI.ArbitrarySpec+Description : Tests for Network.URI.Arbitrary+Copyright   : (c) Alex Brandt, 2018+License     : MIT++Tests for "Network.URI.Arbitrary".+-}+module Network.URI.ArbitrarySpec (main, spec) where++import Network.URI (isURIReference, parseURIReference, uriToString)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)++import Network.URI.Arbitrary ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+  describe "properties" $+    do prop "isURIReference (uriToString id u \"\")" $ \ u -> isURIReference (uriToString id u "")++       prop "Just u == parseURIReference (uriToString id u \"\")" $ \ u -> Just u == parseURIReference (uriToString id u "")
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}