headergen (empty) → 0.1.0.0
raw patch · 4 files changed
+352/−0 lines, 4 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, directory, filepath, haskeline, time
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- headergen.cabal +81/−0
- src/Main.hs +249/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Nils 'bash0r' Jonsson++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ headergen.cabal view
@@ -0,0 +1,81 @@+-- 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++source-repository head+ type: git+ location: https://github.com/aka-bash0r/headergen+++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++ -- Directories containing source files.+ hs-source-dirs: src+ + -- Base language which the package is written in.+ default-language: Haskell2010+
+ src/Main.hs view
@@ -0,0 +1,249 @@+{- |+Module : $Header$+Description : The main module of the application.+Copyright : (c) 2015 Nils 'bash0r' Jonsson+License : MIT++Maintainer : aka.bash0r@gmail.com+Stability : unstable+Portability : non-portable (Portability is not tested.)++The main module is the entry point of the application.+-}++{-# LANGUAGE OverloadedStrings #-}++module Main+( main+) where++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++date :: IO (Integer, Int, Int)+date = liftM (toGregorian . utctDay) getCurrentTime++-- | 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+ }++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+