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