{-# 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 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.AWS.Data as AWS 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)