{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Output.Plain -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- The plain ascii output formatter for CSL -- ----------------------------------------------------------------------------- module Text.CSL.Output.Plain ( renderPlain , renderPlainStrict , procList , (<+>) , (<>) ) where import Data.Char import Data.List import Text.CSL.Style -- | Render the 'FormattedOutput' into a plain text string. renderPlain :: [FormattedOutput] -> String renderPlain = concatMap $ render False -- | Same as 'renderPlain' , but will not clean up the produced -- output. renderPlainStrict :: [FormattedOutput] -> String renderPlainStrict = concatMap $ render True render :: Bool -> FormattedOutput -> String render _ (Delimiter s) = s render b (FO str fm xs) = prefix fm <++> format (trim str <++> rest) <++> suffix fm where rest = procList xs $ concatM (render b) trim = if b then id else unwords . words (<++>) = if b then (++) else (<>) concatM f = foldr (<++>) [] . map f quote s = if s /= [] && quotes fm then "\"" ++ s ++ "\"" else s capital s = toUpper (head s) : (tail s) format s = quote . text_case $ s text_case s | "capitalize-first" <- textCase fm = procList s capital | "capitalize-all" <- textCase fm = procList s $ unwords . map capital . words | "lowercase" <- textCase fm = map toLower s | "uppercase" <- textCase fm = map toUpper s | otherwise = s procList :: Eq a => [a] -> ([a] -> [b]) -> [b] procList s f = if s /= [] then f s else [] (<+>) :: String -> String -> String [] <+> ss = ss s <+> [] = s s <+> ss = s ++ " " ++ ss (<>) :: String -> String -> String sa <> sb | sa /= [], (s:xs) <- sb , last sa == s , s `elem` ";:,. " = sa ++ xs | otherwise = sa ++ sb