-- | A module to represent text with very basic formatting. Values are of
--   type ['Text'] and shown with 'showText'.
--
--   As an example of the formatting:
--
-- > [Line "Cooking for hungry people."
-- > ,Line "Welcome to my cookery recipe program, I sure hope you enjoy using it!"
-- > ,Line ""
-- > ,Cols ["Omlette","  A tasty eggy treat."]
-- > ,Cols ["  -m"," --mushrooms","  Some mushrooms, or in fact any other ingredients you have in the cupboards"]
-- > ,Cols ["  -e"," --eggs", "  But always you need eggs"]
-- > ,Line ""
-- > ,Cols ["Spagetti Bolognaise", "  An Italian delight."]
-- > ,Cols ["  -s"," --spagetti","  The first word in the name"]
-- > ,Cols ["  -b"," --bolognaise","  The second word in the name"]
-- > ,Cols ["  -d"," --dolmio","  The magic ingredient!"]
-- > ,Line ""
-- > ,Line "    The author of this program explicitly disclaims any liability for poisoning people who get their recipes off the internet."]
--
--   With @putStrLn ('showText' ('Wrap' 50) demo)@ gives:
--
-- > Cooking for hungry people.
-- > Welcome to my cookery recipe program, I sure hope
-- > you enjoy using it!
-- >
-- > Omlette              A tasty eggy treat.
-- >   -m --mushrooms   Some mushrooms, or in fact
-- >                    any other ingredients you have
-- >                    in the cupboards
-- >   -e --eggs        But always you need eggs
-- >
-- > Spagetti Bolognaise  An Italian delight.
-- >   -s --spagetti    The first word in the name
-- >   -b --bolognaise  The second word in the name
-- >   -d --dolmio      The magic ingredient!
-- >
-- >     The author of this program explicitly
-- >     disclaims any liability for poisoning people
-- >     who get their recipes off the internet.
module System.Console.CmdArgs.Text(TextFormat(..), defaultWrap, Text(..), showText) where

import Data.Char
import Data.Function
import Data.List
import Data.Maybe
import System.Console.CmdArgs.Default


-- | Wrap with the default width of 80 characters.
defaultWrap :: TextFormat
defaultWrap :: TextFormat
defaultWrap = Int -> TextFormat
Wrap Int
80

-- | How to output the text.
data TextFormat = HTML -- ^ Display as HTML.
                | Wrap Int -- ^ Display as text wrapped at a certain width (see 'defaultWrap').
                  deriving (ReadPrec [TextFormat]
ReadPrec TextFormat
Int -> ReadS TextFormat
ReadS [TextFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextFormat]
$creadListPrec :: ReadPrec [TextFormat]
readPrec :: ReadPrec TextFormat
$creadPrec :: ReadPrec TextFormat
readList :: ReadS [TextFormat]
$creadList :: ReadS [TextFormat]
readsPrec :: Int -> ReadS TextFormat
$creadsPrec :: Int -> ReadS TextFormat
Read,Int -> TextFormat -> ShowS
[TextFormat] -> ShowS
TextFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextFormat] -> ShowS
$cshowList :: [TextFormat] -> ShowS
show :: TextFormat -> String
$cshow :: TextFormat -> String
showsPrec :: Int -> TextFormat -> ShowS
$cshowsPrec :: Int -> TextFormat -> ShowS
Show,TextFormat -> TextFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextFormat -> TextFormat -> Bool
$c/= :: TextFormat -> TextFormat -> Bool
== :: TextFormat -> TextFormat -> Bool
$c== :: TextFormat -> TextFormat -> Bool
Eq,Eq TextFormat
TextFormat -> TextFormat -> Bool
TextFormat -> TextFormat -> Ordering
TextFormat -> TextFormat -> TextFormat
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
min :: TextFormat -> TextFormat -> TextFormat
$cmin :: TextFormat -> TextFormat -> TextFormat
max :: TextFormat -> TextFormat -> TextFormat
$cmax :: TextFormat -> TextFormat -> TextFormat
>= :: TextFormat -> TextFormat -> Bool
$c>= :: TextFormat -> TextFormat -> Bool
> :: TextFormat -> TextFormat -> Bool
$c> :: TextFormat -> TextFormat -> Bool
<= :: TextFormat -> TextFormat -> Bool
$c<= :: TextFormat -> TextFormat -> Bool
< :: TextFormat -> TextFormat -> Bool
$c< :: TextFormat -> TextFormat -> Bool
compare :: TextFormat -> TextFormat -> Ordering
$ccompare :: TextFormat -> TextFormat -> Ordering
Ord)

