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

-- | English-focused text operations.

module Texts.English
  (
  -- * Marketing
   bigUp
  -- * Time
  ,relativeTimes
  -- * Typography
  ,ellipsize
  -- * English numbers
  ,ordSuffix
  -- * English grammar
  ,indefinite
  -- * Letter information
  ,isVowel
  ,isConsonant
  )
  where

import           Texts.Types

import           Data.Lists
import           Data.Monoid
import qualified Data.Text as T
import           Data.Time
import           Text.Printf

-- | Given an integral number, give it a vague English description
-- which makes it seem better than it is. Examples: \<3 -\> a couple,
-- \<1000 -\> hundreds, etc.
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 < 500500         = "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"

-- 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)
           ]

-- | Limit the length of the string and ellipsize it.
ellipsize :: Int -> SText -> SText
ellipsize n xs
  | T.length xs > n = T.take n $ T.take (max 1 (n-1)) xs <> "…"
  | otherwise     = xs

-- | Add a suffix to an integral, e.g. 1st, 2nd, 3rd, 21st.
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

-- | The indefinite article to be used before a word, e.g. \"An\"
-- elephant, \"a\" car, etc.
indefinite :: SText -> SText
indefinite word
  | T.all isVowel (T.take 1 word) = "an"
  | otherwise = "a"

-- | Is a character a vowel?
isVowel :: Char -> Bool
isVowel = flip elem "aeiou"

-- | Is a character a consonant?
isConsonant :: Char -> Bool
isConsonant = flip elem "bcsfghjklmnpqrstvwxyz"