76 lines
2.8 KiB
Haskell
76 lines
2.8 KiB
Haskell
module Main (main) where
|
|
|
|
import Data.Foldable (for_)
|
|
import Network.URI
|
|
( URI
|
|
, URIAuth
|
|
, parseURI
|
|
, uriAuthority
|
|
, uriFragment
|
|
, uriPath
|
|
, uriPort
|
|
, uriQuery
|
|
, uriRegName
|
|
, uriScheme
|
|
, uriUserInfo
|
|
)
|
|
|
|
uriStrings :: [String]
|
|
uriStrings =
|
|
[ "https://bob:pass@example.com/place"
|
|
, "foo://example.com:8042/over/there?name=ferret#nose"
|
|
, "urn:example:animal:ferret:nose"
|
|
, "jdbc:mysql://test_user:ouupppssss@localhost:3306/sakila?profileSQL=true"
|
|
, "ftp://ftp.is.co.za/rfc/rfc1808.txt"
|
|
, "http://www.ietf.org/rfc/rfc2396.txt#header1"
|
|
, "ldap://[2001:db8::7]/c=GB?objectClass?one"
|
|
, "mailto:John.Doe@example.com"
|
|
, "news:comp.infosystems.www.servers.unix"
|
|
, "tel:+1-816-555-1212"
|
|
, "telnet://192.0.2.16:80/"
|
|
, "urn:oasis:names:specification:docbook:dtd:xml:4.1.2"
|
|
]
|
|
|
|
trimmedUriScheme :: URI -> String
|
|
trimmedUriScheme = init . uriScheme
|
|
|
|
trimmedUriUserInfo :: URIAuth -> Maybe String
|
|
trimmedUriUserInfo uriAuth =
|
|
case uriUserInfo uriAuth of
|
|
[] -> Nothing
|
|
userInfo -> if last userInfo == '@' then Just (init userInfo) else Nothing
|
|
|
|
trimmedUriPath :: URI -> String
|
|
trimmedUriPath uri = case uriPath uri of '/' : t -> t; p -> p
|
|
|
|
trimmedUriQuery :: URI -> Maybe String
|
|
trimmedUriQuery uri = case uriQuery uri of '?' : t -> Just t; _ -> Nothing
|
|
|
|
trimmedUriFragment :: URI -> Maybe String
|
|
trimmedUriFragment uri = case uriFragment uri of '#' : t -> Just t; _ -> Nothing
|
|
|
|
main :: IO ()
|
|
main = do
|
|
for_ uriStrings $ \uriString -> do
|
|
case parseURI uriString of
|
|
Nothing -> putStrLn $ "Could not parse" ++ uriString
|
|
Just uri -> do
|
|
putStrLn uriString
|
|
putStrLn $ " scheme = " ++ trimmedUriScheme uri
|
|
case uriAuthority uri of
|
|
Nothing -> return ()
|
|
Just uriAuth -> do
|
|
case trimmedUriUserInfo uriAuth of
|
|
Nothing -> return ()
|
|
Just userInfo -> putStrLn $ " user-info = " ++ userInfo
|
|
putStrLn $ " domain = " ++ uriRegName uriAuth
|
|
putStrLn $ " port = " ++ uriPort uriAuth
|
|
putStrLn $ " path = " ++ trimmedUriPath uri
|
|
case trimmedUriQuery uri of
|
|
Nothing -> return ()
|
|
Just query -> putStrLn $ " query = " ++ query
|
|
case trimmedUriFragment uri of
|
|
Nothing -> return ()
|
|
Just fragment -> putStrLn $ " fragment = " ++ fragment
|
|
putStrLn ""
|