module HaskellSay where
haskellSay :: String -> IO ()
haskellSay str = mapM_ putStrLn $ headerLines ++ content ++ haskellLogoSay
where
headerLines = [
" " ++ replicate 56 '_',
" /" ++ replicate 56 ' ' ++ "\\"
]
content = map padLine (wrapLine 56 str)
padLine :: String -> String
padLine content = ("| " ++) content ++ rightPadding ++ "|"
where
rightPadding = replicate paddingWidth ' '
paddingWidth = 60 - 2 - length content - 1
haskellLogoSay :: [String]
haskellLogoSay = [
" \\____ _____________________________________________/",
" \\ /",
" \\ /",
" \\/",
" _____ _____",
" \\ \\ \\ \\",
" \\ \\ \\ \\",
" \\ \\ \\ \\",
" \\ \\ \\ \\ \\-----------|",
" \\ \\ \\ \\ \\ |",
" \\ \\ \\ \\ \\---------|",
" / / / \\",
" / / / \\ \\-------|",
" / / / ^ \\ \\ |",
" / / / / \\ \\ \\ ----|",
" / / / / \\ \\",
" /____/ /____/ \\____\\"
]
wrapLine :: Int -> String -> [String]
wrapLine width str = go (words str) 0 [] []
where
go :: [String] -> Int -> [String] -> [String] -> [String]
go [] _ currentLine wrappedLines = wrappedLines ++ [unwords currentLine]
go (w:ws) n currentLine wrappedLines
| n + (length w) + length currentLine > width =
go (w:ws) 0 [] (wrappedLines ++ [unwords currentLine])
| otherwise =
go ws (n + length w) (currentLine ++ [w]) wrappedLines