hw-uri 0.1.0.0 → 0.1.0.1

raw patch · 3 files changed

+42/−16 lines, 3 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• hw-uri.cabal +1/−1
• src/HaskellWorks/Data/Uri/Location.hs +25/−14
• test/HaskellWorks/Data/Uri/LocationSpec.hs +16/−1

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   hw-uri-version:                0.1.0.0+version:                0.1.0.1 synopsis:               Supports IO on URIs description:            Supports IO on URIs. homepage:               https://github.com/haskell-works/hw-uri

@@ -24,11 +24,13 @@ import qualified Data.Aeson.Types as J  class IsPath a s | a -> s where-  (</>) :: a -> s -> a-  (<.>) :: a -> s -> a+  (</>)  :: a -> s -> a+  (<.>)  :: a -> s -> a+  (-<.>) :: a -> s -> a  infixr 5 </> infixr 7 <.>+infixl 4 -<.>  data Location   = S3 S3Uri@@ -64,28 +66,37 @@   toText (HttpUri uri)  = uri  instance IsPath Location Text where-  (S3      b) </> p = S3      (b </>          p)-  (Local   b) </> p = Local   (b </> T.unpack p)-  (HttpUri b) </> p = HttpUri (b </>          p)+  (S3      b) </>  p = S3      (b </>           p)+  (Local   b) </>  p = Local   (b </>  T.unpack p)+  (HttpUri b) </>  p = HttpUri (b </>           p) -  (S3      b) <.> e = S3      (b <.>          e)-  (Local   b) <.> e = Local   (b <.> T.unpack e)-  (HttpUri b) <.> e = HttpUri (b <.>          e)+  (S3      b) <.>  e = S3      (b <.>           e)+  (Local   b) <.>  e = Local   (b <.>  T.unpack e)+  (HttpUri b) <.>  e = HttpUri (b <.>           e) +  (S3      b) -<.> e = S3      (b -<.>          e)+  (Local   b) -<.> e = Local   (b -<.> T.unpack e)+  (HttpUri b) -<.> e = HttpUri (b -<.>          e)+ instance IsPath Text Text where-  b </> p = T.pack (T.unpack b FP.</> T.unpack p)-  b <.> e = T.pack (T.unpack b FP.<.> T.unpack e)+  b  </> p = T.pack (T.unpack b FP.</>  T.unpack p)+  b  <.> e = T.pack (T.unpack b FP.<.>  T.unpack e)+  b -<.> e = T.pack (T.unpack b FP.-<.> T.unpack e)  instance (a ~ Char) => IsPath [a] [a] where-  b </> p = b FP.</> p-  b <.> e = b FP.<.> e+  b  </> p = b FP.</>  p+  b  <.> e = b FP.<.>  e+  b -<.> e = b FP.-<.> e  instance IsPath S3Uri Text where-  S3Uri b (ObjectKey k) </> p =+  S3Uri b (ObjectKey k) </>  p =     S3Uri b (ObjectKey (stripEnd "/" k <> "/" <> stripStart "/" p)) -  S3Uri b (ObjectKey k) <.> e =+  S3Uri b (ObjectKey k) <.>  e =     S3Uri b (ObjectKey (stripEnd "." k <> "." <> stripStart "." e))++  S3Uri b (ObjectKey k) -<.> e =+    S3Uri b (ObjectKey (stripEnd "." (T.pack . (FP.-<.> (T.unpack $ stripStart "." e)) . T.unpack $ k)))  toLocation :: Text -> Maybe Location toLocation txt = if

@@ -56,11 +56,26 @@     toText (loc </> part <.> ext) === (toText loc) <> "/" <> part <> "." <> ext     toText (loc </> ("/" <> part) <.> ("." <> ext)) === (toText loc) <> "/" <> part <> "." <> ext -  it "Should append s3 path" $ requireProperty $ do+  it "Should replace s3 path extension" $ 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+    ext' <- forAll $ Gen.text (Range.linear 2 4)  Gen.alphaNum+    toText (loc </> part <.> ext -<.> ext') === (toText loc) <> "/" <> part <> "." <> ext'+    toText (loc </> ("/" <> part) <.> ("." <> ext) -<.> ("." <> ext')) === (toText loc) <> "/" <> part <> "." <> ext'++  it "Should append local 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 "Should replace local path extension" $ requireProperty $ do+    loc  <- Local <$> forAll localPath+    part <- forAll $ Gen.text (Range.linear 3 10) Gen.alphaNum+    ext  <- forAll $ Gen.text (Range.linear 2 4)  Gen.alphaNum+    ext' <- forAll $ Gen.text (Range.linear 2 4)  Gen.alphaNum+    toText (loc </> part <.> ext -<.> ext') === (toText loc) <> "/" <> part <> "." <> ext'    it "S3 uri should encode/decode to JSON" $ requireTest $ do     let location = S3 (S3Uri "hello" "world")