{-# LANGUAGE OverloadedStrings #-} module HaskellWorks.CabalCache.LocationSpec ( spec, ) where import Data.Maybe (fromJust) import HaskellWorks.CabalCache.Location import HaskellWorks.Hspec.Hedgehog import Hedgehog import Network.URI (URI) import Test.Hspec import qualified Amazonka.Data as AWS import qualified Data.List as L 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 Network.URI as URI import qualified System.FilePath as FP {- HLINT ignore "Redundant do" -} {- HLINT ignore "Reduce duplication" -} {- HLINT ignore "Redundant bracket" -} s3Uri :: MonadGen m => m URI s3Uri = do let partGen = Gen.string (Range.linear 3 10) Gen.alphaNum bkt <- partGen parts <- Gen.list (Range.linear 1 5) partGen ext <- Gen.string (Range.linear 2 4) Gen.alphaNum pure $ fromJust $ URI.parseURI $ "s3://" <> bkt <> "/" <> L.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 "URI bucket-only" $ requireTest do fromJust (URI.parseURI "s3://bucket") "directory" === fromJust (URI.parseURI "s3://bucket/directory") it "Location bucket-only" $ requireTest do fromJust (toLocation "s3://bucket") "directory" === fromJust (toLocation "s3://bucket/directory") it "S3 should roundtrip from and to text" $ require $ property do uri <- forAll s3Uri tripping (Uri uri) AWS.toText toLocation it "LocalLocation should roundtrip from and to text" $ require $ property do path <- forAll localPath tripping (Local path) AWS.toText toLocation it "Should append s3 path" $ require $ property do loc <- Uri <$> forAll s3Uri part <- forAll $ Gen.text (Range.linear 3 10) Gen.alphaNum ext <- forAll $ Gen.text (Range.linear 2 4) Gen.alphaNum AWS.toText (loc part <.> ext) === AWS.toText loc <> "/" <> part <> "." <> ext it "Should append s3 path" $ require $ property 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 AWS.toText (loc Text.pack part <.> Text.pack ext) === Text.pack ((Text.unpack $ AWS.toText loc) FP. part FP.<.> ext)