instance Default TextFormat where def :: TextFormat
def = TextFormat
defaultWrap

-- | The data type representing some text, typically used as @[Text]@. The formatting
--   is described by:
--
--   * 'Line' values represent a paragraph of text, and may be wrapped depending on the 'TextFormat'.
--     If a 'Line' value is wrapped then all leading space will be treated as an indent.
--
--   * 'Cols' values represent columns of text. Within any @[Text]@ all columns of the same length
--     are grouped in tabs, with the final column being wrapped if necessary. All columns are placed
--     adjacent with no space between them - for this reason most columns will start with a space.
data Text = Line String -- a single line
          | Cols [String] -- a single line with columns (always indented by 2 spaces)

instance Show Text where
    showList :: [Text] -> ShowS
showList = String -> ShowS
showString forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextFormat -> [Text] -> String
showText TextFormat
defaultWrap
    show :: Text -> String
show Text
x = TextFormat -> [Text] -> String
showText TextFormat
defaultWrap [Text
x]


-- | Show some text using the given formatting.
showText :: TextFormat -> [Text] -> String
showText :: TextFormat -> [Text] -> String
showText TextFormat
HTML = [Text] -> String
showHTML
showText (Wrap Int
x) = Int -> [Text] -> String
showWrap Int
x


---------------------------------------------------------------------
-- TEXT OUTPUT

showWrap :: Int -> [Text] -> String
showWrap :: Int -> [Text] -> String
showWrap Int
width [Text]
xs = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [String]
f [Text]
xs
    where
        cs :: [(Int,[Int])]
        cs :: [(Int, [Int])]
cs = forall a b. (a -> b) -> [a] -> [b]
map (\[(Int, [Int])]
x -> (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Int, [Int])]
x, forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, [Int])]
x)) forall a b. (a -> b) -> a -> b
$
                forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
                [(forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
x, forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [String]
x) | Cols [String]
x <- [Text]
xs]
        pad :: Int -> ShowS
pad Int
n String
x = String
x forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) Char
' '

        f :: Text -> [String]
f (Line String
x) = forall a b. (a -> b) -> [a] -> [b]
map (String
aforall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
wrap1 (Int
width forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) String
b
            where (String
a,String
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
x

        f (Cols [String]
xs) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ShowS
pad [Int]
ys [String]
xs forall a. [a] -> [a] -> [a]
++ [String
z1]) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
replicate Int
n Char
' 'forall a. [a] -> [a] -> [a]
++) [String]
zs
            where ys :: [Int]
ys = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) [(Int, [Int])]
cs
                  n :: Int
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [String]
xs)
                  String
z1:[String]
zs = Int -> String -> [String]
wrap1 (Int
width forall a. Num a => a -> a -> a
- Int
n) (forall a. [a] -> a
last [String]
xs)


wrap1 :: Int -> String -> [String]
wrap1 Int
width String
x = [String
"" | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
res] forall a. [a] -> [a] -> [a]
++ [String]
res
    where res :: [String]
res = Int -> String -> [String]
wrap Int
width String
x

-- | Split the text into strips of no-more than the given width
wrap :: Int -> String -> [String]
wrap :: Int -> String -> [String]
wrap Int
width = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(String, Int)] -> [String]
combine forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, Int)]
split) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    where
        split :: String -> [(String,Int)] -- string, amount of space after
        split :: String -> [(String, Int)]
