collection-json 0.1.0.0 → 1.0.0.0

raw patch · 10 files changed

+560/−206 lines, 10 filesdep +QuickCheckdep +network-uridep +quickcheck-instancesdep −bytestringdep ~aesondep ~basedep ~textnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, network-uri, quickcheck-instances, test-invariant

Dependencies removed: bytestring

Dependency ranges changed: aeson, base, text

API changes (from Hackage documentation)

Files

• COPYRIGHT +1/−0
• ChangeLog.md +9/−0
• README.md +31/−4
• Text/JSON/CollectionJSON/Types.hs +0/−181
• collection-json.cabal +81/−21
• src/Data/CollectionJSON.hs +235/−0
• src/Internal/Network/URI.hs +26/−0
• test/Data/CollectionJSON/Tests.hs +111/−0
• test/Internal/Network/URI/Tests.hs +49/−0
• test/Main.hs +17/−0

@@ -0,0 +1,1 @@+Copyright 2017 Alex Brandt <alunduil@alunduil.com>

@@ -0,0 +1,9 @@+# Revision history for collection-json++## 1.0.0.0  -- 2017-08-05++* Add Property Test Suite+* Add Code of Conduct+* Update README+* Add Travis CI Configuration+* Other Package Updates

@@ -1,8 +1,35 @@-# collection-json+# Description -A Haskell supporting library for the Collection+JSON media type.+[Collection+JSON] Tools -In progess.+Types, classes, and functions for using the+[Collection+JSON—Hypermedia Type][Collection+JSON] in [Haskell]. +# Getting Started -See <http://amundsen.com/media-types/collection/> for information about this media type.+Documentation is available on [Hackage] and information about+`application/vnd.collection+json` can be found at+<http://amundsen.com/media-types/collection/>.++# 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.++[Collection+JSON]: http://amundsen.com/media-types/collection/+[git flow]: http://nvie.com/posts/a-successful-git-branching-model/+[Hackage]: https://hackage.haskell.org/package/collection-json+[Haskell]: https://www.haskell.org/+[issues]: https://github.com/alunduil/collection-json.hs/issues+[travis]: https://travis-ci.org/alunduil/collection-json.hs

