packages feed

network-uri-json (empty) → 0.1.0.0

raw patch · 11 files changed

+416/−0 lines, 11 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, hspec, network-uri, test-invariant, text

Files

@@ -0,0 +1,1 @@+Copyright 2017 Alex Brandt <alunduil@alunduil.com>
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for network-uri-json++## 0.1.0.0  -- 2017-11-11++* First version.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 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,34 @@+# Description++[FromJSON] and [ToJSON] Instances for [Network.URI][network-uri]++# Getting Started++Documentation is available on [Hackage].  A beginner's guide to+[Data.Aeson][aeson] is <https://artyom.me/aeson>.++# 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.++[aeson]: https://hackage.haskell.org/package/aeson+[FromJSON]: https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:FromJSON+[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-uri-json/issues+[network-uri]: https://hackage.haskell.org/package/network-uri+[ToJSON]: https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:ToJSON+[travis]: https://travis-ci.org/alunduil/network-uri-json
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ network-uri-json.cabal view
@@ -0,0 +1,87 @@+name:                network-uri-json+version:             0.1.0.0+synopsis:            FromJSON and ToJSON Instances for Network.URI++description:+  FromJSON and ToJSON instancse for Network.URI.++homepage:            https://github.com/alunduil/network-uri-json+bug-reports:         https://github.com/alunduil/network-uri-json/issues+license:             MIT+license-file:        LICENSE+author:              Alex Brandt+maintainer:          alunduil@alunduil.com+copyright:           (c) 2017 Alex Brandt+category:            Network+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-uri-json+  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.JSON++  other-modules:++  build-depends:+      aeson       >= 0.8 && < 1.2+    , base        >= 4.6 && < 4.12+    , network-uri == 2.6.*+    , text        == 1.2.*++  other-extensions:+      OverloadedStrings++test-suite network-uri-json-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:+      External.Network.URI.Arbitrary+    , External.Network.URI.ArbitrarySpec+    , Network.URI.JSON+    , Network.URI.JSONSpec++  build-tool-depends:+      hspec-discover:hspec-discover == 2.4.*++  build-depends:+      aeson          >= 0.8 && < 1.2+    , base           >= 4.6 && < 4.12+    , hspec          == 2.4.*+    , network-uri    == 2.6.*+    , QuickCheck     == 2.9.*+    , test-invariant == 0.4.*+    , text           == 1.2.*++  other-extensions:+      OverloadedStrings+    , RecordWildCards
+ src/Network/URI/JSON.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Network.URI.JSON+Description : URI FromJSON and ToJSON Instances+Copyright   : (c) Alex Brandt, 2017+License     : MIT++URI Instances for FromJSON and ToJSON+-}+module Network.URI.JSON where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)+import Data.Text (unpack)+import Network.URI (parseURIReference, URI, uriToString)++instance FromJSON URI where+  parseJSON = withText "URI" $ maybe (fail "invalid URI") return . parseURIReference . unpack++instance ToJSON URI where+  toJSON u = toJSON $ uriToString id u ""
+ test/External/Network/URI/Arbitrary.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE RecordWildCards #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module      : External.Network.URI.Arbitrary+Description : Arbitrary Instances for Network.URI+Copyright   : (c) Alex Brandt, 2017+License     : MIT++Arbitrary instances for "Network.URI".+-}+module External.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/External/Network/URI/ArbitrarySpec.hs view
@@ -0,0 +1,25 @@+{-|+Module      : External.Network.URI.ArbitrarySpec+Description : Tests for External.Network.URI.Arbitrary+Copyright   : (c) Alex Brandt, 2017+License     : MIT++Tests for "External.Network.URI.Arbitrary".+-}+module External.Network.URI.ArbitrarySpec (main, spec) where++import Network.URI (isURIReference, parseURIReference, uriToString)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)++import External.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/Network/URI/JSONSpec.hs view
@@ -0,0 +1,27 @@+{-|+Module      : Network.URI.JSONSpec+Description : Tests for Network.URI.JSON+Copyright   : (c) Alex Brandt, 2017+License     : MIT++Tests for "Network.URI.JSON".+-}+module Network.URI.JSONSpec (main, spec) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust)+import Network.URI (URI)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)+import Test.Invariant ((<=>))++import External.Network.URI.Arbitrary ()+import Network.URI.JSON ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+  describe "properties" $+    prop "fromJust . decode . encode == id" (fromJust . decode . encode <=> id :: URI -> Bool)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}