headergen 0.1.0.0 → 0.1.1.0
raw patch · 2 files changed
+49/−297 lines, 2 files
Files
- headergen.cabal +33/−75
- src/Main.hs +16/−222
headergen.cabal view
@@ -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-
src/Main.hs view
@@ -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 []