{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.Uri.LocationSpec ( spec ) where 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 import Test.Hspec 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) #-} spec :: Spec spec = describe "HaskellWorks.Assist.LocationSpec" $ do it "S3 should roundtrip from and to text" $ requireProperty $ do uri <- forAll G.s3Uri tripping (S3 uri) toText toLocation it "LocalLocation should roundtrip from and to text" $ requireProperty $ do path <- forAll G.localPath tripping (Local path) toText toLocation it "Should append s3 path" $ requireProperty $ do 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 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 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 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 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 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