implemented Helpers.makeHttps
This commit is contained in:
parent
b7737766f6
commit
b809cdf082
|
@ -25,6 +25,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
module Helpers (
|
module Helpers (
|
||||||
textToUrl,
|
textToUrl,
|
||||||
urlToText,
|
urlToText,
|
||||||
|
makeHttps,
|
||||||
editHost
|
editHost
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -63,6 +64,15 @@ urlToText url = T.pack $
|
||||||
Just str -> "#" ++ str
|
Just str -> "#" ++ str
|
||||||
Nothing -> ""
|
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'
|
-- | Edit the 'host' value of a 'Url'
|
||||||
editHost
|
editHost
|
||||||
:: (String -> Maybe String)
|
:: (String -> Maybe String)
|
||||||
|
|
|
@ -33,6 +33,7 @@ spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
textToUrlSpec
|
textToUrlSpec
|
||||||
urlToTextSpec
|
urlToTextSpec
|
||||||
|
makeHttpsSpec
|
||||||
editHostSpec
|
editHostSpec
|
||||||
|
|
||||||
textToUrlSpec :: Spec
|
textToUrlSpec :: Spec
|
||||||
|
@ -65,6 +66,23 @@ urlToTextSpec = describe "urlToText" $ mapM_
|
||||||
, ( anchorUrl, anchorTxt )
|
, ( 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 ::Spec
|
||||||
editHostSpec = describe "editHost" $ mapM_
|
editHostSpec = describe "editHost" $ mapM_
|
||||||
( \(desc, f, url, expected) -> context desc $
|
( \(desc, f, url, expected) -> context desc $
|
||||||
|
|
Loading…
Reference in New Issue
Block a user