diff --git a/src/Helpers.hs b/src/Helpers.hs index 5095f32..21fa267 100644 --- a/src/Helpers.hs +++ b/src/Helpers.hs @@ -26,7 +26,8 @@ module Helpers ( textToUrl, urlToText, makeHttps, - editHost + editHost, + dropParam ) where import qualified Data.List as L @@ -84,6 +85,17 @@ editHost f url = do host' <- f $ host url Just url { host = host' } +-- | Drop a parameter from a 'Url' (if present) +dropParam + :: String + -- ^ the parameter to be dropped + -> Url + -- ^ the 'Url' being modified + -> Url +dropParam pName url = let + params' = filter (\p -> fst p /= pName) $ params url + in url { params = params' } + subToUrl :: T.Text -> Maybe Url subToUrl text = case T.splitOn "://" text of [protT, raw] -> do diff --git a/test/HelpersSpec.hs b/test/HelpersSpec.hs index c17aaf7..646908c 100644 --- a/test/HelpersSpec.hs +++ b/test/HelpersSpec.hs @@ -35,6 +35,7 @@ spec = do urlToTextSpec makeHttpsSpec editHostSpec + dropParamSpec textToUrlSpec :: Spec textToUrlSpec = describe "textToUrl" $ mapM_ @@ -99,6 +100,29 @@ editHostSpec = describe "editHost" $ mapM_ reversed = Just simpleUrl { host = reverse $ host simpleUrl } +dropParamSpec :: Spec +dropParamSpec = describe "dropParam" $ mapM_ + ( \(desc, p, expected) -> context desc $ + it ("should be " ++ show expected) $ + dropParam p url `shouldBe` expected + ) + + -- description, param, expected + [ ( "with val", "a", withVal ) + , ( "without val", "b", withoutVal ) + , ( "not present", "c", url ) + ] + + where + url = simpleUrl + { params = + [ ("a", Just "1") + , ("b", Nothing) + ] + } + withVal = simpleUrl { params = [("b", Nothing)] } + withoutVal = simpleUrl { params = [("a", Just "1")] } + simpleTxt :: T.Text simpleTxt = "http://example.com/"