headergen 0.1.1.0 → 0.1.1.1
raw patch · 10 files changed
+617/−8 lines, 10 files
Files
- headergen.cabal +10/−2
- src/Headergen/Commands/Creation.hs +80/−0
- src/Headergen/Commands/Help.hs +51/−0
- src/Headergen/Commands/Initialization.hs +96/−0
- src/Headergen/Configuration.hs +78/−0
- src/Headergen/Messages.hs +111/−0
- src/Headergen/Template.hs +69/−0
- src/Headergen/Template/Parser.hs +46/−0
- src/Headergen/Utility.hs +76/−0
- src/Main.hs +0/−6
headergen.cabal view
@@ -1,5 +1,5 @@ name: headergen-version: 0.1.1.0+version: 0.1.1.1 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@@ -21,11 +21,19 @@ source-repository this type: git location: https://github.com/aka-bash0r/headergen- tag: 0.1.1.0+ tag: 0.1.1.1 executable headergen main-is: Main.hs+ other-modules: Headergen.Commands.Creation+ , Headergen.Commands.Help+ , Headergen.Commands.Initialization+ , Headergen.Configuration+ , Headergen.Messages+ , Headergen.Template.Parser+ , Headergen.Template+ , Headergen.Utility build-depends: base >=4.8 && <4.9 , aeson >=0.9.0.1 && <0.10 , aeson-pretty >=0.7.2 && <0.8
+ src/Headergen/Commands/Creation.hs view
@@ -0,0 +1,80 @@+{- |+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+
+ src/Headergen/Commands/Help.hs view
@@ -0,0 +1,51 @@+{- |+Module : $Header$+Description : Provides basic help functionality.+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.)++Provides basic help functionality for the headergen executable.+-}+module Headergen.Commands.Help+( command+, help+) where+++import Headergen.Messages++import qualified Headergen.Commands.Creation as Creation+import qualified Headergen.Commands.Initialization as Initialization+++command :: [String] -> IO ()+command ["all" ] = do+ command []+ Creation.help+ Initialization.help+ help+command ["init" ] = do+ command []+ Initialization.help+command ["create"] = do+ command []+ Creation.help+command ["help" ] = do+ command []+ help+command _ = do+ putStrLn "Usage: headergen {help [all|COMMAND]|init|create MODULE}"+ putStrLn ""++help :: IO ()+help = do+ putStrLn " headergen help"+ putStrLn " --> shows this help information"+ putStrLn " headergen help COMMAND"+ putStrLn " --> shows detailed help information"+
+ src/Headergen/Commands/Initialization.hs view
@@ -0,0 +1,96 @@+{- |+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+
+ src/Headergen/Configuration.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : $Header$+Description : +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.)++The 'Configuration' module contains all relevant information+-}+module Headergen.Configuration+( Configuration (..)+, createDictionary+) where+++import Control.Applicative+import Control.Monad++import Data.Aeson++import Headergen.Template+++-- | 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+ }++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++createDictionary :: Configuration -> Dictionary+createDictionary (Configuration mod des aut cop lic mai sta por) =+ [ ("module" , mod)+ , ("description", des)+ , ("author" , aut)+ , ("copyright" , cop)+ , ("license" , lic)+ , ("maintainer" , mai)+ , ("stability" , sta)+ , ("portability", por)+ ]+
+ src/Headergen/Messages.hs view
@@ -0,0 +1,111 @@+{- |+Module : $Header$+Description : Some message constants.+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.)++This module defines some messages +-}++module Headergen.Messages+( corruptedMessage+, noResourcesCreatedMessage+, noHeadergenDefMessage+, exitMessage++, moduleMessage+, descriptionMessage+, authorMessage+, copyRightMessage+, licenseMessage+, maintainerMessage+, stabilityMessage+, portabilityMessage++, template+) where+++import Headergen.Configuration+import Headergen.Utility+++-- | A message stating corruption of .headergen.def.+corruptedMessage :: String+corruptedMessage =+ "The .headergen.def is corrupted.\n" +++ exitMessage++-- | A message stating that no resources have been created.+noResourcesCreatedMessage :: String+noResourcesCreatedMessage =+ "No resources have been created.\n" +++ exitMessage++-- | A message stating that no .headergen.def was found.+noHeadergenDefMessage :: String+noHeadergenDefMessage =+ "There is no .headergen.def in any parent directory.\n" +++ exitMessage++-- | A message stating exit of application.+exitMessage :: String+exitMessage =+ "Exitting now.\n"+++-- | A message stating that input for module definition is required.+moduleMessage :: String+moduleMessage = "Module [$Header$]: "++-- | A message stating that input for description definition is required.+descriptionMessage :: String+descriptionMessage = "Description [ ]: "++-- | A message stating that input for author definition is required.+authorMessage :: String+authorMessage = "Author [ ]: "++-- | A message stating that input for copyright definition is required.+copyRightMessage :: String -> String+copyRightMessage crt = "Copyright [" ++ trimText 8 crt ++ "]: "++-- | A message stating that input for license definition is required.+licenseMessage :: String+licenseMessage = "License [MIT ]: "++-- | A message stating that input for maintainer definition is required.+maintainerMessage :: String+maintainerMessage = "Maintainer [ ]: "++-- | A message stating that input for stability definition is required.+stabilityMessage :: String+stabilityMessage = "Stability [unstable]: "++-- | A message stating that input for portability definition is required.+portabilityMessage :: String+portabilityMessage = "Portability [non-port]: "+++-- | A template function creating a new header from a configuration.+template :: Configuration -> String+template (Configuration mod des aut cop lic mai sta por) =+ "{- |\n" +++ "Module : " ++ mod ++ "\n" +++ "Description : " ++ des ++ "\n" +++ "Author : " ++ aut ++ "\n" +++ "Copyright : " ++ cop ++ "\n" +++ "License : " ++ lic ++ "\n" +++ "\n" +++ "Maintainer : " ++ mai ++ "\n" +++ "Stability : " ++ sta ++ "\n" +++ "Portability : " ++ por ++ "\n" +++ "\n" +++ "TODO: module description\n" +++ "-}\n\n"+
+ src/Headergen/Template.hs view
@@ -0,0 +1,69 @@+{- |+Module : $Header$+Description : Template language syntax tree.+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.)++This module contains the syntax tree for the templating language.+-}+module Headergen.Template+( KeyValue+, Dictionary++, VariableName+, Template (..)++, fillTemplate+) where+++import Control.Applicative+import Control.Monad+++-- | A key value pair.+type KeyValue = (String, String)+-- | A list of key value pairs.+type Dictionary = [KeyValue]++-- | The name of a variable in a template.+type VariableName = String+++-- | A template is used when +data Template+ -- | A simple text element in the template.+ = TemplateText String+ -- | A variable to substitute in later process in the template.+ | TemplateVariable VariableName+ -- | A sequence of several elements in the template.+ | TemplateSequence Template Template+ -- | The end of a template.+ | TemplateEOF+ deriving (Show, Eq)+++fillTemplate :: Dictionary -> Template -> Either String String+fillTemplate dict (TemplateEOF ) = Right ""+fillTemplate dict (TemplateVariable var ) = case dict `find` var of+ Just v -> Right v+ Nothing -> Left ("Variable " ++ var ++ " is not defined.")+fillTemplate dict (TemplateText text ) = Right text+fillTemplate dict (TemplateSequence left right) = do+ l <- fillTemplate dict left+ r <- fillTemplate dict right+ return (l ++ r) +++find ((key, value):xs) var =+ if key == var+ then Just value+ else find xs var+find [] _ =+ Nothing+
+ src/Headergen/Template/Parser.hs view
@@ -0,0 +1,46 @@+{- |+Module : $Header$+Description : A parser for the template language.+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.)++This package contains a simple parser for the templating language.+-}+module Headergen.Template.Parser+( parseTemplate+) where+++import Control.Applicative+import Control.Monad++import Headergen.Template+++-- | Parse a template definition.+parseTemplate :: String -> Template+parseTemplate xs = parse xs []+ where+ parse [] ys =+ if null ys+ then TemplateEOF+ else TemplateSequence (TemplateText (reverse ys)) TemplateEOF+ parse ('$':xs) ys =+ let (zs, res) = parseVariable xs []+ rest = parse zs []+ in TemplateSequence (TemplateText (reverse ys)) (TemplateSequence (TemplateVariable res) rest)+ parse (x :xs) ys =+ parse xs (x:ys)++ parseVariable [] ys = ([] , reverse ys)+ parseVariable (' ' :xs) ys = (' ' :xs, reverse ys)+ parseVariable ('\t':xs) ys = ('\t':xs, reverse ys)+ parseVariable ('\n':xs) ys = ('\n':xs, reverse ys)+ parseVariable ('\r':xs) ys = ('\r':xs, reverse ys)+ parseVariable (x :xs) ys = parseVariable xs (x:ys)+
+ src/Headergen/Utility.hs view
@@ -0,0 +1,76 @@+{- |+Module : $Header$+Description : Contains utility functions.+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.)++Some utility functions.+-}+module Headergen.Utility+( alignText+, trimText+, def+, requestForAllowance+, parentDirectory+) where+++import Data.List++import System.Console.Haskeline+import System.FilePath.Posix+++-- | Align message if it is less than n characters.+alignText :: (Num a) => Int -> String -> String+alignText n xs =+ if genericLength xs < n+ then alignText n (xs ++ " ")+ else xs++-- | Align text or cut text to be exact n characters.+trimText :: (Num a) => Int -> String -> String+trimText n crt =+ if genericLength crt >= n+ then take n crt+ else alignText n crt++-- | Try to get a value out of a Maybe String.+def :: Maybe String -> String -> String+def v d =+ case v of+ Just v ->+ if null v+ then d+ else v+ Nothing ->+ d++-- | Request the user for allowance to override a file.+requestForAllowance :: IO Bool+requestForAllowance = runInputT defaultSettings allowanceRequest+ where+ allowanceRequest = do+ line <- getInputLine "File exists already. Override? [y/n] "+ case line of+ (Just "y") -> return True+ (Just "n") -> return False+ _ -> allowanceRequest++-- | 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+
src/Main.hs view
@@ -19,12 +19,6 @@ import Control.Monad import System.Environment-import System.FilePath.Posix--import Headergen.Configuration-import Headergen.Messages-import Headergen.Template-import Headergen.Template.Parser import qualified Headergen.Commands.Creation as Creation import qualified Headergen.Commands.Help as Help