{-# LANGUAGE Safe #-}

{-|
Module      : Text.Comma
Description : Join text together with a comma, and "and".
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

This module provides functions to join elements of /string-like/ types by adding a comma between the elements, and an "and" (optionally with a comma) between the one-but-last and the last element.
-}

module Text.Comma (
    comma_, and_, commaAnd_
  , CommaStyle(OxfordComma, NoComma)
  , lastJoin
  , commaAs, commaEmptyAs, comma, noComma, commaEmpty, noCommaEmpty
  , combineWith, combineWithEmpty
  ) where

import Data.Default.Class(Default(def))
import Data.Foldable(toList)
import Data.String(IsString(fromString))

-- | The /string-like/ value for a comma, so @", "@.
comma_
  :: IsString s
  => s  -- ^ A /string-like/ type.
comma_ :: forall s. IsString s => s
comma_ = String -> s
forall a. IsString a => String -> a
fromString String
", "

-- | The /string-like/ value for an "and", so @" and "@.
and_
  :: IsString s
  => s  -- ^ A /string-like/ type.
and_ :: forall s. IsString s => s
and_ = String -> s
forall a. IsString a => String -> a
fromString String
" and "

-- | The /string-like/ value for a comma and an "and", so @", and "@.
commaAnd_
  :: IsString s
  => s  -- ^ A /string-like/ type.
commaAnd_ :: forall s. IsString s => s
commaAnd_ = String -> s
forall a. IsString a => String -> a
fromString String
", and "

-- | The two different ways to join the last two items together: with or without a comma.
data CommaStyle
  = OxfordComma  -- ^ The /Oxford comma/ which uses a comma before the latest element, also known as /Harvard comma/ or /series comma/.
  | NoComma  -- ^ The comma style where there is no comma before the "and" of the last item, informally known as the /Heathen comma/.
  deriving (CommaStyle
CommaStyle -> CommaStyle -> Bounded CommaStyle
forall a. a -> a -> Bounded a
$cminBound :: CommaStyle
minBound :: CommaStyle
$cmaxBound :: CommaStyle
maxBound :: CommaStyle
Bounded, Int -> CommaStyle
CommaStyle -> Int
CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle
CommaStyle -> CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
(CommaStyle -> CommaStyle)
-> (CommaStyle -> CommaStyle)
-> (Int -> CommaStyle)
-> (CommaStyle -> Int)
-> (CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle])
-> Enum CommaStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CommaStyle -> CommaStyle
succ :: CommaStyle -> CommaStyle
$cpred :: CommaStyle -> CommaStyle
pred :: CommaStyle -> CommaStyle
$ctoEnum :: Int -> CommaStyle
toEnum :: Int -> CommaStyle
$cfromEnum :: CommaStyle -> Int
fromEnum :: CommaStyle -> Int
$cenumFrom :: CommaStyle -> [CommaStyle]
enumFrom :: CommaStyle -> [CommaStyle]
$cenumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
Enum, CommaStyle -> CommaStyle -> Bool
(CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool) -> Eq CommaStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommaStyle -> CommaStyle -> Bool
== :: CommaStyle -> CommaStyle -> Bool
$c/= :: CommaStyle -> CommaStyle -> Bool
/= :: CommaStyle -> CommaStyle -> Bool
Eq, Eq CommaStyle
Eq CommaStyle =>
(CommaStyle -> CommaStyle -> Ordering)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> CommaStyle)
-> (CommaStyle -> CommaStyle -> CommaStyle)
-> Ord CommaStyle
CommaStyle -> CommaStyle -> Bool
CommaStyle -> CommaStyle -> Ordering
CommaStyle -> CommaStyle -> CommaStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommaStyle -> CommaStyle -> Ordering
compare :: CommaStyle -> CommaStyle -> Ordering
$c< :: CommaStyle -> CommaStyle -> Bool
< :: CommaStyle -> CommaStyle -> Bool
$c<= :: CommaStyle -> CommaStyle -> Bool
<= :: CommaStyle -> CommaStyle -> Bool
$c> :: CommaStyle -> CommaStyle -> Bool
> :: CommaStyle -> CommaStyle -> Bool
$c>= :: CommaStyle -> CommaStyle -> Bool
>= :: CommaStyle -> CommaStyle -> Bool
$cmax :: CommaStyle -> CommaStyle -> CommaStyle
max :: CommaStyle -> CommaStyle -> CommaStyle
$cmin :: CommaStyle -> CommaStyle -> CommaStyle
min :: CommaStyle -> CommaStyle -> CommaStyle
Ord, ReadPrec [CommaStyle]
ReadPrec CommaStyle
Int -> ReadS CommaStyle
ReadS [CommaStyle]
(Int -> ReadS CommaStyle)
-> ReadS [CommaStyle]
-> ReadPrec CommaStyle
-> ReadPrec [CommaStyle]
-> Read CommaStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommaStyle
readsPrec :: Int -> ReadS CommaStyle
$creadList :: ReadS [CommaStyle]
readList :: ReadS [CommaStyle]
$creadPrec :: ReadPrec CommaStyle
readPrec :: ReadPrec CommaStyle
$creadListPrec :: ReadPrec [CommaStyle]
readListPrec :: ReadPrec [CommaStyle]
Read, Int -> CommaStyle -> ShowS
[CommaStyle] -> ShowS
CommaStyle -> String
(Int -> CommaStyle -> ShowS)
-> (CommaStyle -> String)
-> ([CommaStyle] -> ShowS)
-> Show CommaStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommaStyle -> ShowS
showsPrec :: Int -> CommaStyle -> ShowS
$cshow :: CommaStyle -> String
show :: CommaStyle -> String
$cshowList :: [CommaStyle] -> ShowS
showList :: [CommaStyle] -> ShowS
Show)

