implemented encodeRequest

Note: this does not yet handle percent-escaped characters
This commit is contained in:
Jonathan Lamothe 2021-10-22 14:29:15 -04:00
parent bb7b2ebaa2
commit d56116d4c9
2 changed files with 50 additions and 3 deletions

View File

@ -24,6 +24,25 @@ License along with this program. If not, see
-} -}
module Network.GemServ where module Network.GemServ (
encodeRequest
) where
import Data.List (intercalate)
import Network.GemServ.Types
-- | Encodes a 'Request' into a 'String'
encodeRequest :: Request -> String
encodeRequest req =
"gemini://" ++ authority ++ "/" ++ path ++ query
where
authority = reqHost req ++ case reqPort req of
Just port -> ':' : show port
Nothing -> ""
path = intercalate "/" $ reqPath req
query = case reqQuery req of
"" -> ""
q -> '?' : q
--jl --jl

View File

@ -22,9 +22,37 @@ License along with this program. If not, see
module Network.GemServSpec (spec) where module Network.GemServSpec (spec) where
import Test.Hspec (Spec, describe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Network.GemServ
import Network.GemServ.Types
spec :: Spec spec :: Spec
spec = describe "Network.GemServ" $ return () spec = describe "Network.GemServ"
encodeRequestSpec
encodeRequestSpec :: Spec
encodeRequestSpec = describe "encodeRequest" $ mapM_
( \(desc, req, expected) -> context desc $
it ("should be " ++ show expected) $
encodeRequest req `shouldBe` expected
)
-- description, request, expected
[ ( "simple", simpleReq, simpleExp )
, ( "with port", withPortReq, withPortExp )
, ( "with path", withPathReq, withPathExp )
, ( "with query", withQueryReq, withQueryExp )
]
where
simpleReq = newRequest "example.com"
simpleExp = "gemini://example.com/"
withPortReq = simpleReq { reqPort = Just 1965 }
withPortExp = "gemini://example.com:1965/"
withPathReq = simpleReq { reqPath = ["foo", "bar"] }
withPathExp = "gemini://example.com/foo/bar"
withQueryReq = simpleReq { reqQuery = "foo" }
withQueryExp = "gemini://example.com/?foo"
--jl --jl