{-# LANGUAGE Safe #-}
module Text.Comma
(
CommaStyle (OxfordComma, NoComma),
CommaValues (CommaValues, commaText, commaAndText),
toCommaValues,
lastJoin,
commaAs,
commaEmptyAs,
commaWith,
commaEmptyWith,
comma,
noComma,
commaEmpty,
noCommaEmpty,
combineWith,
combineWithEmpty,
comma_,
and_,
commaAnd_,
)
where
import Data.Default.Class (Default (def))
import Data.Foldable (toList)
import Data.String (IsString (fromString))
comma_ ::
(IsString s) =>
s
comma_ :: forall s. IsString s => s
comma_ = String -> s
forall a. IsString a => String -> a
fromString String
", "
and_ ::
(IsString s) =>
s
and_ :: forall s. IsString s => s
and_ = String -> s
forall a. IsString a => String -> a
fromString String
" and "
commaAnd_ ::
(IsString s) =>
s
commaAnd_ :: forall s. IsString s => s
commaAnd_ = String -> s
forall a. IsString a => String -> a
fromString String
", and "
data CommaValues s
=
CommaValues
{
forall s. CommaValues s -> s
commaText :: s,
forall s. CommaValues s -> s
commaAndText :: s
}
deriving (CommaValues s -> CommaValues s -> Bool
(CommaValues s -> CommaValues s -> Bool)
-> (CommaValues s -> CommaValues s -> Bool) -> Eq (CommaValues s)
forall s. Eq s => CommaValues s -> CommaValues s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => CommaValues s -> CommaValues s -> Bool
== :: CommaValues s -> CommaValues s -> Bool
$c/= :: forall s. Eq s => CommaValues s -> CommaValues s -> Bool
/= :: CommaValues s -> CommaValues s -> Bool
Eq, Eq (CommaValues s)
Eq (CommaValues s) =>
(CommaValues s -> CommaValues s -> Ordering)
-> (CommaValues s -> CommaValues s -> Bool)
-> (CommaValues s -> CommaValues s -> Bool)
-> (CommaValues s -> CommaValues s -> Bool)
-> (CommaValues s -> CommaValues s -> Bool)
-> (CommaValues s -> CommaValues s -> CommaValues s)
-> (CommaValues s -> CommaValues s -> CommaValues s)
-> Ord (CommaValues s)
CommaValues s -> CommaValues s -> Bool
CommaValues s -> CommaValues s -> Ordering
CommaValues s -> CommaValues s -> CommaValues s
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
forall s. Ord s => Eq (CommaValues s)
forall s. Ord s => CommaValues s -> CommaValues s -> Bool
forall s. Ord s => CommaValues s -> CommaValues s -> Ordering
forall s. Ord s => CommaValues s -> CommaValues s -> CommaValues s
$ccompare :: forall s. Ord s => CommaValues s -> CommaValues s -> Ordering
compare :: CommaValues s -> CommaValues s -> Ordering
$c< :: forall s. Ord s => CommaValues s -> CommaValues s -> Bool
< :: CommaValues s -> CommaValues s -> Bool
$c<= :: forall s. Ord s => CommaValues s -> CommaValues s -> Bool
<= :: CommaValues s -> CommaValues s -> Bool
$c> :: forall s. Ord s => CommaValues s -> CommaValues s -> Bool
> :: CommaValues s -> CommaValues s -> Bool
$c>= :: forall s. Ord s => CommaValues s -> CommaValues s -> Bool
>= :: CommaValues s -> CommaValues s -> Bool
$cmax :: forall s. Ord s => CommaValues s -> CommaValues s -> CommaValues s
max :: CommaValues s -> CommaValues s -> CommaValues s
$cmin :: forall s. Ord s => CommaValues s -> CommaValues s -> CommaValues s
min :: CommaValues s -> CommaValues s -> CommaValues s
Ord, ReadPrec [CommaValues s]
ReadPrec (CommaValues s)
Int -> ReadS (CommaValues s)
ReadS [CommaValues s]
(Int -> ReadS (CommaValues s))
-> ReadS [CommaValues s]
-> ReadPrec (CommaValues s)
-> ReadPrec [CommaValues s]
-> Read (CommaValues s)
forall s. Read s => ReadPrec [CommaValues s]
forall s. Read s => ReadPrec (CommaValues s)
forall s. Read s => Int -> ReadS (CommaValues s)
forall s. Read s => ReadS [CommaValues s]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall s. Read s => Int -> ReadS (CommaValues s)
readsPrec :: Int -> ReadS (CommaValues s)
$creadList :: forall s. Read s => ReadS [CommaValues s]
readList :: ReadS [CommaValues s]
$creadPrec :: forall s. Read s => ReadPrec (CommaValues s)
readPrec :: ReadPrec (CommaValues s)
$creadListPrec :: forall s. Read s => ReadPrec [CommaValues s]
readListPrec :: ReadPrec [CommaValues s]
Read, Int -> CommaValues s -> ShowS
[CommaValues s] -> ShowS
CommaValues s -> String
(Int -> CommaValues s -> ShowS)
-> (CommaValues s -> String)
-> ([CommaValues s] -> ShowS)
-> Show (CommaValues s)
forall s. Show s => Int -> CommaValues s -> ShowS
forall s. Show s => [CommaValues s] -> ShowS
forall s. Show s => CommaValues s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> CommaValues s -> ShowS
showsPrec :: Int -> CommaValues s -> ShowS
$cshow :: forall s. Show s => CommaValues s -> String
show :: CommaValues s -> String
$cshowList :: forall s. Show s => [CommaValues s] -> ShowS
showList :: [CommaValues s] -> ShowS
Show)
instance (IsString s) => Default (CommaValues s) where
def :: CommaValues s
def = s -> s -> CommaValues s
forall s. s -> s -> CommaValues s
CommaValues s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
commaAnd_
toCommaValues ::
(IsString s) =>
CommaStyle ->
CommaValues s
toCommaValues :: forall s. IsString s => CommaStyle -> CommaValues s
toCommaValues CommaStyle
OxfordComma = s -> s -> CommaValues s
forall s. s -> s -> CommaValues s
CommaValues s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
commaAnd_
toCommaValues CommaStyle
NoComma = s -> s -> CommaValues s
forall s. s -> s -> CommaValues s
CommaValues s
forall s. IsString s => s
comma_ s
forall s. IsString s => s
and_
data CommaStyle
=
OxfordComma
|
NoComma
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
lastJoin ::
(IsString s) =>
CommaStyle ->
s
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_
combineWithEmpty ::
(Semigroup s, Foldable f) =>
s ->
s ->
s ->
f s ->
s
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
combineWith ::
(Monoid s, Foldable f) =>
s ->
s ->
f s ->
s
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
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_
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_
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_
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_
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
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
commaWith ::
(IsString s, Monoid s, Foldable f) =>
CommaValues s ->
f s ->
s
commaWith :: forall s (f :: * -> *).
(IsString s, Monoid s, Foldable f) =>
CommaValues s -> f s -> s
commaWith ~(CommaValues s
c s
ca) = s -> s -> f s -> s
forall s (f :: * -> *).
(Monoid s, Foldable f) =>
s -> s -> f s -> s
combineWith s
c s
ca
commaEmptyWith ::
(IsString s, Semigroup s, Foldable f) =>
s ->
CommaValues s ->
f s ->
s
commaEmptyWith :: forall s (f :: * -> *).
(IsString s, Semigroup s, Foldable f) =>
s -> CommaValues s -> f s -> s
commaEmptyWith s
e ~(CommaValues s
c s
ca) = s -> s -> s -> f s -> s
forall s (f :: * -> *).
(Semigroup s, Foldable f) =>
s -> s -> s -> f s -> s
combineWithEmpty s
e s
c s
ca