-- |
-- Module      :  Text.Inflections.Ordinal
-- Copyright   :  © 2016 Justin Leitgeb
-- License     :  MIT
--
-- Maintainer  :  Justin Leitgeb <justin@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Conversion to spelled ordinal numbers.

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Text.Inflections.Ordinal
  ( ordinalize
  , ordinal )
where

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T

-- |Turns a number into an ordinal string used to denote the position in an
-- ordered sequence such as 1st, 2nd, 3rd, 4th.
--
-- >>> ordinalize 1
-- "1st"
-- >>> ordinalize 2
-- "2nd"
-- >>> ordinalize 10
-- "10th"
ordinalize :: (Integral a, Show a) => a -> Text
ordinalize :: forall a. (Integral a, Show a) => a -> Text
ordinalize a
n = String -> Text
T.pack (forall a. Show a => a -> String
show a
n) forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Text
ordinal a
n

-- |Returns the suffix that should be added to a number to denote the position
-- in an ordered sequence such as 1st, 2nd, 3rd, 4th.
--
-- >>> ordinal 1
-- "st"
-- >>> ordinal 2
-- "nd"
-- >>> ordinal 10
-- "th"
ordinal :: Integral a => a -> Text
ordinal :: forall a. Integral a => a -> Text
ordinal a
number
        | a
remainder100 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
11..a
13] = Text
"th"
        | a
remainder10 forall a. Eq a => a -> a -> Bool
== a
1             = Text
"st"
        | a
remainder10 forall a. Eq a => a -> a -> Bool
== a
2             = Text
"nd"
        | a
remainder10 forall a. Eq a => a -> a -> Bool
== a
3             = Text
"rd"
        | Bool
otherwise                    = Text
"th"
  where abs_number :: a
abs_number   = forall a. Num a => a -> a
abs a
number
        remainder10 :: a
remainder10  = a
abs_number forall a. Integral a => a -> a -> a
`mod` a
10
        remainder100 :: a
remainder100 = a
abs_number forall a. Integral a => a -> a -> a
`mod` a
100