implemented Helpers.makeHttps

src/Helpers.hs

@@ -25,6 +25,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 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)

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 $