-- | Defines types and functions to encode people, names, and naming convention.
-- Used for referencing and authorship of work.
module Language.Drasil.People (
    -- * Class
    HasName
    -- * Types
  , Person, People, Conv(..) --This is needed to unwrap names for the bibliography
    -- * Constructors
  , person, person', personWM, personWM', mononym
    -- * Accessors
  , name, nameStr
  , lstName
  , rendPersLFM, rendPersLFM', rendPersLFM''
  , comparePeople --For sorting references
  ) where

-- | A person can have a given name, middle name(s), and surname, as well
-- as the naming convention they use.
data Person = Person { Person -> String
_given :: String
                     , Person -> String
_surname :: String
                     , Person -> [String]
_middle :: [String]
                     , Person -> Conv
_convention :: Conv
                     } deriving (Person -> Person -> Bool
(Person -> Person -> Bool)
-> (Person -> Person -> Bool) -> Eq Person
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Person -> Person -> Bool
$c/= :: Person -> Person -> Bool
== :: Person -> Person -> Bool
$c== :: Person -> Person -> Bool
Eq)
-- | People is a synonymn for many 'Person's.
type People = [Person]

-- | Naming conventions.
data Conv = Western -- ^ Western style conventions are given name followed
                    -- by middle names, followed by surname.
          | Eastern -- ^ Eastern style conventions are surname followed by middle names, 
                    -- followed by given name.
          | Mono  -- ^ Mononyms are for those people who have only one name (ex. Madonna).
          deriving (Conv -> Conv -> Bool
(Conv -> Conv -> Bool) -> (Conv -> Conv -> Bool) -> Eq Conv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conv -> Conv -> Bool
$c/= :: Conv -> Conv -> Bool
== :: Conv -> Conv -> Bool
$c== :: Conv -> Conv -> Bool
Eq)

-- | Orderes different groups of 'Person's. If two lists are the same up to a point, the citation with more 'Person's will go last.
comparePeople :: [Person] -> [Person] -> Ordering
comparePeople :: [Person] -> [Person] -> Ordering
comparePeople [] [] = Ordering
EQ
comparePeople _  [] = Ordering
GT -- this makes sure that if the authors are the same 
comparePeople []  _ = Ordering
LT -- up to a point, the citation with more goes last
comparePeople (Person f1 :: String
f1 l1 :: String
l1 _ _:xs :: [Person]
xs) (Person f2 :: String
f2 l2 :: String
l2 _ _:ys :: [Person]
ys)
  | String
l1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
l2  = String
l1 String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
l2
  | String
f1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
f2  = String
f1 String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
f2
  | Bool
otherwise = [Person] -> [Person] -> Ordering
comparePeople [Person]
xs [Person]
ys

-- | Constructor for a person using Western naming conventions. 
-- Used for a person with only a given name and surname.
-- Arguments are in the order: given name, surname.
person :: String -> String -> Person
person :: String -> String -> Person
person f :: String
f l :: String
l = String -> String -> [String] -> Conv -> Person
Person String
f String
l [] Conv
Western

-- | Constructor for a person using Eastern naming conventions. 
-- Used for a person with only a given name and surname.
-- Arguments are in the order: surname, given name.
person' :: String -> String -> Person
person' :: String -> String -> Person
person' s :: String
s g :: String
g = String -> String -> [String] -> Conv -> Person
Person String
g String
s [] Conv
Eastern

-- | Constructor for a person using Western naming conventions.
-- Similar to the 'person' constructor,
-- except the middle argument is a list of middle names.
personWM :: String -> [String] -> String -> Person
personWM :: String -> [String] -> String -> Person
personWM f :: String
f ms :: [String]
ms l :: String
l = String -> String -> [String] -> Conv -> Person
Person String
f String
l [String]
ms Conv
Western

-- | Constructor for a person using Eastern naming conventions.
-- Similar to the 'person'' constructor,
-- except the middle argument is a list of middle names.
personWM' :: String -> [String] -> String -> Person
personWM' :: String -> [String] -> String -> Person
personWM' g :: String
g ms :: [String]
ms s :: String
s = String -> String -> [String] -> Conv -> Person
Person String
g String
s [String]
ms Conv
Eastern

-- | Constructor for a person with a mononym (only one name).
mononym :: String -> Person
mononym :: String -> Person
mononym n :: String
n = String -> String -> [String] -> Conv -> Person
Person "NFN" String
n [] Conv
Mono

