implemented decodeGemURL

src/Network/GemServ.hs

@@ -24,10 +24,11 @@ License along with this program.  If not, see
 
 -}
 
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase, OverloadedStrings, RecordWildCards #-}
 
 module Network.GemServ (
   encodeGemURL,
+  decodeGemURL,
   escapeString,
   unescapeString
 ) where
@@ -56,6 +57,49 @@ encodeGemURL url =
       Nothing -> ""
       Just q  -> '?' : escapeString q
 
+-- | Decodes a 'GemURL' from a 'String' (if possible)
+decodeGemURL :: String -> Maybe GemURL
+decodeGemURL str = do
+  let txt = T.pack str
+
+  noProt <- case T.splitOn "://" txt of
+    [prot, rest] -> if T.toLower prot == "gemini"
+      then Just rest
+      else Nothing
+    _ -> Nothing
+
+  noFrag <- case T.splitOn "#" noProt of
+    [x, _] -> Just x
+    [x]    -> Just x
+    _      -> Nothing
+
+  (noQuery, query) <- case T.splitOn "?" noFrag of
+    [nq, q] -> Just (nq, Just q)
+    [nq]    -> Just (nq, Nothing)
+    _       -> Nothing
+
+  gemQuery <- case query of
+    Just q  -> Just <$> unescapeString (T.unpack q)
+    Nothing -> Just Nothing
+
+  (auth, path) <- case T.splitOn "/" noQuery of
+    [a]     -> Just (a, [])
+    [a, ""] -> Just (a, [])
+    a:ps    -> Just (a, ps)
+    _       -> Nothing
+
+  gemPath  <- mapM (unescapeString . T.unpack) path
+
+  (host, gemPort) <- case T.splitOn ":" auth of
+    [h, p] -> case reads $ T.unpack p of
+      [(n, "")] -> Just (h, Just n)
+      _         -> Nothing
+    [h] -> Just (h, Nothing)
+    _   -> Nothing
+
+  let gemHost = T.unpack host
+  Just GemURL {..}
+
 -- | add required escape sequences to a string
 escapeString :: String -> String
 escapeString = concatMap

test/Network/GemServSpec.hs

@@ -30,6 +30,7 @@ import Network.GemServ.Types
 spec :: Spec
 spec = describe "Network.GemServ" $ do
   encodeGemURLSpec
+  decodeGemURLSpec
   escapeStringSpec
   unescapeStringSpec
 
@@ -68,6 +69,50 @@ encodeGemURLSpec = describe "encodeGemURL" $ mapM_
 
     withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
 
+decodeGemURLSpec :: Spec
+decodeGemURLSpec = describe "decodeGemURL" $ mapM_
+  ( \(str, expected) -> context (show str) $
+    it ("should be " ++ show expected) $
+      decodeGemURL str `shouldBe` expected
+  )
+
+  --  URL string,   expected
+  [ ( simpleStr,       Just simpleURL     )
+  , ( withSlashStr,    Just simpleURL     )
+  , ( withPathStr,     Just withPathURL   )
+  , ( withQueryStr,    Just withQueryURL  )
+  , ( pathQueryStr,    Just pathQueryURL  )
+  , ( blankQueryStr,   Just blankQueryURL )
+  , ( withFragmentStr, Just simpleURL     )
+  , ( escapedStr,      Just escapedURL    )
+  , ( httpStr,         Nothing            )
+  , ( malformed,       Nothing            )
+  , ( "",              Nothing            )
+  ]
+
+  where
+    simpleStr       = "gemini://example.com"
+    simpleURL       = newGemURL "example.com"
+    withSlashStr    = simpleStr ++ "/"
+    withPathStr     = simpleStr ++ "/foo/bar"
+    withPathURL     = simpleURL { gemPath = ["foo", "bar"] }
+    withQueryStr    = simpleStr ++ "?foo"
+    withQueryURL    = simpleURL { gemQuery = Just "foo" }
+    pathQueryStr    = withPathStr ++ "?baz"
+    pathQueryURL    = withPathURL { gemQuery = Just "baz" }
+    blankQueryStr   = simpleStr ++"?"
+    blankQueryURL   = simpleURL { gemQuery = Just "" }
+    withFragmentStr = simpleStr ++ "#foo"
+    escapedStr      = simpleStr ++ "/foo%20bar/baz?quux%20stuff"
+
+    escapedURL      = simpleURL
+      { gemPath = ["foo bar", "baz"]
+      , gemQuery = Just "quux stuff"
+      }
+
+    httpStr   = "http://example.com"
+    malformed = "foo"
+
 escapeStringSpec :: Spec
 escapeStringSpec = describe "escapeString" $ mapM_
   ( \(input, expected) -> context (show input) $