@@ -1,181 +0,0 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards #-} -module Text.JSON.CollectionJSON.Types where-import Data.Aeson hiding (Error)-import Data.Text (Text)-import Control.Applicative--data Collection = Collection {-    cVersion :: Text-  , cHref :: Text-  , cLinks :: [Link]-  , cItems :: [Item]-  , cQueries :: [Query]-  , cTemplate :: Maybe Template-  , cError :: Maybe Error-  } deriving Show--data Error = Error {-    eTitle :: Text-  , eCode :: Maybe Text-  , eMessage :: Maybe Text-  } deriving Show--{- Each has five possible properties: href (REQUIRED), rel (REQURIED), name (OPTIONAL), render (OPTIONAL), and prompt, (OPTIONAL).--}--data Link = Link {-    lHref :: Text-  , lRel :: Text-  , lName :: Maybe Text-  , lRender :: Maybe Text-  , lPrompt :: Maybe Text-  } deriving Show-  -{- The queries array SHOULD contain one or more anonymous objects. Each object composed of five possible properties: href (REQUIRED), rel (REQUIRED), name (OPTIONAL), prompt (OPTIONAL), and a data array (OPTIONAL). -}--data Query = Query {-    qHref :: Text-  , qRel :: Text-  , qName :: Maybe Text-  , qPrompt :: Maybe Text-  , qData :: [Data]-  } deriving Show--{- The data array SHOULD contain one or more anonymous objects. Each -object MAY have any of three possible properties: name (REQUIRED), value-(OPTIONAL), and prompt (OPTIONAL). -}--data Data = Data { -    dName :: Text-  , dValue :: Maybe Text-  , dPrompt :: Maybe Text-  } deriving Show--{- Each element in the items array SHOULD contain an href property. The-href property MUST contain a URI. This URI MAY be used to retrieve a-Collection+JSON document representing the associated item. It MAY be used-to edit or delete the associated item. See Reading and Writing Data for-details.--The items array MAY have a data array child property.--The items array MAY have a links array child property.--}--data Item = Item {-    iHref :: Text-  , iData :: [Data]-  , iLinks :: [Link]-  } deriving Show--{- The template object SHOULD have a data array child property. -}---data Template = Template {-    tData :: [Data]-  } deriving Show- ---------------------------------------------------------------------------- FromJSON instances--instance FromJSON Template where-    parseJSON (Object v) = Template <$> v .: "data" --instance FromJSON Item where-    parseJSON (Object v) = Item -        <$> v .: "href" -        <*> v .:? "data" .!= [] -        <*> v .:? "links" .!= []--instance FromJSON Data where-    parseJSON (Object v) = Data-        <$> v .: "name"-        <*> v .:? "value"-        <*> v .:? "prompt"--instance FromJSON Query where-    parseJSON (Object v) = Query-        <$> v .: "href"-        <*> v .: "rel"-        <*> v .:? "name"-        <*> v .:? "prompt"-        <*> v .:? "data" .!= []--instance FromJSON Link where-    parseJSON (Object v) = Link-        <$> v .: "href"-        <*> v .: "rel"-        <*> v .:? "name"-        <*> v .:? "render"-        <*> v .:? "prompt"--instance FromJSON Error where-    parseJSON (Object v) = Error-        <$> v .: "title"-        <*> v .:? "code"-        <*> v .:? "message"--instance FromJSON Collection where-    parseJSON (Object v) = Collection -        <$> v .: "version" -        <*> v .: "href" -        <*> v .:? "links" .!= []-        <*> v .:? "items" .!= []-        <*> v .:? "queries" .!= []-        <*> v .:? "template" -        <*> v .:? "error" ----------------------------------------------------------------------------instance ToJSON Template where-    toJSON Template{..} = object [ "data" .= tData ]--instance ToJSON Item where-    toJSON Item{..} = object [ -        "href" .= iHref-      , "data" .= iData-      , "links" .= iLinks-      ]--instance ToJSON Data where-    toJSON Data{..} = object [ -        "name" .= dName-      , "data" .= dValue-      , "prompt" .= dPrompt-      ]--instance ToJSON Query where-    toJSON Query{..} = object [ -        "href" .= qHref-      , "rel" .= qRel-      , "name" .= qName-      , "prompt" .= qPrompt-      , "data" .= qData-      ]--instance ToJSON Link where-    toJSON Link{..} = object [ -        "href" .= lHref-      , "rel" .= lRel-      , "name" .= lName-      , "render" .= lRender-      , "prompt" .= lPrompt-      ]--instance ToJSON Error where-    toJSON Error{..} = object [ -        "title" .= eTitle-      , "code" .= eCode-      , "message" .= eMessage-      ]--instance ToJSON Collection where-    toJSON Collection{..} = object [ -        "version" .= cVersion-      , "href" .= cHref-      , "links" .= cLinks-      , "items" .= cItems-      , "queries" .= cQueries-      , "template" .= cTemplate-      , "error" .= cError-      ]

@@ -1,28 +1,88 @@--- Initial collection-json.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/- name:                collection-json-version:             0.1.0.0-synopsis:            Collection+JSON hypermedia type tools-homepage:            https://github.com/danchoi/collection-json.hs-description:         Collection+JSON hypermedia type tools+version:             1.0.0.0+synopsis:            Collection+JSON—Hypermedia Type Tools++description:+  Types, classes, and functions for using the Collection+JSON—Hypermedia Type+  in Haskell.++homepage:            https://github.com/alunduil/collection-json.hs+bug-reports:         https://github.com/alunduil/collection-json.hs/issues license:             MIT license-file:        LICENSE-author:              Daniel Choi-maintainer:          dhchoi@gmail.com-copyright:           2015 Daniel Choi-category:            Web+author:              Alex Brandt+maintainer:          alunduil@alunduil.com+copyright:           (c) 2017 Alex Brandt+category:            Data build-type:          Simple--- extra-source-files:   cabal-version:       >=1.10+tested-with:         GHC ==8.0.2 +extra-source-files:+    ChangeLog.md+  , COPYRIGHT+  , LICENSE+  , README.md+  , Setup.hs+  , test/Data/CollectionJSON/Tests.hs+  , test/Internal/Network/URI/Tests.hs+  , test/Main.hs++source-repository head+  type:     git+  location: https://github.com/alunduil/collection+json.hs+  branch:   develop+ library-  exposed-modules:     Text.JSON.CollectionJSON.Types-  -- other-modules:       -  -- other-extensions:    -  build-depends:       base >=4.6 && <4.8-                     , aeson >= 0.8-                     , text-                     , bytestring-  -- hs-source-dirs:      -  default-language:    Haskell2010+  default-language: Haskell2010+  hs-source-dirs:   src++  exposed-modules:+      Data.CollectionJSON++  ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction+               -fwarn-unused-do-bind++  other-modules:+      Internal.Network.URI++  build-depends:+      aeson       >= 0.8 && < 1.1+    , base        >= 4.6 && < 4.10+    , network-uri == 2.6.*+    , text        == 1.2.*++  other-extensions:+      OverloadedStrings+    , RecordWildCards++test-suite Properties+  default-language: Haskell2010+  hs-source-dirs:   src test++  type:             exitcode-stdio-1.0+  main-is:          Main.hs++  ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction+               -fwarn-unused-do-bind++  other-modules:+      Data.CollectionJSON+      Data.CollectionJSON.Tests++      Internal.Network.URI+      Internal.Network.URI.Tests++  build-depends:+      aeson                >= 0.8 && < 1.1+    , base                 >= 4.6 && < 4.10+    , network-uri          == 2.6.*+    , QuickCheck           == 2.9.*+    , quickcheck-instances == 0.3.*+    , test-invariant       == 0.4.*+    , text                 == 1.2.*++  other-extensions:+      OverloadedStrings+    , RecordWildCards+    , TemplateHaskell

