Creation.hs

{- |
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