implemented Handlers.updateLink

This commit is contained in:
Jonathan Lamothe 2021-09-22 21:19:42 -04:00
parent 89879153de
commit 0a8bffa4f2
2 changed files with 49 additions and 1 deletions

View File

@ -32,7 +32,8 @@ module Helpers (
editAnchor, editAnchor,
incParamBy, incParamBy,
incAnchorBy, incAnchorBy,
incStrBy incStrBy,
updateLink
) where ) where
import qualified Data.List as L import qualified Data.List as L
@ -167,6 +168,22 @@ incStrBy n str = case reads str of
[(m, "")] -> Just $ show $ n + m [(m, "")] -> Just $ show $ n + m
_ -> Nothing _ -> Nothing
-- | Update an old message board link
updateLink :: T.Text -> Maybe T.Text
updateLink text = textToUrl text
>>= makeHttps
>>= editHost
( \case
"www.mormondiscussions.com" -> Just "www.discussmormonism.com"
"mormondiscussions.com" -> Just "discussmormonism.com"
_ -> Nothing
)
>>= Just . dropParam "f"
>>= incParamBy 100000 "t"
>>= incParamBy 1500000 "p"
>>= incAnchorBy 1500000
>>= Just . urlToText
subToUrl :: T.Text -> Maybe Url subToUrl :: T.Text -> Maybe Url
subToUrl text = case T.splitOn "://" text of subToUrl text = case T.splitOn "://" text of
[protT, raw] -> do [protT, raw] -> do

View File

@ -41,6 +41,7 @@ spec = do
incParamBySpec incParamBySpec
incAnchorBySpec incAnchorBySpec
incStrBySpec incStrBySpec
updateLinkSpec
textToUrlSpec :: Spec textToUrlSpec :: Spec
textToUrlSpec = describe "textToUrl" $ mapM_ textToUrlSpec = describe "textToUrl" $ mapM_
@ -225,6 +226,36 @@ incStrBySpec = describe "incStrBy" $ mapM_
, ( 2, "", Nothing ) , ( 2, "", Nothing )
] ]
updateLinkSpec :: Spec
updateLinkSpec = describe "updateLink" $ mapM_
( \(input, expected) -> context (show input) $
it ("should be " ++ show expected) $
updateLink input `shouldBe` expected
)
[ ( "http://www.mormondiscussions.com/viewtopic.php?f=1&t=34500"
, Just "https://www.discussmormonism.com/viewtopic.php?t=134500"
)
, ( "http://www.mormondiscussions.com/viewtopic.php?f=1&t=696&p=96969#96969"
, Just "https://www.discussmormonism.com/viewtopic.php?t=100696&p=1596969#1596969"
)
, ( "http://www.mormondiscussions.com/viewtopic.php"
, Just "https://www.discussmormonism.com/viewtopic.php"
)
, ( "http://mormondiscussions.com/viewtopic.php?f=1&t=34500"
, Just "https://discussmormonism.com/viewtopic.php?t=134500"
)
, ( "http://mormondiscussions.com/viewtopic.php?f=1&t=696&p=96969#96969"
, Just "https://discussmormonism.com/viewtopic.php?t=100696&p=1596969#1596969"
)
, ( "http://mormondiscussions.com/viewtopic.php"
, Just "https://discussmormonism.com/viewtopic.php"
)
, ( "http://example.com"
, Nothing
)
]
simpleTxt :: T.Text simpleTxt :: T.Text
simpleTxt = "http://example.com/" simpleTxt = "http://example.com/"