Initialization.hs

{- |
Module      :  $Header$
Description :  Contains all relevant definitions for the initialization command.
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 relevant definitions for the initialization command.
-}
module Headergen.Commands.Initialization
( command
, help
) where

import Control.Applicative
import Control.Monad

import Data.Aeson ()
import Data.Aeson.Encode.Pretty
import Data.Time.Calendar
import Data.Time.Clock

import qualified Data.ByteString.Lazy as BS

import System.Console.Haskeline
import System.Directory
import System.IO

import Headergen.Configuration
import Headergen.Messages
import Headergen.Utility


command :: [String] -> IO ()
command [] = initializeDefinition
command _  = undefined -- TODO: implement printing of help message.


help :: IO ()
help = do
  putStrLn "  headergen init"
  putStrLn "    --> initializes a new .headergen.def."

-- | Initialize a .headergen.def.
initializeDefinition = do
  exists <- doesFileExist ".headergen.def"
  if exists
     then do
       allowance <- requestForAllowance
       if allowance
          then do
            hgd <- requestConfiguration
            createHeadergenDef hgd
          else
            putStrLn noResourcesCreatedMessage
     else do
       hgd <- requestConfiguration
       createHeadergenDef hgd

-- | Request the configuration from console.
requestConfiguration = do
  (year, _, _) <- date
  runInputT defaultSettings $ do
    mod    <- getInputLine moduleMessage 
    desc   <- getInputLine descriptionMessage 
    auth   <- getInputLine authorMessage
    let copyRightText    = "(c) " ++ show year ++ " " ++ def auth ""
        copyRight        = copyRightMessage copyRightText
    copyr  <- getInputLine copyRight
    lic    <- getInputLine licenseMessage
    maint  <- getInputLine maintainerMessage
    stab   <- getInputLine stabilityMessage
    portab <- getInputLine portabilityMessage
    return ( Configuration (def mod    "$Header$"                               )
                           (def desc   ""                                       )
                           (def auth   ""                                       )
                           (def copyr  copyRightText                            )
                           (def lic    "MIT"                                    )
                           (def maint  ""                                       )
                           (def stab   "unstable"                               )
                           (def portab "non-portable (Portability is untested.)") )

-- | Create a .headergen.def in the current directory.
createHeadergenDef conf = do
  file <- openFile ".headergen.def" WriteMode
  BS.hPutStr file (encodePretty conf)
  hFlush file
  hClose file

-- | Current date.
date = liftM (toGregorian . utctDay) getCurrentTime