addLicenseInfo-0.0: Main.hs

module Main where

import Data.List (find, span, isPrefixOf, stripPrefix)
import Data.Maybe (fromJust)
import System.IO (hClose, hPutStr, hFileSize, hGetContents, IOMode(ReadMode, WriteMode), openFile)
import System.Environment (getArgs)
import System.Cmd (system)

data LicenseInfo = LI 	{ modName 	:: String
			, author	:: String
			, copyHold	:: String
			, licenseType 	:: String
			, maintainer	:: String
			, stability	:: String
			, portability	:: String
			, description	:: String}
	deriving (Eq, Show)


main = do
	ls <- getArgs
	let fp = head ls 
	let li = if null (tail ls) then "" else (head $ tail ls)
	fileHdl <- openFile fp ReadMode
	fileToModify <- hGetContents fileHdl
	licenseInfo <- if li == "" then getLicenseInfo 
		    		   else (readFile li) >>= parseLicenseInfoFile
	let licenseInfoWithModName = getModule fileToModify licenseInfo
	let formatInfo = format licenseInfoWithModName
	let formatted = (formatInfo ++ fileToModify)
	writeFile (fp++"tmp") formatted
	hClose fileHdl
	system ("mv " ++ fp ++ "tmp" ++ " " ++ fp) -- Because the Lazy Gods can't read and write
						   -- to the same goddamn file without getting
						   -- bitchy.
	
	
getModule :: String -> LicenseInfo -> LicenseInfo
getModule p (LI _ a c l ma s po d) = LI mod a c l ma s po d
	where 	mod = filter (/='\n') . getModname . maybeStringToString . findPrefix "module" $ (lines p)
		
	

getModname :: String -> String
getModname s = takeWhile (\x -> not $ elem x " (") $ drop (length "module ") s

findPrefix :: String -> [String] -> Maybe String
findPrefix _ [] = Nothing
findPrefix s (x:xs) | s `isPrefixOf` x = Just x
		    | otherwise	       = findPrefix s xs

	

maybeToString :: Show a => Maybe a -> String
maybeToString Nothing = ""
maybeToString (Just a) = show a

maybeStringToString :: Maybe String -> String
maybeStringToString Nothing = ""
maybeStringToString (Just s) = s

	
format :: LicenseInfo -> String
format li = (\x -> x ++ "\n") 
	  $ unlines 
	  $ map ("--"++) 
	  $	[ bar
		, bar
		, " |"
		, "Module       : " ++ modName li
		, "Author       : " ++ author li
		, "License      : " ++ licenseType li
		, "Copyright    : " ++ copyHold li
		, ""
		, "Maintainer   : " ++ maintainer li
		, "Stability    : " ++ stability li
		, "Portability  : " ++ portability li
		, ""
		, bar
		, "Description  : " ++ description li
		, bar
		, bar
		]
	where bar =  replicate 78 '-' 
	  

	
parseLicenseInfoFile :: String -> IO LicenseInfo
parseLicenseInfoFile s = do	
	let ls = lines s
	let ls_parsed = map parse ls
	let filt = flip filt' $ ls_parsed
	return $ LI (filt "Module") (filt "Author") (filt "Copyright") (filt "License") (filt "Maintainer") (filt "Stability") (filt "Portability") (filt "Description")
	where parse s = (\x -> (fst x, dropWhile (==' ') $ tail $ snd x)) 	
		      $ span (/=':') $ s
	      filt' ss l = maybeStringToString $ lookup ss l

getLicenseInfo :: IO LicenseInfo
getLicenseInfo = do 
	putStrLn "" 
	license <- grab "Choose a license type?"
	author  <- grab "Author?"
	copy    <- grab "Copyright holder?"
	mntnr   <- grab "Maintainer?"
	stblt   <- grab "Stability Level?"
	port    <- grab "Portability Level?"
	desc	<- grab "Description?"
	return $ LI "" author copy license mntnr stblt port desc


grab :: String -> IO String
grab s = do 
	putStrLn s
	get <- getLine
	return get