diff --git a/headergen.cabal b/headergen.cabal --- a/headergen.cabal +++ b/headergen.cabal @@ -1,81 +1,39 @@ --- Initial headergen.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - --- The name of the package. -name: headergen - --- The package version. See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented. --- http://www.haskell.org/haskellwiki/Package_versioning_policy --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change -version: 0.1.0.0 - -homepage: https://github.com/aka-bash0r/headergen - --- A short (one-line) description of the package. -synopsis: Creates a header for a haskell source file. - --- A longer description of the package. -description: The headergen package provides a small utility for - creating documentation headers for source files. - --- The license under which the package is released. -license: MIT - --- The file containing the license text. -license-file: LICENSE - --- The package author(s). -author: Nils 'bash0r' Jonsson - --- An email address to which users can send suggestions, bug reports, and --- patches. -maintainer: aka.bash0r@gmail.com - --- A copyright notice. -copyright: (c) 2015 Nils bash0r Jonsson - -category: Development - -build-type: Simple - --- Extra files to be distributed with the package, such as examples or a --- README. --- extra-source-files: - --- Constraint on the version of Cabal needed to build this package. -cabal-version: >=1.10 +name: headergen +version: 0.1.1.0 +homepage: https://github.com/aka-bash0r/headergen +synopsis: Creates a header for a haskell source file. +description: The headergen package provides a small utility for + creating documentation headers for source files. +license: MIT +license-file: LICENSE +author: Nils 'bash0r' Jonsson +maintainer: aka.bash0r@gmail.com +copyright: (c) 2015 Nils 'bash0r' Jonsson +category: Development +build-type: Simple +data-dir: share +cabal-version: >=1.10 source-repository head - type: git - location: https://github.com/aka-bash0r/headergen + type: git + location: https://github.com/aka-bash0r/headergen +source-repository this + type: git + location: https://github.com/aka-bash0r/headergen + tag: 0.1.1.0 + executable headergen - -- .hs or .lhs file containing the Main module. - main-is: Main.hs - - -- Modules included in this executable, other than Main. - -- other-modules: - - -- LANGUAGE extensions used by modules in this package. - -- other-extensions: - - -- Other library packages from which modules are imported. - build-depends: base >=4.8 && <4.9 - , aeson >=0.9.0.1 && <0.10 - , aeson-pretty >=0.7.2 && <0.8 - , directory >=1.2.2 && <1.3 - , filepath >=1.4 && <1.5 - , time >=1.5.0.1 && <1.6 - , bytestring >=0.10.6 && <0.17 - , haskeline >=0.7.2.1 && <0.8 + main-is: Main.hs + build-depends: base >=4.8 && <4.9 + , aeson >=0.9.0.1 && <0.10 + , aeson-pretty >=0.7.2 && <0.8 + , directory >=1.2.2 && <1.3 + , filepath >=1.4 && <1.5 + , time >=1.5.0.1 && <1.6 + , bytestring >=0.10.6 && <0.17 + , haskeline >=0.7.2.1 && <0.8 + hs-source-dirs: src + default-language: Haskell2010 - -- Directories containing source files. - hs-source-dirs: src - - -- Base language which the package is written in. - default-language: Haskell2010 - diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,18 +1,16 @@ {- | Module : $Header$ -Description : The main module of the application. +Description : The entrypoint of the application. +Author : Nils 'bash0r' Jonsson Copyright : (c) 2015 Nils 'bash0r' Jonsson License : MIT Maintainer : aka.bash0r@gmail.com Stability : unstable -Portability : non-portable (Portability is not tested.) +Portability : non-portable (Portability is untested.) -The main module is the entry point of the application. +The entrypoint of the application. -} - -{-# LANGUAGE OverloadedStrings #-} - module Main ( main ) where @@ -20,230 +18,26 @@ import Control.Applicative import Control.Monad -import Data.Aeson -import Data.Aeson.Encode.Pretty -import qualified Data.ByteString.Lazy as BS -import Data.Time.Clock -import Data.Time.Calendar - -import System.FilePath.Posix -import System.Console.Haskeline -import System.Directory import System.Environment -import System.IO +import System.FilePath.Posix -date :: IO (Integer, Int, Int) -date = liftM (toGregorian . utctDay) getCurrentTime +import Headergen.Configuration +import Headergen.Messages +import Headergen.Template +import Headergen.Template.Parser --- | The configuration is used to read / write configuration to JSON. -data Configuration = Configuration - { getModule :: String - , getDescription :: String - , getAuthor :: String - , getCopyright :: String - , getLicense :: String - , getMaintainer :: String - , getStability :: String - , getPortability :: String - } +import qualified Headergen.Commands.Creation as Creation +import qualified Headergen.Commands.Help as Help +import qualified Headergen.Commands.Initialization as Initialization -defaultConfiguration = Configuration - { getModule = "$Header$" - , getDescription = "" - , getAuthor = "" - , getCopyright = "" - , getLicense = "" - , getMaintainer = "" - , getStability = "unstable" - , getPortability = "non-portable (Portability is untested.)" - } -instance ToJSON Configuration where - toJSON (Configuration mod desc auth copyr lic maint stab portab) = - object [ "module" .= mod - , "author" .= auth - , "description" .= desc - , "copyright" .= copyr - , "license" .= lic - , "maintainer" .= maint - , "stability" .= stab - , "portability" .= portab - ] - -instance FromJSON Configuration where - parseJSON (Object o) = - Configuration <$> o .: "module" - <*> o .: "description" - <*> o .: "author" - <*> o .: "copyright" - <*> o .: "license" - <*> o .: "maintainer" - <*> o .: "stability" - <*> o .: "portability" - parseJSON _ = - empty - --- | Try to get the parent directory of a given path. -parentDirectory :: FilePath -> Maybe FilePath -parentDirectory path = - let splitted = splitDirectories path - reversed = reverse splitted - dropped = drop 1 reversed - rereversed = reverse dropped - newPath = joinPath rereversed - in case newPath of - [] -> Nothing - otherwise -> Just otherwise - --- | Traverses the path up to root directory. -traversePath :: String -> FilePath -> IO () -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 -> printCorruptedMessage - hClose h - else case parentDirectory cwd of - Just a -> traversePath mod a - Nothing -> printExitMessage - --- | Print message about a corrupted .headergen.def. -printCorruptedMessage :: IO () -printCorruptedMessage = do - putStrLn "The .headergen.def is corrupted." - putStrLn "Exitting now." - putStrLn "" - --- | Print the exit message. -printExitMessage :: IO () -printExitMessage = do - putStrLn "There is no .headergen.def in any parent directory." - putStrLn "Exitting now." - putStrLn "" - -requestForAllowance :: IO Bool -requestForAllowance = runInputT defaultSettings allowanceRequest - where - allowanceRequest = do - line <- getInputLine "File for module exists already. Override? [y/n] " - case line of - (Just "y") -> return True - (Just "n") -> return False - _ -> allowanceRequest - --- | Create the header. -createHeader :: String -> Configuration -> IO () -createHeader mod conf = do - exists <- doesFileExist mod - if exists - then do - v <- requestForAllowance - if v - then printHeader mod conf - else printExit - else printHeader mod conf - -printExit :: IO () -printExit = do - putStrLn "No resources have been created." - putStrLn "Exiting now." - putStrLn "" - -printHeader :: String -> Configuration -> IO () -printHeader modFile (Configuration mod des aut cop lic mai sta por) = do - h <- openFile modFile WriteMode - hPutStrLn h "{- |" - hPutStrLn h ("Module : " ++ mod) - hPutStrLn h ("Description : " ++ des) - hPutStrLn h ("Author : " ++ aut) - hPutStrLn h ("Copyright : " ++ cop) - hPutStrLn h ("License : " ++ lic) - hPutStrLn h "" - hPutStrLn h ("Maintainer : " ++ mai) - hPutStrLn h ("Stability : " ++ sta) - hPutStrLn h ("Portability : " ++ por) - hPutStrLn h "" - hPutStrLn h "TODO: module description" - hPutStrLn h "-}" - hFlush h - hClose h - -def :: Maybe String -> String -> String -def v d = - case v of - Just v -> - if null v - then d - else v - Nothing -> - d - -alignText :: String -> String -alignText xs = - if length xs < 8 - then alignText (xs ++ " ") - else xs - -defaultText :: String -> String -defaultText crt = - if length crt >= 8 - then take 8 crt - else alignText crt - -requestConfiguration :: IO Configuration -requestConfiguration = do - (year, _, _) <- date - runInputT defaultSettings $ do - mod <- getInputLine "Module [$Header$]: " - desc <- getInputLine "Description [ ]: " - auth <- getInputLine "Author [ ]: " - let copyRightText = "(c) " ++ show year ++ " " ++ def auth "" - copyr <- getInputLine ("Copyright [" ++ defaultText copyRightText ++ "]: ") - lic <- getInputLine "License [MIT ]: " - maint <- getInputLine "Maintainer [ ]: " - stab <- getInputLine "Stability [unstable]: " - portab <- getInputLine "Portability [non-port]: " - 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.)") - -initializeDefinition :: IO () -initializeDefinition = do - conf <- requestConfiguration - file <- openFile ".headergen.def" WriteMode - BS.hPutStr file (encodePretty conf) - hFlush file - hClose file - -tryCreate :: String -> IO () -tryCreate mod = do - cwd <- getCurrentDirectory - traversePath mod cwd - -printHelpMessage :: IO () -printHelpMessage = do - putStrLn "Usage: [init|create MODULE]" - putStrLn "" - --- | The entry point of the application. main :: IO () main = do args <- getArgs handleParameters args where - handleParameters ["init"] = initializeDefinition - handleParameters ["create", mod] = tryCreate (mod -<.> ".hs") - handleParameters _ = printHelpMessage + handleParameters ("init" :xs) = Initialization.command xs + handleParameters ("create":xs) = Creation.command xs + handleParameters ("help" :xs) = Help.command xs + handleParameters _ = Help.command []