diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for network-arbitrary +## 0.6.0.0 -- 2020-04-11 + +* Update project structure. +* Migration to ghc 8.8 +* Update travis.yml with haskell-ci + ## 0.5.0.0 -- 2019-12-13 * Bump upper bounds of dependencies. diff --git a/network-arbitrary.cabal b/network-arbitrary.cabal --- a/network-arbitrary.cabal +++ b/network-arbitrary.cabal @@ -1,20 +1,27 @@ name: network-arbitrary -version: 0.5.0.0 -synopsis: Arbitrary Instances for Network Types - -description: - Arbitrary instances for Network types. +version: 0.6.0.0 -homepage: https://github.com/alunduil/network-arbitrary -bug-reports: https://github.com/alunduil/network-arbitrary/issues license: MIT license-file: LICENSE + +copyright: (c) 2018 Alex Brandt + author: Alex Brandt maintainer: alunduil@gmail.com -copyright: (c) 2018 Alex Brandt + +stability: stable + +homepage: https://github.com/alunduil/network-arbitrary +bug-reports: https://github.com/alunduil/network-arbitrary/issues + +synopsis: Arbitrary Instances for Network Types +description: + Arbitrary instances for Network types. + category: Testing -build-type: Simple + cabal-version: >= 1.10 +build-type: Simple tested-with: GHC >= 7.6 && < 8.2.1 || > 8.2.1 && < 9.0 extra-source-files: @@ -24,72 +31,85 @@ , 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 + if impl(ghc >= 8) { + ghc-options: + -Wcompat + } else { + ghc-options: + -fwarn-monomorphism-restriction + -fwarn-tabs + -fwarn-unused-do-bind + } - ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction - -fwarn-unused-do-bind + default-language: Haskell2010 - hs-source-dirs: - src + build-depends: + base >= 4.6 && < 4.14 + , bytestring == 0.10.* + , http-media >= 0.6 && < 0.9 + , http-types >= 0.9 && < 0.13 + , network-uri == 2.6.* + , QuickCheck >= 2.9 && < 2.14 exposed-modules: Network.Arbitrary , Network.HTTP.Media.MediaType.Arbitrary - , Network.HTTP.Types.Method.Arbitrary + , Network.HTTP.Types.Method.Arbitrary , Network.URI.Arbitrary other-modules: - build-depends: - base >= 4.6 && < 4.13 - , bytestring == 0.10.* - , http-media >= 0.6 && < 0.9 - , http-types >= 0.9 && < 0.13 - , network-uri == 2.6.* - , QuickCheck >= 2.9 && < 2.14 - - other-extensions: - RecordWildCards + hs-source-dirs: + src 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 + ghc-options: + -Wall + if impl(ghc >= 8) { + ghc-options: + -Wcompat + } else { + ghc-options: + -fwarn-monomorphism-restriction + -fwarn-tabs + -fwarn-unused-do-bind + } - hs-source-dirs: - src - , test + default-language: Haskell2010 + build-depends: + base >= 4.6 && < 4.14 + , bytestring == 0.10.* + , case-insensitive == 1.2.* + , hspec >= 2.4 && < 2.8 + , http-media >= 0.6 && < 0.9 + , http-types >= 0.9 && < 0.13 + , network-uri == 2.6.* + , QuickCheck >= 2.9 && < 2.14 + , test-invariant == 0.4.* + + build-tool-depends: + hspec-discover:hspec-discover >= 2.4 && < 2.8 + other-modules: Network.HTTP.Media.MediaType.Arbitrary , Network.HTTP.Media.MediaType.ArbitrarySpec - , Network.HTTP.Types.Method.Arbitrary + , Network.HTTP.Types.Method.Arbitrary , Network.HTTP.Types.Method.ArbitrarySpec , Network.URI.Arbitrary , Network.URI.ArbitrarySpec - build-tool-depends: - hspec-discover:hspec-discover >= 2.4 && < 2.8 - - build-depends: - base >= 4.6 && < 4.13 - , bytestring == 0.10.* - , case-insensitive == 1.2.* - , hspec >= 2.4 && < 2.8 - , http-media >= 0.6 && < 0.9 - , http-types >= 0.9 && < 0.13 - , network-uri == 2.6.* - , QuickCheck >= 2.9 && < 2.14 - , test-invariant == 0.4.* + hs-source-dirs: + src + , test - other-extensions: - RecordWildCards +source-repository head + type: git + location: https://github.com/alunduil/network-arbitrary + branch: develop diff --git a/src/Network/Arbitrary.hs b/src/Network/Arbitrary.hs --- a/src/Network/Arbitrary.hs +++ b/src/Network/Arbitrary.hs @@ -6,8 +6,12 @@ Arbitrary instances for "Network". -} -module Network.Arbitrary () where +module Network.Arbitrary + () +where -import Network.HTTP.Media.MediaType.Arbitrary () -import Network.HTTP.Types.Method.Arbitrary () -import Network.URI.Arbitrary () +import Network.HTTP.Media.MediaType.Arbitrary + ( ) +import Network.HTTP.Types.Method.Arbitrary + ( ) +import Network.URI.Arbitrary ( ) diff --git a/src/Network/HTTP/Media/MediaType/Arbitrary.hs b/src/Network/HTTP/Media/MediaType/Arbitrary.hs --- a/src/Network/HTTP/Media/MediaType/Arbitrary.hs +++ b/src/Network/HTTP/Media/MediaType/Arbitrary.hs @@ -8,17 +8,32 @@ Arbitrary instances for "Network.HTTP.Media.MediaType". -} -module Network.HTTP.Media.MediaType.Arbitrary () where +module Network.HTTP.Media.MediaType.Arbitrary + () +where -import Prelude hiding (concat) +import Prelude hiding ( concat ) -import Control.Applicative ((<*>)) -import Control.Monad (replicateM) -import Data.ByteString (append, concat, ByteString) -import Data.ByteString.Char8 (singleton) -import Data.Functor ((<$>)) -import Network.HTTP.Media.MediaType ((/:), (//), MediaType) -import Test.QuickCheck (Arbitrary (arbitrary), choose, elements, Gen, listOf, oneof, sized) +import Control.Applicative ( (<*>) ) +import Control.Monad ( replicateM ) +import Data.ByteString ( append + , concat + , ByteString + ) +import Data.ByteString.Char8 ( singleton ) +import Data.Functor ( (<$>) ) +import Network.HTTP.Media.MediaType ( (/:) + , (//) + , MediaType + ) +import Test.QuickCheck ( Arbitrary(arbitrary) + , choose + , elements + , Gen + , listOf + , oneof + , sized + ) -- -- @@ -27,32 +42,30 @@ -- printable. Until we can use the new instances in quickcheck-2.10.*, we -- shall simply use restrictedName for the values as well. instance Arbitrary MediaType where - arbitrary = - do n <- (//) <$> restrictedName <*> restrictedName - ps <- listOf $ (,) <$> restrictedName <*> restrictedName -- see parameter note above - return $ foldl (/:) n ps + arbitrary = do + n <- (//) <$> restrictedName <*> restrictedName + ps <- listOf $ (,) <$> restrictedName <*> restrictedName -- see parameter note above + return $ foldl (/:) n ps -- * RFC 6838 Generators restrictedName :: Gen ByteString -restrictedName = sized $ \ s -> - do n <- choose (0, min 126 s) - rs <- concat <$> replicateM n restrictedNameChar - (`append` rs) <$> restrictedNameFirst +restrictedName = sized $ \s -> do + n <- choose (0, min 126 s) + rs <- concat <$> replicateM n restrictedNameChar + (`append` rs) <$> restrictedNameFirst restrictedNameFirst :: Gen ByteString restrictedNameFirst = singleton <$> oneof [alpha, digit] restrictedNameChar :: Gen ByteString -restrictedNameChar = singleton <$> oneof [ alpha - , digit - , elements ['!', '#', '$', '&', '-', '^', '_', '.', '+'] - ] +restrictedNameChar = singleton <$> oneof + [alpha, digit, elements ['!', '#', '$', '&', '-', '^', '_', '.', '+']] -- * RFC 2234 Generators alpha :: Gen Char -alpha = elements $ ['a'..'z'] ++ ['A'..'Z'] +alpha = elements $ ['a' .. 'z'] ++ ['A' .. 'Z'] digit :: Gen Char -digit = elements ['0'..'9'] +digit = elements ['0' .. '9'] diff --git a/src/Network/HTTP/Types/Method/Arbitrary.hs b/src/Network/HTTP/Types/Method/Arbitrary.hs --- a/src/Network/HTTP/Types/Method/Arbitrary.hs +++ b/src/Network/HTTP/Types/Method/Arbitrary.hs @@ -8,19 +8,15 @@ Arbitrary instances for "Network.HTTP.Types.Method". -} -module Network.HTTP.Types.Method.Arbitrary () where +module Network.HTTP.Types.Method.Arbitrary + () +where -import Network.HTTP.Types.Method (StdMethod (..)) -import Test.QuickCheck (Arbitrary (arbitrary), elements) +import Network.HTTP.Types.Method ( StdMethod(..) ) +import Test.QuickCheck ( Arbitrary(arbitrary) + , elements + ) instance Arbitrary StdMethod where - arbitrary = elements [ GET - , POST - , HEAD - , PUT - , DELETE - , TRACE - , CONNECT - , OPTIONS - , PATCH - ] + arbitrary = + elements [GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS, PATCH] diff --git a/src/Network/URI/Arbitrary.hs b/src/Network/URI/Arbitrary.hs --- a/src/Network/URI/Arbitrary.hs +++ b/src/Network/URI/Arbitrary.hs @@ -10,37 +10,62 @@ Arbitrary instances for "Network.URI". -} -module Network.URI.Arbitrary () where +module Network.URI.Arbitrary + () +where -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (replicateM) -import Data.List (intercalate) -import Network.URI (parseURIReference, URI (..), URIAuth (..), uriToString) -import Test.QuickCheck (Arbitrary (arbitrary, shrink), choose, elements, Gen, listOf, listOf1, oneof, suchThat) +import Control.Applicative ( (<$>) + , (<*>) + ) +import Control.Monad ( replicateM ) +import Data.List ( intercalate ) +import Network.URI ( parseURIReference + , URI(..) + , URIAuth(..) + , uriToString + ) +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 ""] + 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] + return URI { .. } + where + emptyAuthority URIAuth {..} = all null [uriUserInfo, uriRegName, uriPort] - shrink URI{..} = filter isURI [ URI uriScheme' uriAuthority' uriPath' uriQuery' uriFragment' | (uriScheme', uriAuthority', uriPath', uriQuery', uriFragment') <- shrink (uriScheme, uriAuthority, uriPath, uriQuery, uriFragment) ] - where isURI u = case parseURIReference (uriToString id u "") of - Just u' -> u' == u - Nothing -> False + shrink URI {..} = filter + isURI + [ URI uriScheme' uriAuthority' uriPath' uriQuery' uriFragment' + | (uriScheme', uriAuthority', uriPath', uriQuery', uriFragment') <- shrink + (uriScheme, uriAuthority, uriPath, uriQuery, uriFragment) + ] + where + isURI u = case parseURIReference (uriToString id u "") of + Just u' -> u' == u + Nothing -> False instance Arbitrary URIAuth where - arbitrary = URIAuth <$> userinfo - <*> host `suchThat` (not . null) - <*> port + arbitrary = URIAuth <$> userinfo <*> host `suchThat` (not . null) <*> port - shrink URIAuth{..} = [ URIAuth uriUserInfo' uriRegName' uriPort' | (uriUserInfo', uriRegName', uriPort') <- shrink (uriUserInfo, uriRegName, uriPort) ] + shrink URIAuth {..} = + [ URIAuth uriUserInfo' uriRegName' uriPort' + | (uriUserInfo', uriRegName', uriPort') <- shrink + (uriUserInfo, uriRegName, uriPort) + ] -- * RFC 3986 Generators -- @@ -49,40 +74,33 @@ -- tokens. scheme :: Gen String -scheme = - do a <- alpha - r <- listOf $ oneof [alpha, digit, elements ['+', '-', '.']] - return $ a : (r ++ ":") +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 - ] +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 - ] +host = oneof [ipLiteral, ipv4Address, regName] port :: Gen String -port = - do p <- listOf digit - if null p - then return "" - else return $ ':':p +port = do + p <- listOf digit + if null p then return "" else return $ ':' : p ipLiteral :: Gen String -ipLiteral = - do x <- oneof [ ipv6Address - --, ipvFuture - ] - return $ "[" ++ x ++ "]" +ipLiteral = do + x <- oneof [ipv6Address + --, ipvFuture + ] + return $ "[" ++ x ++ "]" {- TODO Check that "Network.URI" implements this correctly. ipvFuture :: Gen String @@ -93,25 +111,24 @@ -} 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 "::"] - ] +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 - ] +ls32 = oneof [intercalate ":" <$> replicateM 2 h16, ipv4Address] ipv4Address :: Gen String ipv4Address = intercalate "." <$> replicateM 4 decOctet @@ -120,65 +137,60 @@ decOctet = (show :: Int -> String) <$> choose (0, 255) regName :: Gen String -regName = fmap concat $ listOf $ oneof [ replicateM 1 unreserved - , percentEncoded - , replicateM 1 subDelims - ] +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 + then oneof + [ pathAbsolute + , if emptyScheme then pathNoScheme else pathRootless + , return "" + ] + else pathAbEmpty pathAbEmpty :: Gen String -pathAbEmpty = concat <$> listOf (('/':) . concat <$> listOf pchar) +pathAbEmpty = concat <$> listOf (('/' :) . concat <$> listOf pchar) pathAbsolute :: Gen String -pathAbsolute = ('/':) <$> oneof [return "", pathRootless] +pathAbsolute = ('/' :) <$> oneof [return "", pathRootless] pathNoScheme :: Gen String pathNoScheme = concat <$> sequence [segment1nc, pathAbEmpty] pathRootless :: Gen String -pathRootless = concat <$> sequence [ concat <$> listOf1 pchar - , pathAbEmpty - ] +pathRootless = concat <$> sequence [concat <$> listOf1 pchar, pathAbEmpty] segment1nc :: Gen String -segment1nc = oneof [ replicateM 1 unreserved - , percentEncoded - , replicateM 1 subDelims - , replicateM 1 $ return '@' - ] +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 '@' - ] +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 "?" - ] +query = + fmap (('?' :) . concat) $ listOf $ oneof [pchar, return "/", return "?"] fragment :: Gen String -fragment = fmap (('#':) . concat) $ listOf $ oneof [ pchar - , return "/" - , return "?" - ] +fragment = + fmap (('#' :) . concat) $ listOf $ oneof [pchar, return "/", return "?"] percentEncoded :: Gen String -percentEncoded = ('%':) <$> replicateM 2 hexdig +percentEncoded = ('%' :) <$> replicateM 2 hexdig unreserved :: Gen Char -unreserved = oneof [ alpha, digit, elements ['-', '.', '_', '~']] +unreserved = oneof [alpha, digit, elements ['-', '.', '_', '~']] subDelims :: Gen Char subDelims = elements ['!', '$', '&', '\'', '(', ')', '*', '+', ',', ';', '='] @@ -186,10 +198,10 @@ -- * RFC 2234 Generators alpha :: Gen Char -alpha = elements $ ['a'..'z'] ++ ['A'..'Z'] +alpha = elements $ ['a' .. 'z'] ++ ['A' .. 'Z'] digit :: Gen Char -digit = elements ['0'..'9'] +digit = elements ['0' .. '9'] hexdig :: Gen Char -hexdig = oneof [digit, elements ['A'..'F']] +hexdig = oneof [digit, elements ['A' .. 'F']] diff --git a/test/Network/HTTP/Media/MediaType/ArbitrarySpec.hs b/test/Network/HTTP/Media/MediaType/ArbitrarySpec.hs --- a/test/Network/HTTP/Media/MediaType/ArbitrarySpec.hs +++ b/test/Network/HTTP/Media/MediaType/ArbitrarySpec.hs @@ -6,23 +6,32 @@ Tests for "Network.HTTP.Media.MediaType.Arbitrary". -} -module Network.HTTP.Media.MediaType.ArbitrarySpec (main, spec) where +module Network.HTTP.Media.MediaType.ArbitrarySpec + ( main + , spec + ) +where -import Prelude hiding (null) +import Prelude hiding ( null ) -import Data.ByteString (null) -import Data.CaseInsensitive (original) -import Network.HTTP.Media.MediaType (mainType, subType) -import Test.Hspec (describe, hspec, Spec) -import Test.Hspec.QuickCheck (prop) +import Data.ByteString ( null ) +import Data.CaseInsensitive ( original ) +import Network.HTTP.Media.MediaType ( mainType + , subType + ) +import Test.Hspec ( describe + , hspec + , Spec + ) +import Test.Hspec.QuickCheck ( prop ) -import Network.HTTP.Media.MediaType.Arbitrary () +import Network.HTTP.Media.MediaType.Arbitrary + ( ) main :: IO () main = hspec spec spec :: Spec -spec = - describe "properties" $ - do prop "not . null . mainType" $ not . null . original . mainType - prop "not . null . subType" $ not . null . original . subType +spec = describe "properties" $ do + prop "not . null . mainType" $ not . null . original . mainType + prop "not . null . subType" $ not . null . original . subType diff --git a/test/Network/HTTP/Types/Method/ArbitrarySpec.hs b/test/Network/HTTP/Types/Method/ArbitrarySpec.hs --- a/test/Network/HTTP/Types/Method/ArbitrarySpec.hs +++ b/test/Network/HTTP/Types/Method/ArbitrarySpec.hs @@ -6,19 +6,32 @@ Tests for "Network.HTTP.Types.Method.Arbitrary". -} -module Network.HTTP.Types.Method.ArbitrarySpec (main, spec) where +module Network.HTTP.Types.Method.ArbitrarySpec + ( main + , spec + ) +where -import Network.HTTP.Types.Method (parseMethod, renderStdMethod) -import Test.Hspec (describe, hspec, Spec) -import Test.Hspec.QuickCheck (prop) -import Test.Invariant ((<=>)) +import Network.HTTP.Types.Method ( parseMethod + , renderStdMethod + ) +import Test.Hspec ( describe + , hspec + , Spec + ) +import Test.Hspec.QuickCheck ( prop ) +import Test.Invariant ( (<=>) ) -import Network.HTTP.Types.Method.Arbitrary () +import Network.HTTP.Types.Method.Arbitrary + ( ) main :: IO () main = hspec spec spec :: Spec spec = - describe "properties" $ - prop "parseMethod . renderStdMethod <=> Right" $ parseMethod . renderStdMethod <=> Right + describe "properties" + $ prop "parseMethod . renderStdMethod <=> Right" + $ parseMethod + . renderStdMethod + <=> Right diff --git a/test/Network/URI/ArbitrarySpec.hs b/test/Network/URI/ArbitrarySpec.hs --- a/test/Network/URI/ArbitrarySpec.hs +++ b/test/Network/URI/ArbitrarySpec.hs @@ -6,20 +6,31 @@ Tests for "Network.URI.Arbitrary". -} -module Network.URI.ArbitrarySpec (main, spec) where +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 ( isURIReference + , parseURIReference + , uriToString + ) +import Test.Hspec ( describe + , hspec + , Spec + ) +import Test.Hspec.QuickCheck ( prop ) -import Network.URI.Arbitrary () +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 "") +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 "") + prop "Just u == parseURIReference (uriToString id u \"\")" + $ \u -> Just u == parseURIReference (uriToString id u "")