hw-uri 0.1.1.0 → 0.1.1.1
raw patch · 4 files changed
+105/−56 lines, 4 filesdep +generic-lensdep ~antiope-coredep ~antiope-s3PVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: generic-lens
Dependency ranges changed: antiope-core, antiope-s3
API changes (from Hackage documentation)
+ HaskellWorks.Data.Uri.Location: dirname :: Location -> Location
Files
- hw-uri.cabal +19/−18
- src/HaskellWorks/Data/Uri/Location.hs +10/−0
- test/HaskellWorks/Data/Uri/Gen.hs +49/−0
- test/HaskellWorks/Data/Uri/LocationSpec.hs +27/−38
hw-uri.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-uri-version: 0.1.1.0+version: 0.1.1.1 synopsis: Supports IO on URIs description: Supports IO on URIs. homepage: https://github.com/haskell-works/hw-uri@@ -23,12 +23,13 @@ common amazonka { build-depends: amazonka >= 1.6.1 && < 1.7 } common amazonka-core { build-depends: amazonka-core >= 1.6.1 && < 1.7 } common amazonka-s3 { build-depends: amazonka-s3 >= 1.6.1 && < 1.7 }-common antiope-core { build-depends: antiope-core >= 7.1.1 && < 8 }-common antiope-s3 { build-depends: antiope-s3 >= 7.1.1 && < 8 }+common antiope-core { build-depends: antiope-core >= 7.3.3 && < 8 }+common antiope-s3 { build-depends: antiope-s3 >= 7.3.3 && < 8 } common bytestring { build-depends: bytestring >= 0.10.8.2 && < 0.11 } common directory { build-depends: directory >= 1.3.3.0 && < 1.4 } common exceptions { build-depends: exceptions >= 0.10.1 && < 0.11 } common filepath { build-depends: filepath >= 1.3 && < 1.5 }+common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.3 } common hedgehog { build-depends: hedgehog >= 0.5 && < 1.1 } common hspec { build-depends: hspec >= 2.4 && < 3 } common http-client { build-depends: http-client >= 0.5.14 && < 0.7 }@@ -55,6 +56,7 @@ , directory , exceptions , filepath+ , generic-lens , http-client , http-types , lens@@ -64,17 +66,16 @@ other-modules: Paths_hw_uri autogen-modules: Paths_hw_uri hs-source-dirs: src- exposed-modules:- HaskellWorks.Data.Uri.AWS.Env- HaskellWorks.Data.Uri.IO.Console- HaskellWorks.Data.Uri.IO.Error- HaskellWorks.Data.Uri.IO.File- HaskellWorks.Data.Uri.IO.Lazy- HaskellWorks.Data.Uri.IO.Static- HaskellWorks.Data.Uri.Location- HaskellWorks.Data.Uri.Show- HaskellWorks.Data.Uri.Text- HaskellWorks.Data.Uri.UriError+ exposed-modules: HaskellWorks.Data.Uri.AWS.Env+ HaskellWorks.Data.Uri.IO.Console+ HaskellWorks.Data.Uri.IO.Error+ HaskellWorks.Data.Uri.IO.File+ HaskellWorks.Data.Uri.IO.Lazy+ HaskellWorks.Data.Uri.IO.Static+ HaskellWorks.Data.Uri.Location+ HaskellWorks.Data.Uri.Show+ HaskellWorks.Data.Uri.Text+ HaskellWorks.Data.Uri.UriError test-suite hw-uri-test import: base, config@@ -95,7 +96,7 @@ build-depends: hw-uri hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-tools: hspec-discover- other-modules:- HaskellWorks.Data.Uri.AwsSpec- HaskellWorks.Data.Uri.LocationSpec+ build-tool-depends: hspec-discover:hspec-discover+ other-modules: HaskellWorks.Data.Uri.Gen+ HaskellWorks.Data.Uri.AwsSpec+ HaskellWorks.Data.Uri.LocationSpec
src/HaskellWorks/Data/Uri/Location.hs view
@@ -1,13 +1,16 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.Uri.Location ( IsPath(..) , Location(..) , toLocation+ , dirname ) where import Antiope.Core (ToText (..), fromText)@@ -22,6 +25,7 @@ import qualified Data.Text as T import qualified System.FilePath as FP import qualified Data.Aeson.Types as J+import qualified Antiope.S3.Types as Z class IsPath a s | a -> s where (</>) :: a -> s -> a@@ -106,6 +110,12 @@ | T.isInfixOf "://" txt' -> Nothing | otherwise -> Just (Local (T.unpack txt')) where txt' = T.strip txt++dirname :: Location -> Location+dirname location = case location of+ S3 s3Uri -> S3 (Z.dirname s3Uri)+ Local fp -> Local (FP.takeDirectory fp)+ HttpUri uri -> HttpUri (T.pack (FP.takeDirectory (T.unpack uri))) ------------------------------------------------------------------------------- stripStart :: Text -> Text -> Text
+ test/HaskellWorks/Data/Uri/Gen.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Uri.Gen+ ( s3Uri+ , location+ , localPath+ ) where++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+import Hedgehog+import Test.Hspec++import qualified Data.List as L+import qualified Data.Text as T+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+import qualified System.FilePath as FP++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-}++s3Uri :: MonadGen m => m S3Uri+s3Uri = do+ let partGen = G.text (R.linear 3 10) G.alphaNum+ bkt <- partGen+ parts <- G.list (R.linear 1 5) partGen+ ext <- G.text (R.linear 2 4) G.alphaNum+ pure $ S3Uri (BucketName bkt) (ObjectKey (T.intercalate "/" parts <> "." <> ext))++localPath :: MonadGen m => m FilePath+localPath = do+ let partGen = G.string (R.linear 3 10) G.alphaNum+ parts <- G.list (R.linear 1 5) partGen+ ext <- G.string (R.linear 2 4) G.alphaNum+ pure $ "/" <> L.intercalate "/" parts <> "." <> ext++location :: MonadGen m => m Location+location = G.choice+ [ S3 <$> s3Uri+ , Local <$> localPath+ , HttpUri . ("http://" <>) . T.pack <$> localPath+ ]
test/HaskellWorks/Data/Uri/LocationSpec.hs view
@@ -6,7 +6,7 @@ ) where import Antiope.Core (toText)-import Antiope.S3 (BucketName (..), ObjectKey (..), S3Uri (..))+import Antiope.S3 (S3Uri (..)) import Data.Aeson import Data.Semigroup ((<>)) import HaskellWorks.Data.Uri.Location@@ -14,67 +14,52 @@ import Hedgehog import Test.Hspec -import qualified Data.List as List-import qualified Data.Text as Text-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import qualified System.FilePath as FP+import qualified Data.Text as T+import qualified HaskellWorks.Data.Uri.Gen as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+import qualified System.FilePath as FP {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} -s3Uri :: MonadGen m => m S3Uri-s3Uri = do- let partGen = Gen.text (Range.linear 3 10) Gen.alphaNum- bkt <- partGen- parts <- Gen.list (Range.linear 1 5) partGen- ext <- Gen.text (Range.linear 2 4) Gen.alphaNum- pure $ S3Uri (BucketName bkt) (ObjectKey (Text.intercalate "/" parts <> "." <> ext))--localPath :: MonadGen m => m FilePath-localPath = do- let partGen = Gen.string (Range.linear 3 10) Gen.alphaNum- parts <- Gen.list (Range.linear 1 5) partGen- ext <- Gen.string (Range.linear 2 4) Gen.alphaNum- pure $ "/" <> List.intercalate "/" parts <> "." <> ext- spec :: Spec spec = describe "HaskellWorks.Assist.LocationSpec" $ do it "S3 should roundtrip from and to text" $ requireProperty $ do- uri <- forAll s3Uri+ uri <- forAll G.s3Uri tripping (S3 uri) toText toLocation it "LocalLocation should roundtrip from and to text" $ requireProperty $ do- path <- forAll localPath+ path <- forAll G.localPath tripping (Local path) toText toLocation 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+ loc <- S3 <$> forAll G.s3Uri+ part <- forAll $ G.text (R.linear 3 10) G.alphaNum+ ext <- forAll $ G.text (R.linear 2 4) G.alphaNum toText (loc </> part <.> ext) === (toText loc) <> "/" <> part <> "." <> ext toText (loc </> ("/" <> part) <.> ("." <> ext)) === (toText loc) <> "/" <> part <> "." <> ext 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+ loc <- S3 <$> forAll G.s3Uri+ part <- forAll $ G.text (R.linear 3 10) G.alphaNum+ ext <- forAll $ G.text (R.linear 2 4) G.alphaNum+ ext' <- forAll $ G.text (R.linear 2 4) G.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)+ loc <- Local <$> forAll G.localPath+ part <- forAll $ G.string (R.linear 3 10) G.alphaNum+ ext <- forAll $ G.string (R.linear 2 4) G.alphaNum+ toText (loc </> T.pack part <.> T.pack ext) === T.pack ((T.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+ loc <- Local <$> forAll G.localPath+ part <- forAll $ G.text (R.linear 3 10) G.alphaNum+ ext <- forAll $ G.text (R.linear 2 4) G.alphaNum+ ext' <- forAll $ G.text (R.linear 2 4) G.alphaNum toText (loc </> part <.> ext -<.> ext') === (toText loc) <> "/" <> part <> "." <> ext' it "S3 uri should encode/decode to JSON" $ requireTest $ do@@ -92,3 +77,7 @@ it "HttpUri should encode/decode to JSON 2" $ requireTest $ do let location = HttpUri "https://tmp/path" fromJSON (toJSON location) === Success location++ it "dirname" $ requireTest $ do+ location <- forAll G.location+ dirname (location </> "x") === location