{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Texts
  (LText
  ,SText
  ,ToText(..)
  ,FromText(..)
  ,explodeLinks
  ,bigUp
  ,relativeTimes
  )
  where

import           Data.Lists
import           Data.Maybe
import           Data.Monoid
import           Data.Nums
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

-- | Lazy text.
type LText = L.Text

-- | Strict text.
type SText = T.Text

-- | A class for converting to 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

-- | A class for converting from Text.
class FromText a where
  fromText :: SText -> Maybe a
  fromLazyText :: LText -> Maybe a

instance FromText String where
  fromText = Just . T.unpack
  fromLazyText = Just . L.unpack

-- | Big 'em up.
bigUp :: (Integral a) => a -> SText
bigUp = go . fi 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"

-- | Explode a text into its constituent links.
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"
  -- Because it's not normal, and it's annoying.
  allowed '(' = False
  allowed ')' = False
  allowed c = isAllowedInURI c

-- TODO: Port to thyme.
-- | Display a time span as one time relative to another.
relativeTimes :: UTCTime -- ^ The later time span.
              -> UTCTime -- ^ The earlier time span.
              -> Bool    -- ^ Display 'in/ago'?
              -> SText   -- ^ Example: '3 seconds ago', 'in three days'.
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)
           ]

-- TODO: Put these in cabal tests.
_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)