Hedi-0.1: Helper.hs

{-# LANGUAGE ParallelListComp #-}
-- | Parse and pretty print the string of help of commands 
module Helper where
import Control.Monad
import Text.ParserCombinators.Parsec.Prim
import Text.ParserCombinators.Parsec.Char
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Combinator
import Text.PrettyPrint (render,text,nest, (<>),(<+>),($$),sep)
import Data.List (transpose,find)


-- |structure for the help of a command
data CommandHelp = CommandHelp {
	name 		:: String, 	-- ^ the command name
	synopsis	:: String, 	-- ^ how to run it
	descriptions	:: [String],	-- ^ aspects
	errors		:: [String],	-- ^ errors explanations
	implementation	:: String	-- ^ implementation state
	}

instance Show CommandHelp where
	show (CommandHelp name synopsis descriptions errors implementation) = render $
		text ("Command: " ++ name ) $$ 
			nest 4 (
				text ("Synopsis: " ++ synopsis) $$
				(text ("Description: ") <> foldr1 ($$) (map text descriptions)) $$
				(text ("Errors: ") <> foldr1 ($$) (map text errors)) $$
				text ("Implementation: " ++ implementation)
				)
-- |parses a CommandHelp			
parseACommandHelp 	:: CharParser () CommandHelp 			
parseACommandHelp = do
	name <- field 0 "command"
	synopsis <- field 1 "synopsis"
	descriptions <- many (try $ field 1 "description")
	errors <- many (try $ field 1 "error")
	implementation <- field 1 "implementation"
	return $ CommandHelp name synopsis descriptions errors implementation
		where
	field n name = replicateM n tab >> string name >>  char ')' >> many space >> manyTill anyChar newline
	
-- |parses all commands help
parseCommandsHelp 	:: CharParser () [CommandHelp]
parseCommandsHelp = do
	rs <- many (try $ many emptyline >> parseACommandHelp) 
	manyTill  anyChar  eof
	return rs
		where
	emptyline = manyTill space newline

-- |run the parser against a string
run 
	:: String 			-- ^ The string to parse
	-> GenParser Char () a 		-- ^ the parser to use
	-> (a -> Maybe b)		-- ^ a function to use on the result , if it succed 
	-> Either String (Maybe b)	-- ^ the error showed if it fails or the result closed

run file p cl = either (Left . show) (Right . cl) (parse p "help parser" file)  

-- |create a nice table from lines of words
tabulate :: [[String]] -> String
tabulate = render . foldr1 ($$) . tabulate' . transpose where
	tabulate' (xs:[]) 	= map text xs
	tabulate' (xs:yss) 	= [text x $$ nest (maximum (map length xs) + 1) y| x <- xs | y <- tabulate' yss]

-- |parse a prettyprint of a list of command helps from a string
listOfCommands 	
	:: String 			-- ^ the string with the help inside
	-> Either String (Maybe String)	-- ^ a parse error or Just a prettyprint of a list of command helps
listOfCommands file = run file parseCommandsHelp (Just . tabulate . map (\c -> [synopsis c , name c]))

-- |parse a prettyprint of a list of command helps from a string
helpCommand
	:: String 			-- ^ the command name
	->  String 			-- ^ the string with the help inside
	-> Either String (Maybe String)	-- ^ a parse error or (Just the command help or Nothing if the command is missing)
helpCommand s file = run file parseCommandsHelp (\xs -> find  ((==s).name) xs >>= return . show)