{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Exports functions to facilitate unification of the style of output text.
-}

module BishBosh.Text.ShowList(
-- * Functions
	showsAssociation,
	showsSeparator,
	showsDelimitedList,
	showsUnterminatedList,
	showsFormattedList,
	showsFormattedList',
	showsAssociationList,
	showsAssociationList',
	splitOn
) where

import qualified	Data.List

-- | Used to separate an identifier & the it's value.
showsAssociation :: ShowS
showsAssociation :: ShowS
showsAssociation	= String -> ShowS
showString String
" = "

-- | Used to separate the items of a list.
showsSeparator :: ShowS
showsSeparator :: ShowS
showsSeparator	= String -> ShowS
showString String
", "

-- | Shows a list with the specified delimiters.
showsDelimitedList
	:: ShowS	-- ^ The list-separator.
	-> ShowS	-- ^ Left delimiter.
	-> ShowS	-- ^ Right delimiter.
	-> [ShowS]
	-> ShowS
showsDelimitedList :: ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
showsDelimitedList ShowS
separator ShowS
lDelimiter ShowS
rDelimiter	= (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
rDelimiter ([ShowS] -> ShowS) -> ([ShowS] -> [ShowS]) -> [ShowS] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS
lDelimiter ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
:) ([ShowS] -> [ShowS]) -> ([ShowS] -> [ShowS]) -> [ShowS] -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
Data.List.intersperse ShowS
separator

-- | Shows a list without terminal delimiters.
showsUnterminatedList :: [ShowS] -> ShowS
showsUnterminatedList :: [ShowS] -> ShowS
showsUnterminatedList	= ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
showsDelimitedList ShowS
showsSeparator ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id

-- | Formats & shows a list with standard terminal delimiters.
showsFormattedList
	:: ShowS	-- ^ The list-separator.
	-> (a -> ShowS)	-- ^ Format the list-elements.
	-> [a]		-- ^ An arbitrary list of items.
	-> ShowS
showsFormattedList :: ShowS -> (a -> ShowS) -> [a] -> ShowS
showsFormattedList ShowS
separator a -> ShowS
f	= ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
showsDelimitedList ShowS
separator (Char -> ShowS
showChar Char
'[') (Char -> ShowS
showChar Char
']') ([ShowS] -> ShowS) -> ([a] -> [ShowS]) -> [a] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ShowS) -> [a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map a -> ShowS
f

-- | Formats & shows a list with standard delimiters.
showsFormattedList'
	:: (a -> ShowS)	-- ^ Format the list-elements.
	-> [a]		-- ^ An arbitrary list of items.
	-> ShowS
showsFormattedList' :: (a -> ShowS) -> [a] -> ShowS
showsFormattedList'	= ShowS -> (a -> ShowS) -> [a] -> ShowS
forall a. ShowS -> (a -> ShowS) -> [a] -> ShowS
showsFormattedList ShowS
showsSeparator

-- | Shows an association-list with standard terminal delimiters.
showsAssociationList
	:: ShowS	-- ^ The list-separator.
	-> [(String, ShowS)]
	-> ShowS
showsAssociationList :: ShowS -> [(String, ShowS)] -> ShowS
showsAssociationList ShowS
separator	= ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
showsDelimitedList ShowS
separator (Char -> ShowS
showChar Char
'{') (Char -> ShowS
showChar Char
'}') ([ShowS] -> ShowS)
-> ([(String, ShowS)] -> [ShowS]) -> [(String, ShowS)] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, ShowS) -> ShowS) -> [(String, ShowS)] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (
	\(String
k, ShowS
v) -> String -> ShowS
showString String
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
v
 )

-- | Shows an association-list with standard delimiters.
showsAssociationList' :: [(String, ShowS)] -> ShowS
showsAssociationList' :: [(String, ShowS)] -> ShowS
showsAssociationList'	= ShowS -> [(String, ShowS)] -> ShowS
showsAssociationList ShowS
showsSeparator

{- |
	Split the specified list, using the predicate to identify the separator.

	CAVEAT: the separator isn't included in the results.
-}
splitOn :: (a -> Bool) -> [a] -> [[a]]
splitOn :: (a -> Bool) -> [a] -> [[a]]
splitOn a -> Bool
_ []		= []
splitOn a -> Bool
predicate [a]
l	= case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
predicate [a]
l of
	([a]
chunk, a
_ : [a]
l')	-> [a]
chunk [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitOn a -> Bool
predicate [a]
l'	-- Recurse.
	([a]
chunk, [])	-> [[a]
chunk]