newt (empty) → 0.0.1.0
raw patch · 23 files changed
+948/−0 lines, 23 filesdep +HUnitdep +QuickCheckdep +Unixutilssetup-changed
Dependencies added: HUnit, QuickCheck, Unixutils, array, base, cmdargs, containers, directory, filemanip, filepath, mtl, newt, process, regex-base, regex-pcre, test-framework, test-framework-hunit, test-framework-quickcheck2, uuid
Files
- LICENSE +28/−0
- Setup.hs +2/−0
- appsrc/Main.hs +126/−0
- newt.cabal +121/−0
- src/Newt/Inputs.hs +22/−0
- src/Newt/Newt.hs +203/−0
- src/Newt/Outputs.hs +44/−0
- src/Newt/Utilities.hs +30/−0
- tests/src/Integration.hs +119/−0
- tests/src/Main.hs +14/−0
- tests/src/ReplaceTests.hs +91/−0
- tests/testFiles/dirTemplates/cabalProject/<<<projName>>>.cabal +43/−0
- tests/testFiles/dirTemplates/cabalProject/LICENSE +29/−0
- tests/testFiles/dirTemplates/cabalProject/Setup.hs +2/−0
- tests/testFiles/dirTemplates/cabalProject/appsrc/Main.hs +4/−0
- tests/testFiles/dirTemplates/cabalProject/src/<<<projName>>>.hs +0/−0
- tests/testFiles/dirTemplates/cabalProject/tests/src/Main.hs +4/−0
- tests/testFiles/dirTemplates/template2/<<<projName>>>/in.cabal +15/−0
- tests/testFiles/simpleTest/alternate1.txt +5/−0
- tests/testFiles/simpleTest/in.cabal +15/−0
- tests/testFiles/simpleTest/in.cabal.oracle.1 +15/−0
- tests/testFiles/simpleTest/in.cabal.oracle.2 +15/−0
- tests/testFiles/simpleTest/simple1.txt +1/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2011, Eugene Rogan Creswick+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++Neither the name of Eugene Rogan Creswick nor the names of his+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ appsrc/Main.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Main where++import Control.Monad.Error (runErrorT, liftIO)+import Data.List ( elemIndex )+import Data.Maybe ( mapMaybe, fromMaybe )+import Data.Version ( showVersion )+import qualified Data.Set as Set++import System.Console.CmdArgs.Implicit+import System.Environment ( getArgs, withArgs )+import System.Exit ( exitWith, ExitCode(..) )+import System.IO ( hGetContents, stdin )++import Paths_newt ( version )++import Newt.Newt+import Newt.Inputs+import qualified Newt.Inputs as In+import Newt.Outputs+import qualified Newt.Outputs as Out++data Config = Config { source :: Maybe FilePath+ , dest :: Maybe FilePath+ , rawTable :: [String]+ , list :: Bool+ , inplace :: Bool+ , prefix :: Maybe String+ , suffix :: Maybe String+ } deriving (Show, Data, Typeable)++config :: Config+config = Config { source = def &= name "s"+ &= help ("Template source location. Default is to"+++ " read from stdin.")+ , dest = def+ &= help ("Destination location. Default is to"+++ " write to stdout, but not all inputs"+++ "can be written to stdout.")+ , rawTable = def &= args -- the raw key=value pairs+ , list = def+ &= help ("List the set of keys in the input"+++ " template. This is mutually exclusive"+++ " with output to stdout.")+ , inplace = def+ &= help ("Populate the source template in-place,"+++ " making destructive changes. This is"+++ " mutually exclusive with output to stdout."+++ " inplace is not yet supported with directory "+++ " template sources.")+ , prefix = def+ &= help "Specify a custom prefix for the tagged keys"+ &= groupname customTags &= explicit &= name "prefix"+ &= typ "\"<<<\""+ , suffix = def+ &= help "Specify a custom suffix for the tagged keys"+ &= groupname customTags &= explicit &= name "suffix"+ &= typ "\">>>\""+ } &= summary versionString &= details detailsHeader &= program "newt"++customTags :: String+customTags = "\nCustomizing tag syntax"++versionString :: String+versionString = "newt " ++ showVersion version++detailsHeader :: [String]+detailsHeader = [ "For example:"+ , ""+ , " Transform in.cabal according to a set of key=value assignments:"+ , " $ newt --source=in.cabal --dest=FooApp.cabal name=FooApp "+++ "author=\"Your Name\""+ , ""+ , " List the tagged keys in in.cabal:"+ , " $ newt --source=in.cabal --list"+ , ""+ , " List the tagged keys in in.cabal, using cat and stdin:"+ , " $ cat in.cabal | newt --list"+ ]+main :: IO ()+main = do conf <- do args <- getArgs+ -- if no arguments were specified, print help and exit:+ case args of+ [] -> withArgs ["--help"] $ cmdArgs config+ _ -> cmdArgs config++ simpleTag <- mkSimpleTag $ tagBrackets conf+ let table = mapMaybe strToPair $ rawTable conf+ replace = replaceTable table+ replacement input output = replaceFile simpleTag replace input output++ res <- runErrorT $ do+ inSpec <- inputSpec $ source conf+ if (list conf)+ then liftIO $ printTags simpleTag inSpec+ else do outSpec <- outputSpec (inplace conf) inSpec $ dest conf+ liftIO $ replacement inSpec outSpec+ case res of+ Left err -> do putStrLn err+ exitWith (ExitFailure 1)+ Right _ -> return ()++tagBrackets :: Config -> (String, String)+tagBrackets conf = ( fromMaybe defaultPrefix $ prefix conf,+ fromMaybe defaultSuffix $ prefix conf)++printTags :: Tag a => a -> InputSpec -> IO ()+printTags tag StandardIn = do content <- hGetContents stdin+ mapM_ putStrLn $ Set.toList $ getTags tag content+printTags tag (In.TxtFile file) = do tagSet <- getTagsFile tag file+ mapM_ putStrLn $ Set.toList tagSet+printTags tag (In.Directory pth) = do tagSet <- getTagsDirectory tag pth+ mapM_ putStrLn $ Set.toList tagSet+printTags _ fmt = putStrLn ("Unsupported input format: " ++ show fmt)+++printHelp :: IO ()+printHelp = putStrLn "Usage: newt <inFile> [<outFile> [key=value]]"++isPair :: String -> Bool+isPair str = '=' `elem` str++strToPair :: String -> Maybe (String, String)+strToPair str = do idx <- elemIndex '=' str+ let (key, rawValue) = splitAt idx str+ return (key, tail rawValue)
+ newt.cabal view
@@ -0,0 +1,121 @@+name: newt+version: 0.0.1.0+synopsis: A trivially simple app to create things from simple templates.+description: Instantiates text things from templates.+category: Tools+license: BSD3+License-file: LICENSE+author: Rogan Creswick+maintainer: creswick@gmail.com+Cabal-Version: >=1.8.0.6+build-type: Simple++Extra-source-files:+ tests/src/Integration.hs+ tests/src/Main.hs+ tests/src/ReplaceTests.hs+ tests/testFiles/dirTemplates/cabalProject/<<<projName>>>.cabal+ tests/testFiles/dirTemplates/cabalProject/LICENSE+ tests/testFiles/dirTemplates/cabalProject/Setup.hs+ tests/testFiles/dirTemplates/cabalProject/appsrc/Main.hs+ tests/testFiles/dirTemplates/cabalProject/src/<<<projName>>>.hs+ tests/testFiles/dirTemplates/cabalProject/tests/src/Main.hs+ tests/testFiles/dirTemplates/template2/<<<projName>>>/in.cabal+ tests/testFiles/simpleTest/alternate1.txt+ tests/testFiles/simpleTest/in.cabal+ tests/testFiles/simpleTest/in.cabal.oracle.1+ tests/testFiles/simpleTest/in.cabal.oracle.2+ tests/testFiles/simpleTest/simple1.txt++Flag tests+ Description: Build the tests+ Default: False+++Library+ hs-source-dirs: src+ Exposed-modules: Newt.Newt,+ Newt.Inputs,+ Newt.Outputs,+ Newt.Utilities++ Build-depends: base >= 4 && < 6,+ filemanip >= 0.3.5.2 && < 0.3.6,+ mtl >= 2.0.1.0 && < 2.0.2,+ regex-base >= 0.93.2 && < 0.94,+ regex-pcre >= 0.94.2 && < 0.95,+ array >= 0.3.0.0 && < 0.4.1,+ Unixutils >= 1.36 && < 1.37+ if impl(ghc < 7)+ Build-depends:+ containers >= 0.3.0.0 && < 0.5,+ directory >= 1.0.1.1 && < 1.1.1,+ process >= 1.0.1.3 && < 1.0.2,+ filepath >= 1.1.0.0 && < 1.1.0.5+ else+ Build-depends:+ containers >= 0.4.0.0 && < 0.5,+ directory >= 1.1.0.0 && < 1.1.1,+ process >= 1.0.1.5 && < 1.0.2,+ filepath >= 1.2.0.0 && < 1.2.1++ ghc-options: -Wall+++Executable newt+ Main-Is: Main.hs+ hs-source-dirs: appsrc++ Build-depends: newt,+ base >= 4 && < 6,+ mtl >= 2.0.1.0 && < 2.0.2,+ cmdargs >= 0.6.9 && < 0.6.10++ if impl(ghc < 7)+ Build-depends:+ containers >= 0.3.0.0 && < 0.5+ else+ Build-depends:+ containers >= 0.4.0.0 && < 0.5+++ ghc-options: -Wall++Executable test-newt+ if !flag(tests)+ Buildable: False++ Main-is: Main.hs++ Hs-Source-Dirs: tests/src++ Build-depends: newt,+ base >= 4 && < 6,+ HUnit >= 1.2.2 && < 1.2.3,+ test-framework >= 0.3.3 && < 0.4,+ test-framework-quickcheck2 >= 0.2.9 && < 0.3,+ test-framework-hunit >= 0.2.6 && < 0.3,+ QuickCheck >= 2.4.1.1 && < 2.4.2,+ uuid >= 1.2.2 && < 1.2.3++ if impl(ghc < 7)+ Build-depends:+ containers >= 0.3.0.0 && < 0.5,+ directory >= 1.0.1.1 && < 1.1.1,+ process >= 1.0.1.3 && < 1.0.2,+ filepath >= 1.1.0.0 && < 1.1.0.5+ else+ Build-depends:+ containers >= 0.4.0.0 && < 0.5,+ directory >= 1.1.0.0 && < 1.1.1,+ process >= 1.0.1.5 && < 1.0.2,+ filepath >= 1.2.0.0 && < 1.2.1++ Other-modules: Integration,+ ReplaceTests++ GHC-Options: -Wall++source-repository head+ type: git+ location: git://github.com/creswick/Newt.git
+ src/Newt/Inputs.hs view
@@ -0,0 +1,22 @@+module Newt.Inputs where++import System.Directory ( doesDirectoryExist, doesFileExist )++import Control.Monad.Error ( ErrorT, throwError, liftIO )++data InputSpec = StandardIn+ | TxtFile FilePath+ | Directory FilePath+ -- | TarGz FilePath+ -- | Zip FilePath+ deriving (Show)++inputSpec :: Maybe FilePath -> ErrorT String IO InputSpec+inputSpec Nothing = return StandardIn+inputSpec (Just pth) = do dirExists <- liftIO $ doesDirectoryExist pth+ fileExists <- liftIO $ doesFileExist pth+ case dirExists of+ True -> return (Directory pth)+ False -> case fileExists of+ True -> return (TxtFile pth)+ False -> throwError (pth++" Does not exist!")
+ src/Newt/Newt.hs view
@@ -0,0 +1,203 @@+module Newt.Newt where++import Control.Exception.Base ( IOException )+import Control.Monad ( zipWithM )+import Control.Monad.Error ( ErrorT, runErrorT, liftIO )+import Data.Array ( elems )+import Data.Foldable ( foldrM )+import Data.Set ( Set )+import qualified Data.Set as Set+import Data.Maybe ( fromMaybe )++import Text.Regex.PCRE ( Regex )+import Text.Regex.PCRE.String ( compile, compUngreedy, execBlank,+ MatchOffset )+import Text.Regex.Base.RegexLike ( matchAllText )+import System.Directory ( doesDirectoryExist, getDirectoryContents+ , createDirectoryIfMissing )+import System.Exit ( exitWith, ExitCode(..) )+import System.FilePath ( (</>) )+import System.FilePath.Find ( findWithHandler, always )+import System.FilePath.Posix ( makeRelative )+import System.IO ( hGetContents, stdin )++++import Newt.Inputs+import qualified Newt.Inputs as In+import Newt.Outputs+import qualified Newt.Outputs as Out++-- | Tag is an abstraction layer over the ways in which a given @key@+-- could be located in a file. Currently, this does require that the+-- syntax for marking keys is regular.+class Tag a where+ tagRegex :: a -> Regex+ stripTag :: a -> (String -> String)++data TagSyntax = TagSyntax { tagStart :: String+ , tagEnd :: String+ , builtRegex :: Regex+ }++instance Tag TagSyntax where+ tagRegex tag = builtRegex tag+ stripTag (TagSyntax s e _) str = reverse $ drop (length e) $ reverse $ drop (length s) str++-- | The default tag prefix.+defaultPrefix :: String+defaultPrefix = "<<<"++-- | The default tag suffix.+defaultSuffix :: String+defaultSuffix = ">>>"++-- | Create a simple 'tag', the pair of syntactic markers that+-- indicate where in a body of text to stick a value. For example,+-- the defaults tag is created with:+--+-- > mkSimpleTag ("<<<", ">>>")+--+-- which corresponds to tags of the form:+--+-- @<<<key>>>@+mkSimpleTag :: (String, String) -> IO TagSyntax+mkSimpleTag (front, back) = do regex <- mkRegex front back+ return $ TagSyntax front back regex++ where mkRegex :: String -> String -> IO Regex+ mkRegex front back = do res <- makeRegex (front++".+"++back)+ case res of+ Left ( _ , err) -> error err+ Right regex -> return regex+++-- | Retrieves the set of @key@s found in a text file.+getTagsFile :: Tag a => a -> FilePath -> IO (Set String)+getTagsFile tag file = do content <- readFile file+ return $ getTags tag content++-- filesIn :: FilePath -> IO [FilePath]+-- filesIn dir = findWithHandler onErr always always dir+-- where onErr :: FilePath -> IOException -> IO [FilePath]+-- onErr file e = do+-- putStrLn ("Error folding over files on: "++file++"\n error:"++show e)+-- return [file]+++-- | Collect the key names for every tag in the contents of the+-- specified directory. This does currently return tags in the+-- directory name itself. That could be confusing, but I think it's a+-- corner case.+--+-- XXX: Does not check to see if dir is actually a directory.+getTagsDirectory :: Tag a => a -> FilePath -> IO (Set String)+getTagsDirectory tag dir = do fileList <- findWithHandler onFileIOErr always always dir+ foldrM acc Set.empty fileList+ where acc :: FilePath -> Set String -> IO (Set String)+ acc file set = do cTags <- contentTags file+ return $ Set.unions [ set+ , getTags tag file -- get the tags from the file name.+ , cTags -- the content tags.+ ]++ contentTags :: FilePath -> IO (Set String)+ contentTags file = do dirExists <- doesDirectoryExist file+ case dirExists of+ True -> return $ Set.empty -- the recursive case is covered by findWithHandler.+ False -> getTagsFile tag file++onFileIOErr :: FilePath -> IOException -> IO [FilePath]+onFileIOErr file e = do+ putStrLn ("Error folding over files on: "++file++"\n error:"++show e)+ return [file]++-- | Retrieve the set of @key@s found in a given string.+getTags :: Tag a => a -> String -> Set String+getTags tag content = let regexp = tagRegex tag+ matches = map (head . elems) (matchAllText regexp content)+ toStr (s, _) = (stripTag tag) s+ in Set.fromList $ map toStr matches++-- |Compute a replacement for a token+type Replace = String -> Maybe String++-- |A table of replacements+type Table = [(String, String)]++-- |Compute a template replacement by looking up in a table+replaceTable :: Table -> Replace+replaceTable t = \k -> lookup k t++-- | Replace all the defined keys in a template, writing the template+-- out to the specified destination.+--+-- `replaceFile` performs IO as necessary to read/write templates and+-- results. It is also poorly named: it operates on any input/output+-- spec.+--+-- XXX: return value should probably be @ErrorT String IO ()@+replaceFile :: Tag a => a -> Replace -> InputSpec -> OutputSpec -> IO ()+replaceFile tag replace StandardIn outSpec = do content <- hGetContents stdin+ let result = populate tag replace content+ writeTo outSpec result+replaceFile tag replace (In.TxtFile inFile) outSpec = do content <- readFile inFile+ let result = populate tag replace content+ writeTo outSpec result+replaceFile tag replace (In.Directory inDir) (Out.Directory outDir) = do+ -- create the incomming dir. This hapens first so the initial+ -- invocation doesn't do string replacement on the dir name.+ createDirectoryIfMissing True outDir+ -- get all the directory entries:+ inPaths <- do tempPaths <- getDirectoryContents inDir+ return $ map (inDir </>) (filter (\x-> (x /= ".") && (x /= "..")) tempPaths)++ let outPaths = map inToOut inPaths+ inToOut f = Just (outDir </> -- prepend the output dir to the paths.+ (populate tag replace -- run substitutions on file names.+ (makeRelative inDir f))) -- get the relative locations for the incoming template files/dirs++ res <- runErrorT $ do+ inList <- mapM inputSpec (map Just inPaths)+ outList <- zipWithM (outputSpec False) inList outPaths+ liftIO $ zipWithM (replaceFile tag replace) inList outList+ -- TODO replaceFile should return ErrorT String IO (), so this won't be necessary:+ case res of+ Left err -> do putStrLn err+ exitWith (ExitFailure 1)+ Right _ -> return ()++++replaceFile _ _ _ _ = putStrLn "Unsupported input/output pairing"++-- | Replace all the defined keys in a string, returning the populated string.+populate :: Tag a => a -> Replace -> String -> String+populate tag replace template = regexReplace (tagRegex tag) replaceFn template+ where stripTags = stripTag tag+ replaceFn str = fromMaybe str $ replace $ stripTags str++-- | Helper function for compiling a non-greedy regular expression.+-- Might be better written as a result of @ErrorT String IO Regex@ to+-- match the other error types in Newt.+makeRegex :: String -> IO (Either (MatchOffset, String) Regex)+makeRegex str = compile compUngreedy execBlank str++-- | Apply @fn@ to every matched instance of @regexp@ in @input@,+-- returning the result.+regexReplace :: Regex -> (String -> String) -> String -> String+regexReplace regexp fn input =+ -- matches :: [(String, (Int, Int))]+ let matches = map (head . elems) (matchAllText regexp input)+ in case matches of+ [] -> input+ _ -> let (prefix, offset) = foldl (builder input fn) ("", 0) matches+ in prefix ++ (drop offset input)++-- | Helper to assemble the replaced strings with the content between+-- regular expression matches.+builder :: String -> (String -> String) -> (String, Int) -> (String, (Int, Int)) -> (String, Int)+builder input fn (acc, loc) (str, (offset, len)) =+ let filler = take (offset - loc) (drop loc input)+ newLoc = offset + len+ in (acc ++ filler ++ fn str, newLoc)
+ src/Newt/Outputs.hs view
@@ -0,0 +1,44 @@+module Newt.Outputs where++import System.Directory ( doesDirectoryExist, doesFileExist+ , copyFile )+import System.FilePath ( (</>) )+import System.Unix.Directory ( withTemporaryDirectory )+import Control.Monad ( when )+import Control.Monad.Error ( ErrorT, throwError, liftIO )++++import qualified Newt.Inputs as In++data OutputSpec = StandardOut+ | TxtFile FilePath+ | Directory FilePath+ deriving (Show)++outputSpec :: Bool -> In.InputSpec -> Maybe FilePath -> ErrorT String IO OutputSpec+outputSpec True inSpec _ = fromInputSpec inSpec+outputSpec False (In.Directory _) Nothing = throwError "Can not write directory input to standard output!"+outputSpec False _ Nothing = return StandardOut -- should check for compatability+outputSpec False input (Just pth) = do dirExists <- liftIO $ doesDirectoryExist pth+ fileExists <- liftIO $ doesFileExist pth+ when (dirExists || fileExists) (throwError (pth++" exists!"))+ case input of+ In.StandardIn -> return $ TxtFile pth+ In.TxtFile _ -> return $ TxtFile pth+ In.Directory _ -> return $ Directory pth++-- | Convert an inputspec into an output spec that represents the same+-- source. used for inplace modifications.+fromInputSpec :: In.InputSpec -> ErrorT String IO OutputSpec+fromInputSpec (In.TxtFile file) = return $ TxtFile file+fromInputSpec (In.Directory dir) = return $ Directory dir+fromInputSpec In.StandardIn = throwError "Can not modife stdin inplace."++writeTo :: OutputSpec -> String -> IO ()+writeTo (TxtFile outFile) str = withTemporaryDirectory "newt-XXXXXX" $ \dir -> do+ let tempOut = dir </> "tempOut"+ writeFile tempOut str+ copyFile tempOut outFile+writeTo StandardOut str = putStr str+writeTo outSpec _ = error ("Could not write to outspec: "++show outSpec)
+ src/Newt/Utilities.hs view
@@ -0,0 +1,30 @@+module Newt.Utilities+ ( copyDirectory+ , cleanup+ ) where++import Prelude hiding ( catch )+import Control.Exception ( IOException, catch, finally )+import System.Directory ( removeFile, removeDirectory )+import System.Process ( rawSystem )++-- | Currently using rawSystem+--+-- XXX this doesn't do proper exception handling, at all. Sorry about that.+copyDirectory :: FilePath -> FilePath -> IO ()+copyDirectory dir newLocation = do _ <- rawSystem "cp" ["-rf", dir, newLocation]+ return ()++cleanup :: [FilePath] -> IO a -> IO a+cleanup files operation = do+ finally operation $ do+ mapM_ rmIfExists files++ where rmIfExists :: FilePath -> IO ()+ rmIfExists file = catch (removeFile file) (fileFailedHandler file)++ fileFailedHandler :: FilePath -> IOException -> IO ()+ fileFailedHandler file e = catch (removeDirectory file) dirFailedHandler++ dirFailedHandler :: IOException -> IO ()+ dirFailedHandler e = return ()
+ tests/src/Integration.hs view
@@ -0,0 +1,119 @@+module Integration where++import Control.Exception.Base (finally, catch, IOException )+import System.Directory ( removeFile, removeDirectory, getTemporaryDirectory+ , copyFile )+import System.FilePath ( (</>) )+import System.Process ( rawSystem )+import System.Exit ( ExitCode(..) )+import Data.UUID.V1 ( nextUUID )+import Data.UUID++import Prelude hiding (catch)++import Test.HUnit ( (@=?), assertEqual, Assertion )+-- import Test.QuickCheck ( Property )+-- import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit+import Test.Framework ( testGroup, Test )++import Newt.Utilities++tests :: [Test]+tests = [ testGroup "Simple File tests" [+ testCase "Simple replacement test 1" $+ test_simpleReplace "The Author" "in.cabal.oracle.1"+ , testCase "Simple replacement test 2" $+ test_simpleReplace "TheAuthor" "in.cabal.oracle.2"+ ]+ , testGroup "Inplace modification tests" [+ testCase "Inplace replacement test 1" $+ test_inplaceReplace "The Author" "in.cabal.oracle.1"+ , testCase "Inplace replacement test 2" $+ test_inplaceReplace "TheAuthor" "in.cabal.oracle.2"+ ]+ ]++testDir :: FilePath+testDir = "tests" </> "testFiles"++newtCmd :: FilePath+newtCmd = "./cabal-dev/bin/newt"+++test_inplaceReplace :: String -> String -> Assertion+test_inplaceReplace author oracleFile = do tmpFile <- getTmpFileName+ let input = (testDir </> "simpleTest" </> "in.cabal")+ source= "--source=" ++ tmpFile+ oracle = (testDir </> "simpleTest" </> oracleFile)+ params = [ "--inplace"+ , "name=myProject"+ , "author="++author]+ cleanup [tmpFile] $ do+ -- don't modify the original test input file:+ copyFile input tmpFile+ exitCode <- rawSystem newtCmd ([source] ++ params)+ assertEqual "invocation of newt failed" ExitSuccess exitCode+ -- check file content:+ assertFilesEqual "Generated file doesn't match" oracle tmpFile++test_simpleReplace :: String -> String -> Assertion+test_simpleReplace author oracleFile = do tmpFile <- getTmpFileName+ let source= "--source=" ++ (testDir </> "simpleTest" </> "in.cabal")+ dest = "--dest="++tmpFile+ oracle = (testDir </> "simpleTest" </> oracleFile)+ params = [ "name=myProject"+ , "author="++author]+ cleanup [tmpFile] $ do+ exitCode <- rawSystem newtCmd ([source, dest] ++ params)+ assertEqual "invocation of newt failed" ExitSuccess exitCode+ -- check file content:+ assertFilesEqual "Generated file doesn't match" oracle tmpFile++assertFilesEqual :: String -> FilePath -> FilePath -> Assertion+assertFilesEqual msg oracle suspect = do oracleTxt <- readFile oracle+ suspectTxt <- readFile suspect+ assertEqual msg oracleTxt suspectTxt++-- | Generates a filename with a uuid in either the system temp+-- directory or the current directory (if the system temp dir can't be+-- found). Does not create the file, or verify uniqueness, just+-- generates the name.+getTmpFileName :: IO FilePath+getTmpFileName = do tempdir <- catch (getTemporaryDirectory) errHandler+ Just uuid <- nextUUID -- XXX will fail if you don't have a MAC+ return (tempdir </> toString uuid)+ where errHandler :: IOException -> IO FilePath+ errHandler _ = return "."++-- {- This function takes two parameters: a filename pattern and another+-- function. It will create a temporary file, and pass the name and Handle+-- of that file to the given function.++-- The temporary file is created with openTempFile. The directory is the one+-- indicated by getTemporaryDirectory, or, if the system has no notion of+-- a temporary directory, "." is used. The given pattern is passed to+-- openTempFile.++-- After the given function terminates, even if it terminates due to an+-- exception, the Handle is closed and the file is deleted. -}+-- withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a+-- withTempFile pattern func =+-- do -- The library ref says that getTemporaryDirectory may raise on+-- -- exception on systems that have no notion of a temporary directory.+-- -- So, we run getTemporaryDirectory under catch. catch takes+-- -- two functions: one to run, and a different one to run if the+-- -- first raised an exception. If getTemporaryDirectory raised an+-- -- exception, just use "." (the current working directory).+-- tempdir <- catch (getTemporaryDirectory) (\_ -> return ".")+-- (tempfile, temph) <- openTempFile tempdir pattern++-- -- Call (func tempfile temph) to perform the action on the temporary+-- -- file. finally takes two actions. The first is the action to run.+-- -- The second is an action to run after the first, regardless of+-- -- whether the first action raised an exception. This way, we ensure+-- -- the temporary file is always deleted. The return value from finally+-- -- is the first action's return value.+-- finally (func tempfile temph) +-- (do hClose temph+-- removeFile tempfile)
+ tests/src/Main.hs view
@@ -0,0 +1,14 @@+module Main where+++import qualified Integration as Integration+import qualified ReplaceTests as ReplaceTests++import Test.Framework ( defaultMain )++++main :: IO ()+main = do replaceTests <- ReplaceTests.tests+ defaultMain $ concat [ replaceTests+ , Integration.tests ]
+ tests/src/ReplaceTests.hs view
@@ -0,0 +1,91 @@+module ReplaceTests where++import qualified Data.Set as Set++import Test.HUnit ( (@=?) )+import Test.QuickCheck ( Property )+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit+import Test.Framework ( testGroup, Test )++import Newt.Newt ( populate, Replace, Table, replaceTable, Tag+ , defaultPrefix, defaultSuffix, mkSimpleTag+ , getTags)++tests :: IO [Test]+tests = do defaultTag <- mkSimpleTag (defaultPrefix, defaultSuffix)+ dashTag <- mkSimpleTag ("---", "---")+ return $ [ testGroup "populate" $+ concat [map (testPopulate defaultTag $ replaceTable replacements)+ [ ("Empty string", "", "")+ , ("Empty tag", "<<<>>>", "<<<>>>")+ , ("Empty tag", "<<<k>>>", "v")+ , ("Nested tag", "<<<<<<k>>>>>>", "<<<v>>>")+ , ("Simple confusing context", "<<<<k>>>", "<v")+ , ("Unknown key", "<<<BadKey>>>", "<<<BadKey>>>")+ , ("key uses prefix", "<<<key<<<key>>>", "ok")+ , ("Multi-tag 1", "<<<k>>> <<<k>>>", "v v")+ , ("Multi-tag 2", "<<<k>>> <<<key>>>", "v value")+ , ("value uses tag markers", "<<<anotherkey>>>", "<<<newKey>>>")+ ]+ , [ testGroup "Random surrounding string"+ [ testProperty "default tag" $+ prop_populateKeyInRandStr defaultTag defaultPrefix defaultSuffix replacements+ , testProperty "dash tag" $+ prop_populateKeyInRandStr dashTag "---" "---" replacements+ ]+ ]+ ]+ , testGroup "getTags" $+ concat [ map (testGetTags defaultTag)+ [ ("Empty string", "", [])+ , ("Empty tag", "<<<>>>", [])+ , ("Empty tag", "<<<k>>>", ["k"])+ , ("Nested tag", "<<<<<<k>>>>>>", ["<<<k>>>"])+ , ("Simple confusing context", "<<<<k>>>", ["k"])+ , ("key uses prefix", "<<<key<<<key>>>", ["key<<<key"])+ , ("Multi-tag 1", "<<<k>>> <<<k>>>", ["k"])+ , ("Multi-tag 2", "<<<k>>> <<<key>>>", ["k", "key"])+ , ("Multi-tag 3", "<<<k>>><<<key>>> <<<k>>>", ["k", "key"])+ ]+ , [ testProperty "random content, default tag" $+ prop_getTags defaultTag defaultPrefix defaultSuffix+ , testProperty "random content, dash tag" $+ prop_getTags dashTag "---" "---"+ ]+ ]+ ]+++-- | Generate random strings, slap a key between them, and see if newt+-- can do the replacement:+prop_populateKeyInRandStr :: Tag a => a -> String -> String -> Table -> String -> String -> Bool+prop_populateKeyInRandStr tag tPrefix tSuffix table pfx sfx =+ let key = (fst . head) table+ value = (snd . head) table+ input = pfx ++ tPrefix ++ key ++ tSuffix ++ sfx+ oracle = pfx ++ value ++ sfx+ in populate tag (replaceTable table) input == oracle++prop_getTags :: Tag a => a -> String -> String -> [(String, String)] -> String -> Bool+prop_getTags tag tPrefix tSuffix keys end =+ let input = foldr (\(filler, key) front -> front ++ filler ++ tPrefix ++ key ++ tSuffix) end keys+ oracle = Set.fromList $ map snd keys+ in getTags tag input == oracle++replacements :: Table+replacements = [ ( "k", "v")+ , ( "key", "value")+ , ( "key<<<key", "ok")+ , ( "anotherkey", "<<<newKey>>>")+ ]++testPopulate :: Tag a => a -> Replace -> (String, String, String) -> Test+testPopulate tag fn (descr, input, oracle) =+ testCase (descr++" input: "++show input) assert+ where assert = oracle @=? populate tag fn input++testGetTags :: Tag a => a -> (String, String, [String]) -> Test+testGetTags tag (descr, input, oracle) =+ testCase (descr++" input: "++show input) assert+ where assert = Set.fromList oracle @=? getTags tag input
+ tests/testFiles/dirTemplates/cabalProject/<<<projName>>>.cabal view
@@ -0,0 +1,43 @@+name: <<<projName>>>+version: 0.0.0.1+synopsis: <<<synopsis>>>+description: <<<description>>>+category: Tools+license: BSD3+License-file: LICENSE+author: <<<author>>>+maintainer: <<<authoremail>>>+Cabal-Version: >=1.8.0.6+build-type: Simple++Flag tests+ Description: Build the tests+ Default: False++Library+ hs-source-dirs: src++ Build-depends: base >= 4 && < 6++ ghc-options: -Wall++Executable <<<projName>>>+ Main-Is: Main.hs+ hs-source-dirs: appsrc++ Build-depends: <<<projName>>>,+ base >= 4 && < 6++ ghc-options: -Wall++Executable test-<<<projName>>>+ Main-Is: Main.hs+ hs-source-dirs: tests/src++ if !flag(tests)+ Buildable: False++ Build-depends: <<<projName>>>,+ base >= 4 && < 6++ ghc-options: -Wall
+ tests/testFiles/dirTemplates/cabalProject/LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) <<<year>>>, <<<author>>>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++Neither the name of <<<author>>> nor the names of his or her+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ tests/testFiles/dirTemplates/cabalProject/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ tests/testFiles/dirTemplates/cabalProject/appsrc/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "<<<projName>>> Sample application!"
+ tests/testFiles/dirTemplates/cabalProject/src/<<<projName>>>.hs view
+ tests/testFiles/dirTemplates/cabalProject/tests/src/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "<<<projName>>> Test suite."
+ tests/testFiles/dirTemplates/template2/<<<projName>>>/in.cabal view
@@ -0,0 +1,15 @@+name: <<<projName>>>+version: 0.0.0.1+synopsis: <<<synopsis>>>+description: <<<description>>>+category: Tools+license: BSD3+License-file: LICENSE+author: <<<author>>>+maintainer: <<<authoremail>>>+Cabal-Version: >=1.8.0.6+build-type: Simple++Executable <<<projName>>>+ Main-Is: Main.hs+ hs-source-dirs: src
+ tests/testFiles/simpleTest/alternate1.txt view
@@ -0,0 +1,5 @@+Testing zzz_letter_z_zzz brackets.+Another ***starts*** of brackets.+Another [[[squareBrackets]]] of brackets.+Another <<<angleBrackets>>> of brackets.+Another ---dashes--- of brackets.
+ tests/testFiles/simpleTest/in.cabal view
@@ -0,0 +1,15 @@+name: <<<name>>>+version: 0.0.0.1+synopsis: <<<synopsis>>>+description: <<<description>>>+category: Tools+license: BSD3+License-file: LICENSE+author: <<<author>>>+maintainer: <<<authoremail>>>+Cabal-Version: >=1.8.0.6+build-type: Simple++Executable <<<name>>>+ Main-Is: Main.hs+ hs-source-dirs: src
+ tests/testFiles/simpleTest/in.cabal.oracle.1 view
@@ -0,0 +1,15 @@+name: myProject+version: 0.0.0.1+synopsis: <<<synopsis>>>+description: <<<description>>>+category: Tools+license: BSD3+License-file: LICENSE+author: The Author+maintainer: <<<authoremail>>>+Cabal-Version: >=1.8.0.6+build-type: Simple++Executable myProject+ Main-Is: Main.hs+ hs-source-dirs: src
+ tests/testFiles/simpleTest/in.cabal.oracle.2 view
@@ -0,0 +1,15 @@+name: myProject+version: 0.0.0.1+synopsis: <<<synopsis>>>+description: <<<description>>>+category: Tools+license: BSD3+License-file: LICENSE+author: TheAuthor+maintainer: <<<authoremail>>>+Cabal-Version: >=1.8.0.6+build-type: Simple++Executable myProject+ Main-Is: Main.hs+ hs-source-dirs: src
+ tests/testFiles/simpleTest/simple1.txt view
@@ -0,0 +1,1 @@+Variable: <<<key>>>