hw-uri 0.0.1.0 → 0.0.2.0

raw patch · 3 files changed

+48/−14 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hw-uri.cabal +2/−1
• src/HaskellWorks/Data/Uri/Location.hs +26/−9
• test/HaskellWorks/Data/Uri/LocationSpec.hs +20/−4

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   hw-uri-version:                0.0.1.0+version:                0.0.2.0 synopsis:               Supports IO on URIs description:            Supports IO on URIs. homepage:               https://github.com/haskell-works/hw-uri@@ -81,6 +81,7 @@           , antiope-core           , antiope-s3           , bytestring+          , aeson           , filepath           , hedgehog           , hspec

@@ -10,17 +10,18 @@   , toLocation   ) where -import Antiope.Core   (ToText (..), fromText)-import Antiope.S3     (ObjectKey (..), S3Uri (..))+import Antiope.Core         (ToText (..), fromText)+import Antiope.S3           (ObjectKey (..), S3Uri (..))+import Control.Applicative import Data.Aeson-import Data.Maybe     (fromMaybe)-import Data.Semigroup ((<>))-import Data.Text      (Text)-import GHC.Generics   (Generic)-import Data.Aeson     (ToJSON)+import Data.Maybe           (fromMaybe)+import Data.Semigroup       ((<>))+import Data.Text            (Text)+import GHC.Generics         (Generic) -import qualified Data.Text       as T-import qualified System.FilePath as FP+import qualified Data.Text        as T+import qualified System.FilePath  as FP+import qualified Data.Aeson.Types as J  class IsPath a s | a -> s where   (</>) :: a -> s -> a@@ -40,6 +41,22 @@     S3 uri          -> toJSON uri     Local filePath  -> toJSON filePath     HttpUri text    -> toJSON text++parseJsonLocal :: Value -> J.Parser FilePath+parseJsonLocal (J.String v) = return (T.unpack v)+parseJsonLocal v = J.typeMismatch ("FilePath (String)") v++parseJsonHttpUri :: Value -> J.Parser Text+parseJsonHttpUri v@(J.String s) = if T.isPrefixOf "http://" s || T.isPrefixOf "https://" s+  then return s+  else J.typeMismatch ("HttpUri (String)") v+parseJsonHttpUri v = J.typeMismatch ("HttpUri (String)") v++instance FromJSON Location where+  parseJSON v =+        (S3       <$> parseJSON        v)+    <|> (HttpUri  <$> parseJsonHttpUri v)+    <|> (Local    <$> parseJsonLocal   v)  instance ToText Location where   toText (S3 uri)       = toText uri

@@ -7,6 +7,7 @@  import Antiope.Core                   (toText) import Antiope.S3                     (BucketName (..), ObjectKey (..), S3Uri (..))+import Data.Aeson import Data.Semigroup                 ((<>)) import HaskellWorks.Data.Uri.Location import HaskellWorks.Hspec.Hedgehog@@ -40,24 +41,39 @@  spec :: Spec spec = describe "HaskellWorks.Assist.LocationSpec" $ do-  it "S3 should roundtrip from and to text" $ require $ property $ do+  it "S3 should roundtrip from and to text" $ requireProperty $ do     uri <- forAll s3Uri     tripping (S3 uri) toText toLocation -  it "LocalLocation should roundtrip from and to text" $ require $ property $ do+  it "LocalLocation should roundtrip from and to text" $ requireProperty $ do     path <- forAll localPath     tripping (Local path) toText toLocation -  it "Should append s3 path" $ require $ property $ do+  it "Should append s3 path" $ requireProperty $ do     loc  <- S3 <$> forAll s3Uri     part <- forAll $ Gen.text (Range.linear 3 10) Gen.alphaNum     ext  <- forAll $ Gen.text (Range.linear 2 4)  Gen.alphaNum     toText (loc </> part <.> ext) === (toText loc) <> "/" <> part <> "." <> ext     toText (loc </> ("/" <> part) <.> ("." <> ext)) === (toText loc) <> "/" <> part <> "." <> ext -  it "Should append s3 path" $ require $ property $ do+  it "Should append s3 path" $ requireProperty $ do     loc  <- Local <$> forAll localPath     part <- forAll $ Gen.string (Range.linear 3 10) Gen.alphaNum     ext  <- forAll $ Gen.string (Range.linear 2 4)  Gen.alphaNum     toText (loc </> Text.pack part <.> Text.pack ext) === Text.pack ((Text.unpack $ toText loc) FP.</> part FP.<.> ext) +  it "S3 uri should encode/decode to JSON" $ requireTest $ do+    let location = S3 (S3Uri "hello" "world")+    fromJSON (toJSON location) === Success location++  it "Local should encode/decode to JSON" $ requireTest $ do+    let location = Local "/tmp/path"+    fromJSON (toJSON location) === Success location++  it "HttpUri should encode/decode to JSON 1" $ requireTest $ do+    let location = HttpUri "http://tmp/path"+    fromJSON (toJSON location) === Success location++  it "HttpUri should encode/decode to JSON 2" $ requireTest $ do+    let location = HttpUri "https://tmp/path"+    fromJSON (toJSON location) === Success location