split String
"" = []
        split String
x = (String
a,forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c) forall a. a -> [a] -> [a]
: String -> [(String, Int)]
split String
d
            where (String
a,String
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
x
                  (String
c,String
d) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
b

        -- combine two adjacent chunks while they are less than width
        combine :: [(String,Int)] -> [String]
        combine :: [(String, Int)] -> [String]
combine ((String
a,Int
b):(String
c,Int
d):[(String, Int)]
xs) | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a forall a. Num a => a -> a -> a
+ Int
b forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c forall a. Ord a => a -> a -> Bool
< Int
width = [(String, Int)] -> [String]
combine forall a b. (a -> b) -> a -> b
$ (String
a forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
b Char
' ' forall a. [a] -> [a] -> [a]
++ String
c,Int
d)forall a. a -> [a] -> [a]
:[(String, Int)]
xs
        combine ((String, Int)
x:[(String, Int)]
xs) = forall a b. (a, b) -> a
fst (String, Int)
x forall a. a -> [a] -> [a]
: [(String, Int)] -> [String]
combine [(String, Int)]
xs
        combine [] = []


---------------------------------------------------------------------
-- HTML OUTPUT

showHTML :: [Text] -> String
showHTML :: [Text] -> String
showHTML [Text]
xs = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
    [String
"<table class='cmdargs'>"] forall a. [a] -> [a] -> [a]
++
    forall a b. (a -> b) -> [a] -> [b]
map Text -> String
f [Text]
xs forall a. [a] -> [a] -> [a]
++
    [String
"</table>"]
    where
        maxCols :: Int
maxCols = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
x | Cols [String]
x <- [Text]
xs]

        f :: Text -> String
f (Line String
x) = ShowS
tr forall a b. (a -> b) -> a -> b
$ forall {a}. (Eq a, Num a, Show a) => a -> ShowS
td Int
maxCols String
x
        f (Cols [String]
xs) = ShowS
tr forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a}. (Eq a, Num a, Show a) => a -> ShowS
td Integer
1) (forall a. [a] -> [a]
init [String]
xs) forall a. [a] -> [a] -> [a]
++ forall {a}. (Eq a, Num a, Show a) => a -> ShowS
td (Int
maxCols forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) (forall a. [a] -> a
last [String]
xs)

        tr :: ShowS
tr String
x = String
"<tr>" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"</tr>"
        td :: a -> ShowS
td a
cols String
x = String
"<td" forall a. [a] -> [a] -> [a]
++ (if a
cols forall a. Eq a => a -> a -> Bool
== a
1 then String
"" else String
" colspan='" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
cols forall a. [a] -> [a] -> [a]
++ String
"'")
                          forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
styles then String
"" else String
" style='" forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
styles forall a. [a] -> [a] -> [a]
++ String
"'") forall a. [a] -> [a] -> [a]
++
                     String
">" forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b then String
"&nbsp;" else forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc String
b forall a. [a] -> [a] -> [a]
++ String
"</td>"
            where (String
a,String
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
x
                  -- if the first letter of the contents is '-', assume this is a flag
                  -- and be aware that HTML might try to line-break it, see #39
                  isFlag :: Bool
isFlag = forall a. Int -> [a] -> [a]
take Int
1 String
b forall a. Eq a => a -> a -> Bool
== String
"-"
                  styles :: [String]
styles = [ String
"padding-left:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) forall a. [a] -> [a] -> [a]
++ String
"ex;" | String
a forall a. Eq a => a -> a -> Bool
/= String
"" ]
                        forall a. [a] -> [a] -> [a]
++ [ String
"white-space:nowrap;" | Bool
isFlag ]

        esc :: Char -> String
esc Char
'&' = String
"&amp;"
        esc Char
'>' = String
"&gt;"
        esc Char
'<' = String
"&lt;"
        esc Char
'\n' = String
"<br />"
        esc Char
x = [Char
x]