@@ -0,0 +1,235 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+Module      : Data.CollectionJSON+Description : Types and Instances for @application/vnd.collection+json@+Copyright   : (c) Alex Brandt, 2017+License     : MIT++A collection of types and instances for @application/vnd.collection+json@.++Full documentation for @application/vnd.collection+json@ can be found at+<http://amundsen.com/media-types/collection/>.+-}+module Data.CollectionJSON where++import Data.Aeson ((.=), (.:?), (.!=), (.:), FromJSON (parseJSON), object, ToJSON (toJSON), withObject)+import Data.Text (Text)+import Network.URI (URI)++import Internal.Network.URI ()++-- * Core Data Types++-- | The top-level object for an @application/vnd.collection+json@ resource.+data Collection = Collection+  { cVersion  :: Text           -- ^ Currently, always "1.0".+  , cHref     :: URI            -- ^ Address used to retrieve the 'Collection'+                                --   and to add new elements.+  , cLinks    :: [Link]+  , cItems    :: [Item]+  , cQueries  :: [Query]+  , cTemplate :: Maybe Template+  , cError    :: Maybe Error+  } deriving (Eq, Show)++instance FromJSON Collection where+  parseJSON = withObject "Collection" $ \ c -> do+    v <- c .: "collection"++    cVersion  <- v .:? "version"  .!= "1.0"+    cHref     <- v .:  "href"+    cLinks    <- v .:? "links"    .!= []+    cItems    <- v .:? "items"    .!= []+    cQueries  <- v .:? "queries"  .!= []+    cTemplate <- v .:? "template"+    cError    <- v .:? "error"++    return Collection{..}++instance ToJSON Collection where+  toJSON Collection{..} = object+    [ "collection" .= object+      [ "version"  .= cVersion+      , "href"     .= cHref+      , "links"    .= cLinks+      , "items"    .= cItems+      , "queries"  .= cQueries+      , "template" .= cTemplate+      , "error"    .= cError+      ]+    ]++{-|+A link to a related resource (not necessarily an+@application/vnd.collection+json@ resource).+-}+data Link = Link+  { lHref   :: URI        -- ^ Address of the resource.+  , lRel    :: Text       -- ^ Relation---the following contain suggested+                          --   relation values:+                          --+                          --   * [IANA Link Relations](http://www.iana.org/assignments/link-relations/link-relations.xml)+                          --   * [Microformat Existing Rel Values](http://microformats.org/wiki/existing-rel-values)+                          --   * [RFC5988](http://tools.ietf.org/html/rfc5988)+  , lName   :: Maybe Text+  , lRender :: Maybe Text+  , lPrompt :: Maybe Text+  } deriving (Eq, Show)++instance FromJSON Link where+  parseJSON = withObject "Link" $ \ v -> do+    lHref   <- v .:  "href"+    lRel    <- v .:  "rel"+    lName   <- v .:? "name"+    lRender <- v .:? "render"+    lPrompt <- v .:? "prompt"++    return Link{..}++instance ToJSON Link where+  toJSON Link{..} = object+    [ "href"   .= lHref+    , "rel"    .= lRel+    , "name"   .= lName+    , "render" .= lRender+    , "prompt" .= lPrompt+    ]++-- | An element in the 'Collection'+data Item = Item+  { iHref  :: URI    -- ^ Address of the resource used to retrieve, modify, or+                     --   delete the element.+  , iData  :: [Datum]+  , iLinks :: [Link]+  } deriving (Eq, Show)++instance FromJSON Item where+  parseJSON = withObject "Item" $ \ v -> do+    iHref  <- v .:  "href"+    iData  <- v .:? "data"  .!= []+    iLinks <- v .:? "links" .!= []++    return Item{..}++instance ToJSON Item where+  toJSON Item{..} = object+    [ "href"  .= iHref+    , "data"  .= iData+    , "links" .= iLinks+    ]++{-|+A template for possible queries related to this 'Collection'.++A query should correspond to an associated HTTP GET request.++The Query:+> Query "http://example.com/search" "search" Nothing (Just "Search:") [Datum "search" "" Nothing]++Corresponds with the following URI for an HTTP GET:+> http://example.com/search?search={search_terms}+-}+data Query = Query+  { qHref   :: URI        -- ^ Address of reqeust's target.+  , qRel    :: Text       -- ^ Relation---the following contain suggested+                          --   relation values:+                          --+                          --   * [IANA Link Relations](http://www.iana.org/assignments/link-relations/link-relations.xml)+                          --   * [Microformat Existing Rel Values](http://microformats.org/wiki/existing-rel-values)+                          --   * [RFC5988](http://tools.ietf.org/html/rfc5988)+  , qName   :: Maybe Text -- ^ Identifier for this 'Query'.+  , qPrompt :: Maybe Text -- ^ Suggested user prompt.+  , qData   :: [Datum]    -- ^ Query parameters for this 'Query'.+  } deriving (Eq, Show)++instance FromJSON Query where+  parseJSON = withObject "Query" $ \ v -> do+    qHref   <- v .:  "href"+    qRel    <- v .:  "rel"+    qName   <- v .:? "name"+    qPrompt <- v .:? "prompt"+    qData   <- v .:? "data"   .!= []++    return Query{..}++instance ToJSON Query where+  toJSON Query{..} = object+    [ "href"   .= qHref+    , "rel"    .= qRel+    , "name"   .= qName+    , "prompt" .= qPrompt+    , "data"   .= qData+    ]++-- | A fillable template for creation of a new object in the 'Collection'.+newtype Template = Template+  { tData :: [Datum]+  } deriving (Eq, Show)++instance FromJSON Template where+  parseJSON = withObject "Template" $ \ v -> do+    tData <- v .:? "data" .!= []++    return Template{..}++instance ToJSON Template where+  toJSON Template{..} = object+    [ "data" .= tData+    ]++-- | Information about latest error that occured when responding to a request.+data Error = Error+  { eTitle   :: Maybe Text+  , eCode    :: Maybe Text -- ^ Unique identifier (e.g. session identifier,+                           --   request tracker, etc).+  , eMessage :: Maybe Text+  } deriving (Eq, Show)++instance FromJSON Error where+  parseJSON = withObject "Error" $ \ v -> do+    eTitle   <- v .:? "title"+    eCode    <- v .:? "code"+    eMessage <- v .:? "message"++    return Error{..}++instance ToJSON Error where+  toJSON Error{..} = object+    [ "title"   .= eTitle+    , "code"    .= eCode+    , "message" .= eMessage+    ]++-- | Contents of a 'Collection' 'Item'.+data Datum = Datum+  { dName   :: Text       -- ^ Identifier for this 'Datum'.+  , dValue  :: Maybe Text+  , dPrompt :: Maybe Text -- ^ Suggested user prompt.+  } deriving (Eq, Show)++instance FromJSON Datum where+  parseJSON = withObject "Datum" $ \ v -> do+    dName   <- v .:  "name"+    dValue  <- v .:? "value"+    dPrompt <- v .:? "prompt"++    return Datum{..}++instance ToJSON Datum where+  toJSON Datum{..} = object+    [ "name"   .= dName+    , "value"  .= dValue+    , "prompt" .= dPrompt+    ]++-- * Type Conversion++-- | A type that can be converted from 'Collection'.+class FromCollection a where+  fromCollection :: Collection -> a++-- | A type that can be converted to 'Collection'.+class ToCollection a where+  toCollection :: a -> Collection

