diff --git a/src/Helpers.hs b/src/Helpers.hs index 0a8eac1..b1a2385 100644 --- a/src/Helpers.hs +++ b/src/Helpers.hs @@ -32,7 +32,8 @@ module Helpers ( editAnchor, incParamBy, incAnchorBy, - incStrBy + incStrBy, + updateLink ) where import qualified Data.List as L @@ -167,6 +168,22 @@ incStrBy n str = case reads str of [(m, "")] -> Just $ show $ n + m _ -> 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 text = case T.splitOn "://" text of [protT, raw] -> do diff --git a/test/HelpersSpec.hs b/test/HelpersSpec.hs index 01d51d8..24b3a55 100644 --- a/test/HelpersSpec.hs +++ b/test/HelpersSpec.hs @@ -41,6 +41,7 @@ spec = do incParamBySpec incAnchorBySpec incStrBySpec + updateLinkSpec textToUrlSpec :: Spec textToUrlSpec = describe "textToUrl" $ mapM_ @@ -225,6 +226,36 @@ incStrBySpec = describe "incStrBy" $ mapM_ , ( 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 = "http://example.com/"