diff --git a/src/Helpers.hs b/src/Helpers.hs index 78bf03b..5095f32 100644 --- a/src/Helpers.hs +++ b/src/Helpers.hs @@ -25,6 +25,7 @@ along with this program. If not, see . module Helpers ( textToUrl, urlToText, + makeHttps, editHost ) where @@ -63,6 +64,15 @@ urlToText url = T.pack $ Just str -> "#" ++ str Nothing -> "" +-- | Convert HTTP to HTTPS (if necessary) +makeHttps :: Url -> Maybe Url +makeHttps url = if any ($ protocol url) + [ (== "https") + , (== "http") + ] + then Just url { protocol = "https" } + else Nothing + -- | Edit the 'host' value of a 'Url' editHost :: (String -> Maybe String) diff --git a/test/HelpersSpec.hs b/test/HelpersSpec.hs index 895fafb..c17aaf7 100644 --- a/test/HelpersSpec.hs +++ b/test/HelpersSpec.hs @@ -33,6 +33,7 @@ spec :: Spec spec = do textToUrlSpec urlToTextSpec + makeHttpsSpec editHostSpec textToUrlSpec :: Spec @@ -65,6 +66,23 @@ urlToTextSpec = describe "urlToText" $ mapM_ , ( anchorUrl, anchorTxt ) ] +makeHttpsSpec :: Spec +makeHttpsSpec = describe "makeHttps" $ mapM_ + ( \(desc, input, expected) -> context desc $ + it ("should be " ++ show expected) $ + makeHttps input `shouldBe` expected + ) + + -- description, input, expected + [ ( "HTTP", simpleUrl, Just https ) + , ( "HTTPS", https, Just https ) + , ( "FTP", urlWith "ftp", Nothing ) + ] + + where + https = urlWith "https" + urlWith p = simpleUrl { protocol = p } + editHostSpec ::Spec editHostSpec = describe "editHost" $ mapM_ ( \(desc, f, url, expected) -> context desc $