module Data.Texts
(LText
,SText
,ToText(..)
,FromText(..)
,explodeLinks
,bigUp
,relativeTimes
,ellipsize
,ordSuffix
)
where
import Data.Lists
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import Data.Time
import Network.URI
import Test.HUnit
import Text.Printf
type LText = L.Text
type SText = T.Text
class ToText a where
toText :: a -> SText
toLazyText :: a -> LText
instance ToText SText where
toText = id
toLazyText = L.fromStrict
instance ToText String where
toText = T.pack
toLazyText = L.pack
class FromText a where
fromText :: SText -> Maybe a
fromLazyText :: LText -> Maybe a
instance FromText String where
fromText = Just . T.unpack
fromLazyText = Just . L.unpack
bigUp :: (Integral a) => a -> SText
bigUp = go . fromIntegral where
go :: Integer -> SText
go n | n < 3 = "a couple"
| n < 5 = "several"
| n < 10 = "many"
| n < 80 = "dozens"
| n < 100 = "nearly a hundred"
| n < 200 = "some hundred"
| n < 1000 = "hundreds"
| n < 10000 = "thousands"
| n < 100000 = "tens of thousands"
| n < 200000 = "a hundred thousand"
| n < 500000 = "hundreds of thousands"
| n < 500000 = "half a million"
| n < 600000 = "over half a million"
| n < 1000000 = "nearly a million"
| n < 2000000 = "over a million"
| n < (10^ (9::Int)) = "millions"
| n < 10^ (12::Int) = "billions"
| otherwise = "trillions"
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
relativeTimes :: UTCTime
-> UTCTime
-> Bool
-> SText
relativeTimes t1 t2 fix = T.pack $ maybe "unknown" format $ find (\(s,_,_) -> abs span'>=s) $ reverse ranges where
minute = 60; hour = minute * 60; day = hour * 24;
week = day * 7; month = day * 30; year = month * 12
format range =
(if fix && span'>0 then "in " else "")
++ case range of
(_,str,0) -> str
(_,str,base) -> printf str (abs $ round (span' / base) :: Integer)
++ (if fix && span'<0 then " ago" else "")
span' = t1 `diffUTCTime` t2
ranges = [(0,"%d seconds",1)
,(minute,"a minute",0)
,(minute*2,"%d minutes",minute)
,(minute*30,"half an hour",0)
,(minute*31,"%d minutes",minute)
,(hour,"an hour",0)
,(hour*2,"%d hours",hour)
,(hour*3,"a few hours",0)
,(hour*4,"%d hours",hour)
,(day,"a day",0)
,(day*2,"%d days",day)
,(week,"a week",0)
,(week*2,"%d weeks",week)
,(month,"a month",0)
,(month*2,"%d months",month)
,(year,"a year",0)
,(year*2,"%d years",year)
]
ellipsize :: Int -> SText -> SText
ellipsize n xs
| T.length xs > n = T.take n $ T.take (max 1 (n1)) xs <> "…"
| otherwise = xs
ordSuffix :: Integral n => n -> SText
ordSuffix n
| tens > 3 && tens < 21 = "th"
| otherwise = case n `mod` 10 of
1 -> "st"; 2 -> "nd"; 3 -> "rd"; _ -> "th"
where tens = n `mod` 100
_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)