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 Data.Aeson
import qualified Data.ByteString.Lazy as BS

import System.Directory
import System.FilePath.Posix
import System.IO

import Headergen.Configuration
import Headergen.Messages
import Headergen.Utility (requestForAllowance, parentDirectory)


command :: [String] -> IO ()
command [mod] = tryCreate (mod -<.> ".hs")
command _     = undefined -- TODO: implement help message

help :: IO ()
help = do
  putStrLn "  headergen create MODULE"
  putStrLn "    --> creates a new module in current working directory."

-- | Try to create a new module file.
tryCreate mod = do
  cwd <- getCurrentDirectory
  traversePath mod cwd

-- | Traverses the path up to root directory.
traversePath mod cwd = do
  putStrLn ("Checking " ++ cwd ++ " ...")
  let headerGenDef = cwd </> ".headergen.def"
  exists <- doesFileExist headerGenDef
  if exists
     then do
       h  <- openFile headerGenDef ReadMode
       cs <- BS.hGetContents h
       let hgd = decode cs :: Maybe Configuration 
       case hgd of
         Just a  -> createHeader mod a
         Nothing -> putStrLn corruptedMessage
       hClose h 
     else case parentDirectory cwd of
       Just a  -> traversePath mod a
       Nothing -> putStrLn noHeadergenDefMessage

-- | Create the header.
createHeader mod conf = do
  exists <- doesFileExist mod
  if exists
     then do
       v <- requestForAllowance
       if v
          then writeHeader mod conf
          else putStrLn noResourcesCreatedMessage
     else writeHeader mod conf

-- | Write the header to file.
writeHeader modFile conf = do
  h <- openFile modFile WriteMode
  hPutStr h (template conf) 
  hFlush h
  hClose h