| By | ~fr33domlover |
| At | 2018-05-13 |
| Title | URI rendering into Text |
| Description |
Edit file src/Network/IRI.hs 0 → 0
+ 28 , renderURI
… … … … - 39 import Control.Arrow ((***))
+ 40 import Control.Arrow (first, (***))
… … … … + 52 import Numeric (showHex)
- 57 import qualified Data.Text as T (null, concat)
+ 59 import qualified Data.Text as T (null, empty, pack, concat, intercalate)
… … … … + 135 renderURI :: URI t -> Text
+ 136 renderURI (URI (Scheme s) hier q f) = T.concat
+ 137 [ if B.null s
+ 138 then T.empty
+ 139 else decodeUtf8 s <> ":"
+ 140 , case hier of
+ 141 HierarchyAuthorized (Authority mui h mp) segs -> T.concat
+ 142 [ "//"
+ 143 , case mui of
+ 144 Nothing -> T.empty
+ 145 Just (UserInfo t) -> t <> "@"
+ 146 , case h of
+ 147 HostIPv4 (IPv4 w) ->
+ 148 T.intercalate "." $ map hex $ split 0xff w
+ 149 HostIPv6 (IPv6 w v) -> T.concat
+ 150 [ "["
+ 151 , T.intercalate ":" $
+ 152 map hex $
+ 153 split 0xffff w ++ split 0xffff v
+ 154 , "]"
+ 155 ]
+ 156 HostIPvFuture (IPvFuture i b) -> T.concat
+ 157 [ "[v"
+ 158 , hex i
+ 159 , "."
+ 160 , decodeUtf8 b
+ 161 , "]"
+ 162 ]
+ 163 HostRegName (RegName dsegs) ->
+ 164 T.intercalate "." $ map unsegD dsegs
+ 165 , case mp of
+ 166 Nothing -> T.empty
+ 167 Just (Port w) -> ":" <> T.pack (show w)
+ 168 , if null segs
+ 169 then T.empty
+ 170 else "/" <> T.intercalate "/" (map unsegP segs)
+ 171 ]
+ 172 HierarchyAbsolute segs ->
+ 173 "/" <> T.intercalate "/" (map unsegP segs)
+ 174 HierarchyRootless segs ->
+ 175 T.intercalate "/" $ map unsegP $ N.toList segs
+ 176 HierarchyEmpty -> T.empty
+ 177 , case q of
+ 178 Nothing -> T.empty
+ 179 Just (Query t) -> "?" <> t
+ 180 , case f of
+ 181 Nothing -> T.empty
+ 182 Just (Fragment t) -> "#" <> t
+ 183 ]
+ 184 where
+ 185 unsegP (PathSegment t) = t
+ 186 unsegD (DomainSegment t) = t
+ 187 split :: Integral i => i -> i -> [i]
+ 188 split b n =
+ 189 let dm = flip divMod b
+ 190 (((n1, n2), n3), n4) = first (first dm . dm) . dm $ n
+ 191 in [n1, n2, n3, n4]
+ 192 hex :: (Integral i, Show i) => i -> Text
+ 193 hex = T.pack . flip showHex ""
+ 194 … … … …