hw-uri 0.1.1.2 → 0.1.1.3

raw patch · 5 files changed

+119/−17 lines, 5 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• hw-uri.cabal +3/−1
• src/HaskellWorks/Data/Uri/Internal/List.hs +14/−0
• src/HaskellWorks/Data/Uri/Internal/Text.hs +15/−0
• src/HaskellWorks/Data/Uri/Location.hs +44/−14
• test/HaskellWorks/Data/Uri/LocationSpec.hs +43/−2

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   hw-uri-version:                0.1.1.2+version:                0.1.1.3 synopsis:               Supports IO on URIs description:            Supports IO on URIs. homepage:               https://github.com/haskell-works/hw-uri@@ -67,6 +67,8 @@   autogen-modules:      Paths_hw_uri   hs-source-dirs:       src   exposed-modules:      HaskellWorks.Data.Uri.AWS.Env+                        HaskellWorks.Data.Uri.Internal.List+                        HaskellWorks.Data.Uri.Internal.Text                         HaskellWorks.Data.Uri.IO.Console                         HaskellWorks.Data.Uri.IO.Error                         HaskellWorks.Data.Uri.IO.File

@@ -0,0 +1,14 @@+module HaskellWorks.Data.Uri.Internal.List+  ( mapLast+  , dropSave1+  ) where++mapLast :: (a -> a) -> [a] -> [a]+mapLast f [a]    = [f a]+mapLast _ []     = []+mapLast f (a:as) = a:mapLast f as++dropSave1 :: [a] -> [a]+dropSave1 (_:xs) = xs+dropSave1 [x]    = [x]+dropSave1 []     = []

@@ -0,0 +1,15 @@+module HaskellWorks.Data.Uri.Internal.Text+  ( maybeStripPrefix+  , maybeStripSuffix+  ) where++import Data.Maybe+import Data.Text  (Text)++import qualified Data.Text as T++maybeStripPrefix :: Text -> Text -> Text+maybeStripPrefix what txt = fromMaybe txt (T.stripPrefix what txt)++maybeStripSuffix :: Text -> Text -> Text+maybeStripSuffix what txt = fromMaybe txt (T.stripSuffix what txt)

@@ -13,23 +13,31 @@   , toLocation   , basename   , dirname+  , modPath+  , getPath+  , modBasename+  , modBasenameParts+  , modBasenamePartsReversed+  , modExts   ) where  import Antiope.Core              (ToText (..), fromText) import Antiope.S3                (ObjectKey (..), S3Uri (..)) import Control.Applicative-import Control.Lens              ((^.))+import Control.Lens              ((%~), (&), (^.)) import Data.Aeson import Data.Generics.Product.Any-import Data.Maybe                (fromMaybe) import Data.Semigroup            ((<>)) import Data.Text                 (Text) import GHC.Generics              (Generic) -import qualified Antiope.S3.Types as Z-import qualified Data.Aeson.Types as J-import qualified Data.Text        as T-import qualified System.FilePath  as FP+import qualified Antiope.S3.Types                    as Z+import qualified Data.Aeson.Types                    as J+import qualified Data.List                           as L+import qualified Data.Text                           as T+import qualified HaskellWorks.Data.Uri.Internal.List as L+import qualified HaskellWorks.Data.Uri.Internal.Text as T+import qualified System.FilePath                     as FP  class IsPath a s | a -> s where   (</>)  :: a -> s -> a@@ -98,13 +106,13 @@  instance IsPath S3Uri Text where   S3Uri b (ObjectKey k) </>  p =-    S3Uri b (ObjectKey (stripEnd "/" k <> "/" <> stripStart "/" p))+    S3Uri b (ObjectKey (T.maybeStripSuffix "/" k <> "/" <> T.maybeStripPrefix "/" p))    S3Uri b (ObjectKey k) <.>  e =-    S3Uri b (ObjectKey (stripEnd "." k <> "." <> stripStart "." e))+    S3Uri b (ObjectKey (T.maybeStripSuffix "." k <> "." <> T.maybeStripPrefix "." e))    S3Uri b (ObjectKey k) -<.> e =-    S3Uri b (ObjectKey (stripEnd "." (T.pack . (FP.-<.> (T.unpack $ stripStart "." e)) . T.unpack $ k)))+    S3Uri b (ObjectKey (T.maybeStripSuffix "." (T.pack . (FP.-<.> (T.unpack $ T.maybeStripPrefix "." e)) . T.unpack $ k)))  toLocation :: Text -> Maybe Location toLocation txt = if@@ -127,9 +135,31 @@   Local fp    -> T.pack $ FP.takeFileName fp   HttpUri uri -> T.pack . FP.takeFileName $ T.unpack uri ---------------------------------------------------------------------------------stripStart :: Text -> Text -> Text-stripStart what txt = fromMaybe txt (T.stripPrefix what txt)+modPath :: (Text -> Text) -> Location -> Location+modPath f location = case location of+  S3 s3Uri    -> S3 (s3Uri & the @"objectKey" . the @1 %~ f)+  Local fp    -> Local (T.unpack (f (T.pack fp)))+  HttpUri uri -> HttpUri (f uri) -stripEnd :: Text -> Text -> Text-stripEnd what txt = fromMaybe txt (T.stripSuffix what txt)+getPath :: Location -> Text+getPath location = case location of+  S3 s3Uri    -> s3Uri ^. the @"objectKey" . the @1+  Local fp    -> T.pack fp+  HttpUri uri -> uri++modBasename :: (Text -> Text) -> Location -> Location+modBasename f = modPath g+  where g path = T.intercalate "/" (L.mapLast f (T.splitOn "/" path))++modBasenameParts :: ([Text] -> [Text]) -> Location -> Location+modBasenameParts f = modBasename (T.intercalate "." . f . T.splitOn ".")++modBasenamePartsReversed :: ([Text] -> [Text]) -> Location -> Location+modBasenamePartsReversed f = modBasenameParts (reverse . f . reverse)++modExts :: [Text] -> [Text] -> Location -> Location+modExts fromExts toExts = modBasenameParts f+  where f :: [Text] -> [Text]+        f as = if L.isSuffixOf fromExts as+          then (reverse (drop (length fromExts) (reverse as))) <> toExts+          else as

