siren-json (empty) → 0.1.0.0
raw patch · 23 files changed
+1152/−0 lines, 23 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, case-insensitive, containers, hspec, http-media, http-types, network-uri, quickcheck-instances, test-invariant, text, unordered-containers
Files
- COPYRIGHT +1/−0
- ChangeLog.md +5/−0
- LICENSE +20/−0
- README.md +34/−0
- Setup.hs +2/−0
- siren-json.cabal +111/−0
- src/Data/SirenJSON.hs +263/−0
- src/External/Network/HTTP/Media/MediaType/JSON.hs +22/−0
- src/External/Network/HTTP/Types/Method/JSON.hs +22/−0
- src/External/Network/URI/JSON.hs +23/−0
- test/Data/SirenJSON/Arbitrary.hs +79/−0
- test/Data/SirenJSON/Norm.hs +56/−0
- test/Data/SirenJSONSpec.hs +84/−0
- test/External/Network/HTTP/Media/MediaType/Arbitrary.hs +58/−0
- test/External/Network/HTTP/Media/MediaType/ArbitrarySpec.hs +28/−0
- test/External/Network/HTTP/Media/MediaType/JSONSpec.hs +27/−0
- test/External/Network/HTTP/Types/Method/Arbitrary.hs +26/−0
- test/External/Network/HTTP/Types/Method/ArbitrarySpec.hs +24/−0
- test/External/Network/HTTP/Types/Method/JSONSpec.hs +27/−0
- test/External/Network/URI/Arbitrary.hs +187/−0
- test/External/Network/URI/ArbitrarySpec.hs +25/−0
- test/External/Network/URI/JSONSpec.hs +27/−0
- test/Spec.hs +1/−0
+ COPYRIGHT view
@@ -0,0 +1,1 @@+Copyright 2017 Alex Brandt <alunduil@alunduil.com>
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for siren-json++## 0.1.0.0 -- 2017-11-08++* 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++[Siren] Tools++Types, classes, and functions for using [Siren][siren] in [Haskell].++# Getting Started++Documentation is available on [Hackage] and information about+`application/vnd.siren+json` can be found at+<https://github.com/kevinswiber/siren>.++# 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.++[siren]: 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/siren-json.hs/issues+[travis]: https://travis-ci.org/alunduil/siren-json.hs
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ siren-json.cabal view
@@ -0,0 +1,111 @@+name: siren-json+version: 0.1.0.0+synopsis: Siren Tools for Haskell++description: + Types, classes, and functions for using the Siren—Hypermedia Type in Haskell.++homepage: https://github.com/alunduil/siren-json.hs+bug-reports: https://github.com/alunduil/siren-json.hs/issues+license: MIT+license-file: LICENSE+author: Alex Brandt+maintainer: alunduil@alunduil.com+copyright: (c) 2017 Alex Brandt+category: Data+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/siren-json.git+ branch: develop++library+ default-language: Haskell2010++ ghc-options: -Wall -fwarn-tabs -fwarn-monomorphism-restriction+ -fwarn-unused-do-bind++ hs-source-dirs:+ src++ exposed-modules:+ Data.SirenJSON++ other-modules:+ External.Network.HTTP.Media.MediaType.JSON+ , External.Network.HTTP.Types.Method.JSON+ , External.Network.URI.JSON++ build-depends:+ aeson >= 0.8 && < 1.2+ , base >= 4.6 && < 4.12+ , bytestring == 0.10.*+ , containers == 0.5.*+ , http-media == 0.6.*+ , http-types == 0.9.*+ , network-uri == 2.6.*+ , text == 1.2.*+ , unordered-containers == 0.2.*++ other-extensions:++test-suite siren-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:+ Data.SirenJSON+ , Data.SirenJSON.Arbitrary+ , Data.SirenJSON.Norm+ , Data.SirenJSONSpec+ , External.Network.HTTP.Media.MediaType.Arbitrary+ , External.Network.HTTP.Media.MediaType.ArbitrarySpec+ , External.Network.HTTP.Media.MediaType.JSON+ , External.Network.HTTP.Media.MediaType.JSONSpec+ , External.Network.HTTP.Types.Method.Arbitrary+ , External.Network.HTTP.Types.Method.ArbitrarySpec+ , External.Network.HTTP.Types.Method.JSON+ , External.Network.HTTP.Types.Method.JSONSpec+ , External.Network.URI.Arbitrary+ , External.Network.URI.ArbitrarySpec+ , External.Network.URI.JSON+ , External.Network.URI.JSONSpec++ build-tool-depends:+ hspec-discover:hspec-discover == 2.4.*++ build-depends:+ aeson >= 0.8 && < 1.2+ , base >= 4.6 && < 4.12+ , bytestring == 0.10.*+ , case-insensitive == 1.2.*+ , containers == 0.5.*+ , hspec == 2.4.*+ , http-media == 0.6.*+ , http-types == 0.9.*+ , network-uri == 2.6.*+ , QuickCheck == 2.9.*+ , quickcheck-instances == 0.3.*+ , test-invariant == 0.4.*+ , text == 1.2.*+ , unordered-containers == 0.2.*++ other-extensions:
+ src/Data/SirenJSON.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+Module : Data.SirenJSON+Description : Types and Instances for @application/vnd.siren+json@+Copyright : (c) Alex Brandt, 2017+License : MIT++A collection of types and instances for @application/vnd.siren+json@.++Full documentation for @application/vnd.siren+json@ can be found at+<https://github.com/kevinswiber/siren>.+-}+module Data.SirenJSON where++import Data.Aeson ((.=), (.:?), (.!=), (.:), FromJSON (parseJSON), Object, object, ToJSON (toJSON), Value (Object, String), withObject, withText)+import Data.Foldable (asum)+import Data.Functor ((<$>))+import Data.Maybe (catMaybes)+import Data.Monoid ((<>))+import Data.Text (Text)+import Network.HTTP.Media (MediaType)+import Network.HTTP.Types (StdMethod (GET))+import Network.URI (URI)++import qualified Data.HashMap.Lazy as HashMap (fromList)+import qualified Data.Map.Strict as Map (empty, Map, null)++import External.Network.HTTP.Media.MediaType.JSON ()+import External.Network.HTTP.Types.Method.JSON ()+import External.Network.URI.JSON ()++-- * Core Data Types++-- | The top-level object for an @application/vnd.siren+json@ resource.+data Entity = Entity+ { eClass :: [Text] -- ^ Nature of 'Entity''s+ -- content---implementation dependant and+ -- should be documented+ , eProperties :: Map.Map Text Text -- ^ 'Entity' state as key-value pairs---we+ -- encode all values as strings for+ -- simplicity and to allow parsing into+ -- other types as needed+ , eEntities :: [SubEntity]+ , eLinks :: [Link]+ , eActions :: [Action]+ , eTitle :: Maybe Text -- ^ Descriptive text about 'Entity'+ } deriving (Eq, Show)++instance FromJSON Entity where+ parseJSON = withObject "Entity" $ \ v -> do+ eClass <- v .:? "class" .!= []+ eProperties <- v .:? "properties" .!= Map.empty+ eEntities <- v .:? "entities" .!= []+ eLinks <- v .:? "links" .!= []+ eActions <- v .:? "actions" .!= []+ eTitle <- v .:? "title"++ return Entity{..}++instance ToJSON Entity where+ toJSON Entity{..} = object $ catMaybes+ [ if null eClass then Nothing else Just $ "class" .= eClass+ , if Map.null eProperties then Nothing else Just $ "properties" .= eProperties+ , if null eEntities then Nothing else Just $ "entities" .= eEntities+ , if null eLinks then Nothing else Just $ "links" .= eLinks+ , if null eActions then Nothing else Just $ "actions" .= eActions+ , (.=) "title" <$> eTitle+ ]++-- | Nested object for an @application/vnd.siren+json@.+data SubEntity = EmbeddedLink Link+ | EmbeddedRepresentation+ { sEntity :: Entity+ , sRel :: [Text]+ }+ deriving (Eq, Show)++instance FromJSON SubEntity where+ parseJSON = withObject "SubEntity" $ \ v -> asum+ [ EmbeddedLink <$> parseJSON (Object v)+ , do sEntity <- parseJSON (Object v)+ sRel <- v .: "rel"++ return EmbeddedRepresentation{..}+ ]++instance ToJSON SubEntity where+ toJSON (EmbeddedLink l) = toJSON l+ toJSON EmbeddedRepresentation{..} = Object $ toObject sEntity <> HashMap.fromList ["rel" .= sRel]+ where toObject :: ToJSON a => a -> Object+ toObject v = case toJSON v of+ Object o -> o+ _ -> error "toObject: received non-Object"++-- | Link to a related resource.+data Link = Link+ { lClass :: [Text] -- ^ Nature of 'Entity''s content---+ -- implementation dependant and should be+ -- documented+ , lRel :: [Text]+ , lHref :: URI+ , lType :: Maybe MediaType+ , lTitle :: Maybe Text+ } deriving (Eq, Show)++instance FromJSON Link where+ parseJSON = withObject "Link" $ \ v -> do+ lClass <- v .:? "class" .!= []+ lRel <- v .: "rel"+ lHref <- v .: "href"+ lType <- v .:? "type"+ lTitle <- v .:? "title"++ return Link{..}++instance ToJSON Link where+ toJSON Link{..} = object $ catMaybes+ [ if null lClass then Nothing else Just $ "class" .= lClass+ , Just $ "rel" .= lRel+ , Just $ "href" .= lHref+ , (.=) "type" <$> lType+ , (.=) "title" <$> lTitle+ ]++-- | Behavior of an 'Entity'.+data Action = Action+ { aName :: Text+ , aClass :: [Text]+ , aMethod :: Maybe StdMethod+ , aHref :: URI+ , aTitle :: Maybe Text+ , aType :: Maybe MediaType+ , aFields :: [Field]+ } deriving (Eq, Show)++instance FromJSON Action where+ parseJSON = withObject "Action" $ \ v -> do+ aName <- v .: "name"+ aClass <- v .:? "class" .!= []+ aMethod <- v .:? "method" .!= Just GET+ aHref <- v .: "href"+ aTitle <- v .:? "title"+ aType <- v .:? "type"+ aFields <- v .:? "fields" .!= []++ return Action{..}++instance ToJSON Action where+ toJSON Action{..} = object $ catMaybes+ [ Just $ "name" .= aName+ , if null aClass then Nothing else Just $ "class" .= aClass+ , (.=) "method" <$> aMethod+ , Just $ "href" .= aHref+ , (.=) "title" <$> aTitle+ , (.=) "type" <$> (show <$> aType)+ , if null aFields then Nothing else Just $ "fields" .= aFields+ ]++-- | Control inside of an 'Action'.+data Field = Field+ { fName :: Text+ , fClass :: [Text]+ , fType :: Maybe InputType+ , fValue :: Maybe Text+ , fTitle :: Maybe Text+ } deriving (Eq, Show)++instance FromJSON Field where+ parseJSON = withObject "Field" $ \ v -> do+ fName <- v .: "name"+ fClass <- v .:? "class" .!= []+ fType <- v .:? "type" .!= Just Text+ fValue <- v .:? "value"+ fTitle <- v .:? "title"++ return Field{..}++instance ToJSON Field where+ toJSON Field{..} = object $ catMaybes+ [ Just $ "name" .= fName+ , if null fClass then Nothing else Just $ "class" .= fClass+ , (.=) "type" <$> fType+ , (.=) "value" <$> fValue+ , (.=) "title" <$> fTitle+ ]++data InputType = Hidden+ | Text+ | Search+ | Tel+ | URL+ | Email+ | Password+ | DateTime+ | Date+ | Month+ | Week+ | Time+ | DateTimeLocal+ | Number+ | Range+ | Color+ | CheckBox+ | Radio+ | File+ deriving (Eq, Show)++instance FromJSON InputType where+ parseJSON = withText "InputType" $ \ v ->+ case v of+ "hidden" -> return Hidden+ "text" -> return Text+ "search" -> return Search+ "tel" -> return Tel+ "url" -> return URL+ "email" -> return Email+ "password" -> return Password+ "datetime" -> return DateTime+ "date" -> return Date+ "month" -> return Month+ "week" -> return Week+ "time" -> return Time+ "datetime-local" -> return DateTimeLocal+ "number" -> return Number+ "range" -> return Range+ "color" -> return Color+ "checkbox" -> return CheckBox+ "radio" -> return Radio+ "file" -> return File+ _ -> fail "invalid InputType"+ +instance ToJSON InputType where+ toJSON Hidden = String "hidden"+ toJSON Text = String "text"+ toJSON Search = String "search"+ toJSON Tel = String "tel"+ toJSON URL = String "url"+ toJSON Email = String "email"+ toJSON Password = String "password"+ toJSON DateTime = String "datetime"+ toJSON Date = String "date"+ toJSON Month = String "month"+ toJSON Week = String "week"+ toJSON Time = String "time"+ toJSON DateTimeLocal = String "datetime-local"+ toJSON Number = String "number"+ toJSON Range = String "range"+ toJSON Color = String "color"+ toJSON CheckBox = String "checkbox"+ toJSON Radio = String "radio"+ toJSON File = String "file"++-- * Type Conversion++-- | A type that can be converted from 'Entity'.+class FromEntity a where+ fromEntity :: Entity -> a++-- | A type that can be converted to 'Entity'.+class ToEntity a where+ toEntity :: a -> Entity
+ src/External/Network/HTTP/Media/MediaType/JSON.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : External.Network.HTTP.Media.MediaType.JSON+Description : MediaType FromJSON and ToJSON Instances+Copyright : (c) Alex Brandt, 2017+License : MIT++MediaType Instances for FromJSON and ToJSON.+-}+module External.Network.HTTP.Media.MediaType.JSON where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)+import Data.String (fromString)+import Data.Text (pack, unpack)+import Network.HTTP.Media.MediaType (MediaType)++instance FromJSON MediaType where+ parseJSON = withText "MediaType" $ return . fromString . unpack++instance ToJSON MediaType where+ toJSON = toJSON . pack . show
+ src/External/Network/HTTP/Types/Method/JSON.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : External.Network.HTTP.Types.Method.JSON+Description : Method FromJSON and ToJSON Instances+Copyright : (c) Alex Brandt, 2017+License : MIT++Method Instances for FromJSON and ToJSON.+-}+module External.Network.HTTP.Types.Method.JSON where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)+import Data.ByteString.Char8 (unpack)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Network.HTTP.Types.Method (StdMethod, parseMethod, renderStdMethod)++instance FromJSON StdMethod where+ parseJSON = withText "StdMethod" $ either (fail . unpack) return . parseMethod . encodeUtf8++instance ToJSON StdMethod where+ toJSON = toJSON . decodeUtf8 . renderStdMethod
+ src/External/Network/URI/JSON.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE OverloadedStrings #-}++{-|+Module : External.Network.URI.JSON+Description : URI FromJSON and ToJSON Instances+Copyright : (c) Alex Brandt, 2017+License : MIT++URI Instances for FromJSON and ToJSON+-}+module External.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/Data/SirenJSON/Arbitrary.hs view
@@ -0,0 +1,79 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : Data.SirenJSON.Arbitrary+Description : Arbitrary Instances for Data.SirenJSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Arbitrary instances for "Data.SirenJSON".+-}+module Data.SirenJSON.Arbitrary where++import Control.Applicative ((<$>), (<*>))+import Test.QuickCheck (Arbitrary (arbitrary), elements, oneof, scale)+import Test.QuickCheck.Instances ()++import Data.SirenJSON+import External.Network.HTTP.Media.MediaType.Arbitrary ()+import External.Network.HTTP.Types.Method.Arbitrary ()+import External.Network.URI.Arbitrary ()++instance Arbitrary Entity where+ arbitrary = Entity <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary SubEntity where+ arbitrary = oneof [ EmbeddedLink <$> arbitrary+ , EmbeddedRepresentation <$> scale (`div` 2) arbitrary+ <*> arbitrary+ ]++instance Arbitrary Link where+ arbitrary = Link <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Action where+ arbitrary = Action <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Field where+ arbitrary = Field <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary InputType where+ arbitrary = elements [ Hidden+ , Text+ , Search+ , Tel+ , URL+ , Email+ , Password+ , DateTime+ , Date+ , Month+ , Week+ , Time+ , DateTimeLocal+ , Number+ , Range+ , Color+ , CheckBox+ , Radio+ , File+ ]
+ test/Data/SirenJSON/Norm.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE RecordWildCards #-}++{-|+Module : Data.SirenJSON.Norm+Description : Norm Instances for Data.SirenJSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Norm instances for "Data.SirenJSON".++Also includes a definition for the 'Norm' class until it is proven generally+useful.+-}+module Data.SirenJSON.Norm+ ( Norm (..)+ ) where++import Data.Functor ((<$>))+import Data.Maybe (isNothing)+import Network.HTTP.Types.Method (StdMethod (GET))++import Data.SirenJSON++class Norm a where+ normalize :: a -> a+ normalize = id++instance Norm Entity where+ normalize Entity{..} = Entity eClass+ eProperties+ (normalize <$> eEntities)+ (normalize <$> eLinks)+ (normalize <$> eActions)+ eTitle++instance Norm SubEntity where+ normalize (EmbeddedLink l) = EmbeddedLink $ normalize l+ normalize EmbeddedRepresentation{..} = EmbeddedRepresentation (normalize sEntity) sRel++instance Norm Link++instance Norm Action where+ normalize Action{..} = Action aName+ aClass+ (if isNothing aMethod then Just GET else aMethod)+ aHref+ aTitle+ aType+ (normalize <$> aFields)++instance Norm Field where+ normalize Field{..} = Field fName+ fClass+ (if isNothing fType then Just Text else fType)+ fValue+ fTitle
+ test/Data/SirenJSONSpec.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module : Data.SirenJSONSpec+Description : Tests for Data.SirenJSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "Data.SirenJSON".+-}+module Data.SirenJSONSpec (main, spec) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust, isJust)+import Network.URI (parseURIReference)+import Test.Hspec (context, describe, hspec, it, shouldBe, Spec)+import Test.Hspec.QuickCheck (modifyMaxSize, prop)+import Test.Invariant ((<=>))+import Test.QuickCheck.Instances ()++import qualified Data.ByteString.Lazy as BL (ByteString)+import qualified Data.Map.Strict as Map (empty)++import Data.SirenJSON+import Data.SirenJSON.Arbitrary ()+import Data.SirenJSON.Norm (Norm (normalize))++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "application/vnd.siren+json" $ modifyMaxSize (const 25) $+ do describe "properties" $+ context "fromJust . decode . encode == normalize" $+ do prop "Field" (fromJust . decode . encode <=> normalize :: Field -> Bool)+ prop "Action" (fromJust . decode . encode <=> normalize :: Action -> Bool)+ prop "Link" (fromJust . decode . encode <=> normalize :: Link -> Bool)+ prop "SubEntity" (fromJust . decode . encode <=> normalize :: SubEntity -> Bool)+ prop "Entity" (fromJust . decode . encode <=> normalize :: Entity -> Bool)++ describe "differentiate SubEntity values" $+ do it "SubEntity_EmbeddedRepresentation" $+ (decode mSubEntity_EmbeddedRepresentation :: Maybe SubEntity) `shouldBe` Just (EmbeddedRepresentation (Entity [] Map.empty [] [] [] Nothing) [])++ it "SubEntity_EmbeddedLink" $+ (decode mSubEntity_EmbeddedLink :: Maybe SubEntity) `shouldBe` Just (EmbeddedLink (Link [] [] eURI Nothing Nothing))++ describe "JSON Missing Keys" $+ do context "decode minimal JSON strings" $+ do it "Field" $ isJust (decode mField :: Maybe Field)+ it "Action" $ isJust (decode mAction :: Maybe Action)+ it "Link" $ isJust (decode mLink :: Maybe Link)+ it "SubEntity_EmbeddedRepresentation" $ isJust (decode mSubEntity_EmbeddedRepresentation :: Maybe SubEntity)+ it "SubEntity_EmbeddedLink" $ isJust (decode mSubEntity_EmbeddedLink :: Maybe SubEntity)+ it "Entity" $ isJust (decode mEntity :: Maybe Entity)++ context "encode minimal data to JSON" $+ do it "Field" $+ encode (Field "name" [] Nothing Nothing Nothing) `shouldBe` mField++ it "Action" $+ encode (Action "name" [] Nothing eURI Nothing Nothing []) `shouldBe` mAction++ it "Link" $+ encode (Link [] [] eURI Nothing Nothing) `shouldBe` mLink++ it "SubEntity_EmbeddedRepresentation" $+ encode (EmbeddedRepresentation (Entity [] Map.empty [] [] [] Nothing) []) `shouldBe` mSubEntity_EmbeddedRepresentation++ it "SubEntity_EmbeddedLink" $+ encode (EmbeddedLink (Link [] [] eURI Nothing Nothing)) `shouldBe` mSubEntity_EmbeddedLink++ it "Entity" $+ encode (Entity [] Map.empty [] [] [] Nothing) `shouldBe` mEntity++ where mEntity = "{}" :: BL.ByteString+ mSubEntity_EmbeddedLink = "{\"href\":\"http://example.com\",\"rel\":[]}" :: BL.ByteString+ mSubEntity_EmbeddedRepresentation = "{\"rel\":[]}" :: BL.ByteString+ mLink = "{\"href\":\"http://example.com\",\"rel\":[]}" :: BL.ByteString+ mAction = "{\"href\":\"http://example.com\",\"name\":\"name\"}" :: BL.ByteString+ mField = "{\"name\":\"name\"}" :: BL.ByteString+ + eURI = fromJust $ parseURIReference "http://example.com"
+ test/External/Network/HTTP/Media/MediaType/Arbitrary.hs view
@@ -0,0 +1,58 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : External.Network.HTTP.Media.MediaType.Arbitrary+Description : Arbitrary Instances for Network.HTTP.Media.MediaType+Copyright : (c) Alex Brandt, 2017+License : MIT++Arbitrary instances for "Network.HTTP.Media.MediaType".+-}+module External.Network.HTTP.Media.MediaType.Arbitrary () where++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)++--+--+-- Note: parameter---paramter values are supposed to be unrestricted but due to+-- the way that quickcheck validates values it's best if these are+-- 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++-- * RFC 6838 Generators++restrictedName :: Gen ByteString+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 ['!', '#', '$', '&', '-', '^', '_', '.', '+']+ ]++-- * RFC 2234 Generators++alpha :: Gen Char+alpha = elements $ ['a'..'z'] ++ ['A'..'Z']++digit :: Gen Char+digit = elements ['0'..'9']
+ test/External/Network/HTTP/Media/MediaType/ArbitrarySpec.hs view
@@ -0,0 +1,28 @@+{-|+Module : External.Network.HTTP.Media.MediaType.ArbitrarySpec+Description : Tests for External.Network.HTTP.Media.MediaType.Arbitrary+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "External.Network.HTTP.Media.MediaType.Arbitrary".+-}+module External.Network.HTTP.Media.MediaType.ArbitrarySpec (main, spec) where++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 External.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
+ test/External/Network/HTTP/Media/MediaType/JSONSpec.hs view
@@ -0,0 +1,27 @@+{-|+Module : External.Network.HTTP.Media.MediaType.JSONSpec+Description : Tests for External.Network.HTTP.Media.MediaType.JSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "External.Network.HTTP.Media.MediaType.JSON".+-}+module External.Network.HTTP.Media.MediaType.JSONSpec (main, spec) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust)+import Network.HTTP.Media.MediaType (MediaType)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)+import Test.Invariant ((<=>))++import External.Network.HTTP.Media.MediaType.Arbitrary ()+import External.Network.HTTP.Media.MediaType.JSON ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "properties" $+ prop "fromJust . decode . encode == id" (fromJust . decode . encode <=> id :: MediaType -> Bool)
+ test/External/Network/HTTP/Types/Method/Arbitrary.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module : External.Network.HTTP.Types.Method.Arbitrary+Description : Arbitrary Instances for Network.HTTP.Types.Method+Copyright : (c) Alex Brandt, 2017+License : MIT++Arbitrary instances for "Network.HTTP.Types.Method".+-}+module External.Network.HTTP.Types.Method.Arbitrary () where++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+ ]
+ test/External/Network/HTTP/Types/Method/ArbitrarySpec.hs view
@@ -0,0 +1,24 @@+{-|+Module : External.Network.HTTP.Types.Method.ArbitrarySpec+Description : Tests for External.Network.HTTP.Types.Method.Arbitrary+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "External.Network.HTTP.Types.Method.Arbitrary".+-}+module External.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 External.Network.HTTP.Types.Method.Arbitrary ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "properties" $+ prop "parseMethod . renderStdMethod <=> Right" $ parseMethod . renderStdMethod <=> Right
+ test/External/Network/HTTP/Types/Method/JSONSpec.hs view
@@ -0,0 +1,27 @@+{-|+Module : External.Network.HTTP.Types.Method.JSONSpec+Description : Tests for External.Network.HTTP.Types.Method.JSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "External.Network.HTTP.Types.Method.JSON".+-}+module External.Network.HTTP.Types.Method.JSONSpec (main, spec) where++import Data.Aeson (decode, encode)+import Data.Maybe (fromJust)+import Network.HTTP.Types.Method (StdMethod)+import Test.Hspec (describe, hspec, Spec)+import Test.Hspec.QuickCheck (prop)+import Test.Invariant ((<=>))++import External.Network.HTTP.Types.Method.Arbitrary ()+import External.Network.HTTP.Types.Method.JSON ()++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "properties" $+ prop "fromJust . decode . encode == id" (fromJust . decode . encode <=> id :: StdMethod -> Bool)
+ test/External/Network/URI/Arbitrary.hs view
@@ -0,0 +1,187 @@+{-# 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), 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]++instance Arbitrary URIAuth where+ arbitrary = URIAuth <$> userinfo+ <*> host `suchThat` (not . null)+ <*> port++-- * 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/External/Network/URI/JSONSpec.hs view
@@ -0,0 +1,27 @@+{-|+Module : External.Network.URI.JSONSpec+Description : Tests for External.Network.URI.JSON+Copyright : (c) Alex Brandt, 2017+License : MIT++Tests for "External.Network.URI.JSON".+-}+module External.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 External.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 #-}