-- | Members of this class must have a name.
class HasName p where
  -- | Provides the ability to hold a name.
  nameStr :: p -> String

-- | Gets the name of a 'Person'. Adds a dot after any initials.
instance HasName Person where
  nameStr :: Person -> String
nameStr (Person _ n :: String
n _ Mono) =  String -> String
dotInitial String
n
  nameStr (Person f :: String
f l :: String
l ms :: [String]
ms Western) = (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> String -> String
nameSep "" (
    [String -> String
dotInitial String
f] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
dotInitial [String]
ms [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String -> String
dotInitial String
l])
  nameStr (Person g :: String
g s :: String
s ms :: [String]
ms Eastern) = (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> String -> String
nameSep "" (
    [String -> String
dotInitial String
s] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
dotInitial [String]
ms [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String -> String
dotInitial String
g])

-- | Gets the name of a 'Person'. Adds a dot after any initials.
name :: (HasName n) => n -> String
name :: n -> String
name = n -> String
forall p. HasName p => p -> String
nameStr

-- | Gets the last name of a 'Person'.
lstName :: Person -> String
lstName :: Person -> String
lstName Person {_surname :: Person -> String
_surname = String
l} = String
l

-- | Gets a 'Person'\'s name in the form: Last, First Middle.
rendPersLFM :: Person -> String
rendPersLFM :: Person -> String
rendPersLFM Person {_surname :: Person -> String
_surname = String
n, _convention :: Person -> Conv
_convention = Conv
Mono} = String
n
rendPersLFM Person {_given :: Person -> String
_given = String
f, _surname :: Person -> String
_surname = String
l, _middle :: Person -> [String]
_middle = [String]
ms} =
  String -> String
dotInitial String
l String -> String -> String
`orderSep` String -> String
dotInitial String
f String -> String -> String
`nameSep`
  (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String -> String
nameSep (String -> String -> String)
-> (String -> String) -> String -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dotInitial) "" [String]
ms

-- | Gets a 'Person'\'s name in the form: Last, F. M.
rendPersLFM' :: Person -> String
rendPersLFM' :: Person -> String
rendPersLFM' Person {_surname :: Person -> String
_surname = String
n, _convention :: Person -> Conv
_convention = Conv
Mono} = String
n
rendPersLFM' Person {_given :: Person -> String
_given = String
f, _surname :: Person -> String
_surname = String
l, _middle :: Person -> [String]
_middle = [String]
ms} =
  String -> String
dotInitial String
l String -> String -> String
`orderSep` (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String -> String
nameSep (String -> String -> String)
-> (String -> String) -> String -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
initial) "" (String
fString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ms)

-- | Gets a 'Person'\'s name in the form: Last, First M.
rendPersLFM'' :: Person -> String
rendPersLFM'' :: Person -> String
rendPersLFM'' Person {_surname :: Person -> String
_surname = String
n, _convention :: Person -> Conv
_convention = Conv
Mono} = String
n
rendPersLFM'' Person {_given :: Person -> String
_given = String
f, _surname :: Person -> String
_surname = String
l, _middle :: Person -> [String]
_middle = [String]
ms} =
  String -> String
dotInitial String
l String -> String -> String
`orderSep` (String -> String -> String) -> [String] -> String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 String -> String -> String
nameSep (String -> String
dotInitial String
f String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
initial [String]
ms)

-- | Finds an initial and appends a period after it.
initial :: String -> String
initial :: String -> String
initial []    = [] -- is this right?
initial (x :: Char
x:_) = [Char
x , '.']

-- | Adds a . after a name which is an initial, aka a single letter.
dotInitial :: String -> String
dotInitial :: String -> String
dotInitial [x :: Char
x] = [Char
x,'.']
dotInitial nm :: String
nm  = String
nm

-- | Helper that joins two strings (second and third arguments) together with another string (first argument).
joiner :: String -> String -> String -> String
joiner :: String -> String -> String -> String
joiner _ a :: String
a "" = String
a
joiner _ "" b :: String
b = String
b
joiner j :: String
j a :: String
a b :: String
b = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b

-- | Joins strings with a comma in between.
orderSep :: String -> String -> String
orderSep :: String -> String -> String
orderSep = String -> String -> String -> String
joiner ", "

-- | Joins strings with a space in between.
nameSep :: String -> String -> String
nameSep :: String -> String -> String
nameSep = String -> String -> String -> String
joiner " "