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)
data CommandHelp = CommandHelp {
name :: String,
synopsis :: String,
descriptions :: [String],
errors :: [String],
implementation :: String
}
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)
)
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
parseCommandsHelp :: CharParser () [CommandHelp]
parseCommandsHelp = do
rs <- many (try $ many emptyline >> parseACommandHelp)
manyTill anyChar eof
return rs
where
emptyline = manyTill space newline
run
:: String
-> GenParser Char () a
-> (a -> Maybe b)
-> Either String (Maybe b)
run file p cl = either (Left . show) (Right . cl) (parse p "help parser" file)
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]
listOfCommands
:: String
-> Either String (Maybe String)
listOfCommands file = run file parseCommandsHelp (Just . tabulate . map (\c -> [synopsis c , name c]))
helpCommand
:: String
-> String
-> Either String (Maybe String)
helpCommand s file = run file parseCommandsHelp (\xs -> find ((==s).name) xs >>= return . show)