@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Internal.Network.URI+Description : URI Helper Functions+Copyright   : (c) Alex Brandt, 2017+License     : MIT++URI utility functions that don't belong anywhere else.+-}+module Internal.Network.URI where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)+import Data.Text (unpack)+import Network.URI (parseURIReference, URI)++instance FromJSON URI where+  parseJSON = withText "URI" $ \ v ->+    case parseURIReference (unpack v) of+      Nothing -> fail "invalid URI"+      Just x  -> return x++instance ToJSON URI where+  toJSON = toJSON . show

@@ -0,0 +1,111 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++{-|+Module      : Data.CollectionJSON.Tests+Description : Tests for Data.CollectionJSON+Copyright   : (c) Alex Brandt, 2017+License     : MIT++Tests for "Data.CollectionJSON".+-}+module Data.CollectionJSON.Tests (runTests) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust)+import Data.Text (pack)+import Test.Invariant ((<=>))+import Test.QuickCheck (Arbitrary (arbitrary), quickCheckAll)+import Test.QuickCheck.Instances ()++import Data.CollectionJSON+import Internal.Network.URI.Tests ()++prop_id_c :: Collection -> Bool+prop_id_c = fromJust . decode . encode <=> id++prop_id_l :: Link -> Bool+prop_id_l = fromJust . decode . encode <=> id++prop_id_i :: Item -> Bool+prop_id_i = fromJust . decode . encode <=> id++prop_id_q :: Query -> Bool+prop_id_q = fromJust . decode . encode <=> id++prop_id_t :: Template -> Bool+prop_id_t = fromJust . decode . encode <=> id++prop_id_e :: Error -> Bool+prop_id_e = fromJust . decode . encode <=> id++prop_id_d :: Datum -> Bool+prop_id_d = fromJust . decode . encode <=> id++return []+runTests :: IO Bool+runTests = $quickCheckAll++instance Arbitrary Collection where+  arbitrary =+    do let cVersion = pack "1.0"+       cHref     <- arbitrary+       cLinks    <- arbitrary+       cItems    <- arbitrary+       cQueries  <- arbitrary+       cTemplate <- arbitrary+       cError    <- arbitrary++       return Collection{..}++instance Arbitrary Link where+  arbitrary =+    do lHref   <- arbitrary+       lRel    <- arbitrary+       lName   <- arbitrary+       lRender <- arbitrary+       lPrompt <- arbitrary++       return Link{..}++instance Arbitrary Item where+  arbitrary =+    do iHref  <- arbitrary+       iData  <- arbitrary+       iLinks <- arbitrary++       return Item{..}++instance Arbitrary Query where+  arbitrary =+    do qHref   <- arbitrary+       qRel    <- arbitrary+       qName   <- arbitrary+       qPrompt <- arbitrary+       qData   <- arbitrary++       return Query{..}++instance Arbitrary Template where+  arbitrary =+    do tData <- arbitrary+       +       return Template{..}++instance Arbitrary Error where+  arbitrary =+    do eTitle   <- arbitrary+       eCode    <- arbitrary+       eMessage <- arbitrary++       return Error{..}++instance Arbitrary Datum where+  arbitrary =+    do dName   <- arbitrary+       dValue  <- arbitrary+       dPrompt <- arbitrary++       return Datum{..}

