293 lines
8.1 KiB
Haskell
293 lines
8.1 KiB
Haskell
{-
|
|
|
|
dmfix
|
|
|
|
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or (at
|
|
your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module HelpersSpec (spec) where
|
|
|
|
import qualified Data.Text as T
|
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
|
|
|
import Helpers
|
|
import Types
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
textToUrlSpec
|
|
urlToTextSpec
|
|
makeHttpsSpec
|
|
editHostSpec
|
|
dropParamSpec
|
|
editParamSpec
|
|
editAnchorSpec
|
|
incParamBySpec
|
|
incAnchorBySpec
|
|
incStrBySpec
|
|
updateLinkSpec
|
|
|
|
textToUrlSpec :: Spec
|
|
textToUrlSpec = describe "textToUrl" $ mapM_
|
|
( \(input, expected) -> context (show input) $
|
|
it ("should be " ++ show expected) $
|
|
textToUrl input `shouldBe` expected
|
|
)
|
|
|
|
-- input, expected
|
|
[ ( "", Nothing )
|
|
, ( "foo", Nothing )
|
|
, ( simpleTxt, Just simpleUrl )
|
|
, ( pathTxt, Just pathUrl )
|
|
, ( paramsTxt, Just paramsUrl )
|
|
, ( anchorTxt, Just anchorUrl )
|
|
]
|
|
|
|
urlToTextSpec :: Spec
|
|
urlToTextSpec = describe "urlToText" $ mapM_
|
|
( \(input, expected) -> context (show input) $
|
|
it ("should be " ++ show expected) $
|
|
urlToText input `shouldBe` expected
|
|
)
|
|
|
|
-- input, expected
|
|
[ ( simpleUrl, simpleTxt )
|
|
, ( pathUrl, pathTxt )
|
|
, ( paramsUrl, paramsTxt )
|
|
, ( 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 = describe "editHost" $ mapM_
|
|
( \(desc, f, url, expected) -> context desc $
|
|
it ("should be " ++ show expected) $
|
|
editHost f url `shouldBe` expected
|
|
)
|
|
|
|
-- description, function, url, expected
|
|
[ ( "reverse", Just . reverse, simpleUrl, reversed )
|
|
, ( "fail", const Nothing, simpleUrl, Nothing )
|
|
]
|
|
|
|
where
|
|
reversed = Just simpleUrl
|
|
{ host = reverse $ host simpleUrl }
|
|
|
|
dropParamSpec :: Spec
|
|
dropParamSpec = describe "dropParam" $ mapM_
|
|
( \(desc, p, expected) -> context desc $
|
|
it ("should be " ++ show expected) $
|
|
dropParam p url `shouldBe` expected
|
|
)
|
|
|
|
-- description, param, expected
|
|
[ ( "with val", "a", withVal )
|
|
, ( "without val", "b", withoutVal )
|
|
, ( "not present", "c", url )
|
|
]
|
|
|
|
where
|
|
url = simpleUrl
|
|
{ params =
|
|
[ ("a", Just "1")
|
|
, ("b", Nothing)
|
|
]
|
|
}
|
|
withVal = simpleUrl { params = [("b", Nothing)] }
|
|
withoutVal = simpleUrl { params = [("a", Just "1")] }
|
|
|
|
editParamSpec :: Spec
|
|
editParamSpec = describe "editParam" $ mapM_
|
|
( \(desc, pName, f, expected) -> context desc $
|
|
it ("should be " ++ show expected) $
|
|
editParam pName f url `shouldBe` expected
|
|
)
|
|
|
|
-- description, param name, function, expected
|
|
[ ( "reverse", "a", Just . reverse, Just reversed )
|
|
, ( "fail", "a", const Nothing, Nothing )
|
|
, ( "reverse empty", "c", Just . reverse, Just url )
|
|
, ( "fail empty", "c", const Nothing, Just url )
|
|
, ( "no reverse", "d", Just . reverse, Just url )
|
|
, ( "no fail", "d", const Nothing, Just url )
|
|
]
|
|
|
|
where
|
|
url = simpleUrl { params = mkParams "foo" }
|
|
reversed = simpleUrl { params = mkParams "oof" }
|
|
mkParams val =
|
|
[ ( "a", Just val )
|
|
, ( "b", Just "bar" )
|
|
, ( "c", Nothing )
|
|
]
|
|
|
|
editAnchorSpec :: Spec
|
|
editAnchorSpec = describe "editAnchor" $ mapM_
|
|
( \(desc, f, url, expected) -> context desc $
|
|
it ("should be " ++ show url) $
|
|
editAnchor f url `shouldBe` expected
|
|
)
|
|
|
|
-- description, function, url, expected
|
|
[ ( "reverse", Just . reverse, fooUrl, Just reversedUrl )
|
|
, ( "fail", const Nothing, fooUrl, Nothing )
|
|
, ( "reverse empty", Just . reverse, simpleUrl, Just simpleUrl )
|
|
, ( "fail empty", const Nothing, simpleUrl, Just simpleUrl )
|
|
]
|
|
|
|
where
|
|
fooUrl = urlWith "foo"
|
|
reversedUrl = urlWith "oof"
|
|
urlWith a = simpleUrl { anchor = Just a }
|
|
|
|
incParamBySpec :: Spec
|
|
incParamBySpec = describe "incParamBy" $ mapM_
|
|
( \(desc, n, pName, expected) -> context desc $
|
|
it ("should be " ++ show expected) $
|
|
incParamBy n pName url `shouldBe` expected
|
|
)
|
|
|
|
-- description, number, param, expected
|
|
[ ( "+1", 1, "a", Just $ urlWith "3" )
|
|
, ( "+2", 2, "a", Just $ urlWith "4" )
|
|
, ( "non-numeric", 1, "c", Nothing )
|
|
, ( "missing", 1, "d", Just url )
|
|
]
|
|
|
|
where
|
|
url = urlWith "2"
|
|
urlWith n = simpleUrl { params = mkParams n }
|
|
mkParams n =
|
|
[ ( "a", Just n )
|
|
, ( "b", Just "2" )
|
|
, ( "c", Just "foo" )
|
|
]
|
|
|
|
incAnchorBySpec :: Spec
|
|
incAnchorBySpec = describe "incAnchorBy" $ mapM_
|
|
( \(desc, n, url, expected) -> context desc $
|
|
it ("should be " ++ show expected) $
|
|
incAnchorBy n url `shouldBe` expected
|
|
)
|
|
|
|
-- description, number, url, expected
|
|
[ ( "+1", 1, urlWith "1", Just $ urlWith "2" )
|
|
, ( "+2", 2, urlWith "1", Just $ urlWith "3" )
|
|
, ( "empty", 1, simpleUrl, Just simpleUrl )
|
|
, ( "non-numeric", 1, urlWith "foo", Nothing )
|
|
]
|
|
|
|
where urlWith str = simpleUrl { anchor = Just str }
|
|
|
|
incStrBySpec :: Spec
|
|
incStrBySpec = describe "incStrBy" $ mapM_
|
|
( \(n, str, expected) ->
|
|
context (show str ++ " + " ++ show n) $
|
|
it ("should be " ++ show expected) $
|
|
incStrBy n str `shouldBe` expected
|
|
)
|
|
|
|
-- number, string, expected
|
|
[ ( 2, "3", Just "5" )
|
|
, ( 2, "foo", 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 = "http://example.com/"
|
|
|
|
simpleUrl :: Url
|
|
simpleUrl = newUrl
|
|
{ protocol = "http"
|
|
, host = "example.com"
|
|
}
|
|
|
|
pathTxt :: T.Text
|
|
pathTxt = simpleTxt `T.append` "foo/bar"
|
|
|
|
pathUrl :: Url
|
|
pathUrl = simpleUrl { path = ["foo", "bar"] }
|
|
|
|
paramsTxt :: T.Text
|
|
paramsTxt = pathTxt `T.append` "?a=1&b=2&c"
|
|
|
|
paramsUrl :: Url
|
|
paramsUrl = pathUrl
|
|
{ params =
|
|
[ ( "a", Just "1" )
|
|
, ( "b", Just "2" )
|
|
, ( "c", Nothing )
|
|
]
|
|
}
|
|
|
|
anchorTxt :: T.Text
|
|
anchorTxt = paramsTxt `T.append` "#abc"
|
|
|
|
anchorUrl :: Url
|
|
anchorUrl = paramsUrl { anchor = Just "abc" }
|
|
|
|
--jl
|