implemented Handlers.updateLink
This commit is contained in:
parent
89879153de
commit
0a8bffa4f2
|
@ -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
|
||||
|
|
|
@ -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/"
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user