@@ -1,5 +1,6 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.Uri.LocationSpec   ( spec@@ -7,8 +8,11 @@  import Antiope.Core                   (toText) import Antiope.S3                     (S3Uri (..))+import Control.Lens                   ((&)) import Data.Aeson+import Data.Maybe import Data.Semigroup                 ((<>))+import Data.Text                      (Text) import HaskellWorks.Data.Uri.Location import HaskellWorks.Hspec.Hedgehog import Hedgehog@@ -81,3 +85,40 @@   it "dirname" $ requireTest $ do     location <- forAll G.location     dirname (location </> "x") === location++  it "modPath" $ requireTest $ do+    let input     :: Location = fromJust (toLocation ("s3://bucket/object/key.ext"))+    let actual    :: Location = input & modPath T.toUpper+    let expected  :: Location = fromJust (toLocation ("s3://bucket/OBJECT/KEY.EXT"))+    actual === expected++  it "getPath" $ requireTest $ do+    let input     :: Location = fromJust (toLocation ("s3://bucket/object/key.ext"))+    let actual    :: Text     = input & getPath+    let expected  :: Text     = "object/key.ext"+    actual === expected++  it "modBasename" $ requireTest $ do+    let input     :: Location = fromJust (toLocation ("s3://bucket/object/key.ext"))+    let actual    :: Location = input & modBasename T.toUpper+    let expected  :: Location = fromJust (toLocation ("s3://bucket/object/KEY.EXT"))+    actual === expected++  it "modBasenameParts" $ requireTest $ do+    let input     :: Location = fromJust (toLocation ("s3://bucket/object/ab.cd.ef"))+    let actual    :: Location = input & modBasenameParts (reverse . drop 1)+    let expected  :: Location = fromJust (toLocation ("s3://bucket/object/ef.cd"))+    actual === expected++  it "modBasenamePartsReversed" $ requireTest $ do+    let input     :: Location = fromJust (toLocation ("s3://bucket/object/ab.cd.ef"))+    let actual    :: Location = input & modBasenamePartsReversed (drop 1)+    let expected  :: Location = fromJust (toLocation ("s3://bucket/object/ab.cd"))+    actual === expected++  it "modExts" $ requireTest $ do+    let input     :: Location = fromJust (toLocation ("s3://bucket/object/ab.cd.ef"))+    let actual    :: Location = input & modExts ["cd", "ef"] ["gh", "ij"]+    let expected  :: Location = fromJust (toLocation ("s3://bucket/object/ab.gh.ij"))+    actual === expected+