instance Default CommaStyle where
  def :: CommaStyle
def = CommaStyle
OxfordComma

-- | Specify the string that determines how to join the last but one and the last item based on the 'CommaStyle'.
lastJoin
  :: IsString s
  => CommaStyle -- ^ The given comma style.
  -> s  -- ^ A string that specifies how to join the last but one item and the last item based on the comma style.
lastJoin :: forall s. IsString s => CommaStyle -> s
lastJoin CommaStyle
OxfordComma = s
forall s. IsString s => s
commaAnd_
lastJoin CommaStyle
_ = s
forall s. IsString s => s
and_

-- | Join the 'Foldable' of elements with a given item for a comma and for the last join with a custom value if the 'Foldable' is empty.
combineWithEmpty
  :: (Semigroup s, Foldable f)
  => s  -- ^ The item used if the foldable item is empty.
  -> s  -- ^ The /comma/ item placed between each item and the next, except for the last join.
  -> s  -- ^ The item used to join the one but last item and the last item.
  -> f s  -- ^ The 'Foldable' of items that should be joined.
  -> s  -- ^ The item generated by joining the elements with the comma and last join item.
combineWithEmpty :: forall s (f :: * -> *).
(Semigroup s, Foldable f) =>
s -> s -> s -> f s -> s
combineWithEmpty s
e s
c0 s
c1 = s -> s -> s -> [s] -> s
forall s. Semigroup s => s -> s -> s -> [s] -> s
_combine s
e s
c0 s
c1 ([s] -> s) -> (f s -> [s]) -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f s -> [s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Join the 'Foldable' of elements with a given item for a comma and for the last join.
combineWith
  :: (Monoid s, Foldable f)
  => s  -- ^ The /comma/ item placed between each item and the next, except for the last join.
  -> s  -- ^ The item used to join the one but last item and the last item.
  -> f s  -- ^ The 'Foldable' of items that should be joined.
  -> s  -- ^ The item generated by joining the elements with the comma and last join item.
combineWith :: forall s (f :: * -> *).
(Monoid s, Foldable f) =>
s -> s -> f s -> s
combineWith s
c0 s
c1 = s -> s -> s -> [s] -> s
forall s. Semigroup s => s -> s -> s -> [s] -> s
_combine s
forall a. Monoid a => a
mempty s
c0 s
c1 ([s] -> s) -> (f s -> [s]) -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f s -> [s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

_combine :: Semigroup s => s -> s -> s -> [s] -> s
_combine :: forall s. Semigroup s => s -> s -> s -> [s] -> s
_combine s
e s
_ s
_ [] = s
e
_combine s
_ s
_ s
_ [s
s] = s
s
_combine s
_ s
c0 s
c1 (s
x:s
x2:[s]
xs) = [s] -> s -> s -> s
go [s]
xs s
x s
x2
  where go :: [s] -> s -> s -> s
go [] s
s1 s
s2 = s
s1 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
c1 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
s2
        go (s
s3:[s]
ss) s
s1 s
s2 = s
s1 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
c0 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [s] -> s -> s -> s
go [s]
ss s
s2 s
s3

-- | Joins the sequence of items with the /Oxford comma/ style, uses the empty string if there are no items.
comma :: (IsString s, Monoid s, Foldable f) => f s -> s
comma :: forall s (f :: * -> *).
(IsString s, Monoid s, Foldable f) =>
f s -> s
comma = s -> s -> f s -> s
forall s (f :: * -> *).
(Monoid s, Foldable f) =>
s -> s -> f s -> s
combineWith s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
commaAnd_

-- | Joins the sequence of items with the /no comma/ style, uses the empty string if there are no items.
noComma :: (IsString s, Monoid s, Foldable f) => f s -> s
noComma :: forall s (f :: * -> *).
(IsString s, Monoid s, Foldable f) =>
f s -> s
noComma = s -> s -> f s -> s
forall s (f :: * -> *).
(Monoid s, Foldable f) =>
s -> s -> f s -> s
combineWith s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
and_

-- | Join the sequence of items with the /Oxford comma/ style, uses a given "string" if there are no items.
commaEmpty :: (IsString s, Semigroup s, Foldable f) => s -> f s -> s
commaEmpty :: forall s (f :: * -> *).
(IsString s, Semigroup s, Foldable f) =>
s -> f s -> s
commaEmpty s
e = s -> s -> s -> f s -> s
forall s (f :: * -> *).
(Semigroup s, Foldable f) =>
s -> s -> s -> f s -> s
combineWithEmpty s
e s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
commaAnd_

-- | Join the sequence of items with the /no comma/ style, uses a given "string" if there are no items.
noCommaEmpty :: (IsString s, Semigroup s, Foldable f) => s -> f s -> s
noCommaEmpty :: forall s (f :: * -> *).
(IsString s, Semigroup s, Foldable f) =>
s -> f s -> s
noCommaEmpty s
e = s -> s -> s -> f s -> s
forall s (f :: * -> *).
(Semigroup s, Foldable f) =>
s -> s -> s -> f s -> s
combineWithEmpty s
e s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
and_

-- | Join the sequence of items with the given comma style, uses the empty string if there are no items.
commaAs :: (IsString s, Monoid s, Foldable f) => CommaStyle -> f s -> s
commaAs :: forall s (f :: * -> *).
(IsString s, Monoid s, Foldable f) =>
CommaStyle -> f s -> s
commaAs = s -> s -> f s -> s
forall s (f :: * -> *).
(Monoid s, Foldable f) =>
s -> s -> f s -> s
combineWith s
forall s. IsString s => s
comma_ (s -> f s -> s) -> (CommaStyle -> s) -> CommaStyle -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaStyle -> s
forall s. IsString s => CommaStyle -> s
lastJoin

-- | Join the sequence of items with the given comma style, uses a given "string" if there are no items.
commaEmptyAs :: (IsString s, Semigroup s, Foldable f) => s -> CommaStyle -> f s -> s
commaEmptyAs :: forall s (f :: * -> *).
(IsString s, Semigroup s, Foldable f) =>
s -> CommaStyle -> f s -> s
commaEmptyAs s
e = s -> s -> s -> f s -> s
forall s (f :: * -> *).
(Semigroup s, Foldable f) =>
s -> s -> s -> f s -> s
combineWithEmpty s
e s
forall s. IsString s => s
comma_ (s -> f s -> s) -> (CommaStyle -> s) -> CommaStyle -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaStyle -> s
forall s. IsString s => CommaStyle -> s
lastJoin