@@ -0,0 +1,49 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE RecordWildCards #-}++{-|+Module      : Internal.Network.URI.Tests+Description : URI Arbitrary Instances+Copyright   : (c) Alex Brandt, 2017+License     : MIT++A collection of 'Arbitrary' instances for 'URI'.+-}+module Internal.Network.URI.Tests where++import Data.Maybe (fromJust)+import Network.URI (parseURIReference, URI)+import Test.QuickCheck (Arbitrary (arbitrary), elements)++-- | Not a general implementation.+--+--   This implementation just returns a random URI from the+--   @application/vnd.collection+json@ examples.+instance Arbitrary URI where+  arbitrary = fromJust . parseURIReference <$> elements uris+    where uris = [ "http://example.org/friends/"+                 , "http://example.org/friends/"+                 , "http://example.org/friends/rss"+                 , "http://example.org/friends/jdoe"+                 , "http://examples.org/blogs/jdoe"+                 , "http://examples.org/images/jdoe"+                 , "http://example.org/friends/msmith"+                 , "http://examples.org/blogs/msmith"+                 , "http://examples.org/images/msmith"+                 , "http://example.org/friends/rwilliams"+                 , "http://examples.org/blogs/rwilliams"+                 , "http://examples.org/images/rwilliams"+                 , "http://example.org/friends/search"+                 , "http://example.org/friends/"+                 , "http://example.org/friends/rss"+                 , "http://example.org/friends/?queries"+                 , "http://example.org/friends/?template"+                 , "http://example.org/friends/jdoe"+                 , "http://examples.org/blogs/jdoe"+                 , "http://examples.org/images/jdoe"+                 , "http://example.org/friends/"+                 , "http://example.org/friends/search"+                 , "http://example.org/friends/"+                 , "http://example.org/friends/"+                 ]

@@ -0,0 +1,17 @@+{-|+Module      : Main+Copyright   : (c) Alex Brandt, 2017+License     : MIT++"Main" Module for collection-json property tests.+-}+module Main where++import System.Exit (exitFailure, exitSuccess)++import qualified Data.CollectionJSON.Tests++main :: IO ()+main =+  do success <- and <$> sequence [ Data.CollectionJSON.Tests.runTests ]+     if success then exitSuccess else exitFailure