{- | Module : $Header$ Description : Contains all definitions for creation comannd. Author : Nils 'bash0r' Jonsson Copyright : (c) 2015 Nils 'bash0r' Jonsson License : MIT Maintainer : aka.bash0r@gmail.com Stability : unstable Portability : non-portable (Portability is untested.) Contains all definitions for creation command. -} module Headergen.Commands.Creation ( command , help ) where import Control.Applicative import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy as BS import System.Directory import System.FilePath.Posix import System.IO import Headergen.Configuration import Headergen.Template import Headergen.Template.Parser import Headergen.Utility (requestForAllowance, parentDirectory) import Paths_headergen command :: [String] -> IO () command [lang, temp, mod] = case findMapping lang of Just mapping -> do cwd <- getCurrentDirectory hdg <- headergenDef cwd template lang temp >>= \t -> case t of Right temp -> do h <- openFile temp ReadMode c <- hGetContents h let templ = parseTemplate c dict = ("module.name", mod) : createDictionary hdg filled = fillTemplate dict templ case filled of Right text -> do m <- openFile (mod -<.> mapping) WriteMode hPutStrLn m text hClose m Left err -> do putStrLn err putStrLn "" hClose h Left err -> do putStrLn err putStrLn "" Nothing -> do putStrLn ("Language " ++ lang ++ " is unsupported.") putStrLn "" command _ = help help :: IO () help = do putStrLn " headergen create LANGUAGE TEMPLATE MODULE" putStrLn " --> creates a new module in current working directory." template :: String -> String -> IO (Either String FilePath) template lang temp = do template <- getDataFileName ("share" lang (temp -<.> ".template")) exists <- doesFileExist template if exists then (return . return) template else fail "Template does not exist." -- | Get the filetype extension of supported languages. findMapping lang = findMapping' lang fileMapping where findMapping' _ [] = Nothing findMapping' lang (x:xs) = let (l, f) = x in if l == lang then return f else findMapping' lang xs -- | A language / filetype mapping. fileMapping = [ ("haskell", "hs") ] -- | Try to get the .headergen.def. headergenDef cwd = do let file = cwd ".headergen.def" exists <- doesFileExist file if exists then do h <- openFile file ReadMode cs <- BS.hGetContents h let hgd = decode cs :: Maybe Configuration case hgd of Just a -> return a Nothing -> empty else case parentDirectory cwd of Just a -> headergenDef a Nothing -> empty