module Texts.Web
(explodeLinks)
where
import Texts.Types
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import Network.URI
import Test.HUnit
explodeLinks :: SText -> [Either URI SText]
explodeLinks = consume where
consume t =
if T.null t
then []
else case T.breakOn prefix t of
(_before,"") -> [Right t]
(before,after) ->
case T.span allowed after of
(murl,rest) -> case parseURI (T.unpack murl) of
Nothing -> let leading = before <> prefix
in case consume (T.drop 4 after) of
(Right x:xs) -> Right (leading <> x) : xs
xs -> Right leading : xs
Just uri -> (if T.null before then id else (Right before :))
(Left uri : explodeLinks rest)
prefix = "http"
allowed '(' = False
allowed ')' = False
allowed c = isAllowedInURI c
_tests :: Test
_tests = TestList $ map testify
[("empty","",[])
,("just text","abc",[Right "abc"])
,("just link","http://abc",[Left (uri "http://abc")])
,("link start","http://abc foobar",[Left (uri "http://abc"),Right " foobar"])
,("link end","foobar http://abc",[Right "foobar ",Left (uri "http://abc")])
,("link mid","foobar http://abc zot",[Right "foobar ",Left (uri "http://abc"),Right " zot"])
,("has http","http http://abc zot",[Right "http ",Left (uri "http://abc"),Right " zot"])
,("has http (2)","foo http http://abc zot",[Right "foo http ",Left (uri "http://abc"),Right " zot"])
,("non-uri char","foo \"http://abc\" zot",[Right "foo \"",Left (uri "http://abc"),Right "\" zot"])
,("non-uri char (2)","foo <http://abc> zot",[Right "foo <",Left (uri "http://abc"),Right "> zot"])
]
where uri = fromJust . parseURI
testify (label,param,expected) = TestCase (assertEqual label (explodeLinks param) expected)