newt 0.0.1.0 → 0.0.3.0
raw patch · 16 files changed
+354/−237 lines, 16 filesdep +bytestringdep +safedep +textdep −regex-basedep −regex-pcrebinary-added
Dependencies added: bytestring, safe, text
Dependencies removed: regex-base, regex-pcre
Files
- appsrc/Main.hs +8/−75
- newt.cabal +23/−15
- src/Newt/CmdParsing.hs +119/−0
- src/Newt/Inputs.hs +20/−3
- src/Newt/Newt.hs +60/−69
- src/Newt/Outputs.hs +11/−10
- src/Newt/Utilities.hs +17/−2
- tests/src/Integration.hs +46/−38
- tests/src/Main.hs +3/−1
- tests/src/ReplaceTests.hs +46/−24
- tests/testFiles/dirTemplates/template1/<<<projName>>>/.gitignore +0/−0
- tests/testFiles/dirTemplates/template3/<<<projName>>>/.gitignore +0/−0
- tests/testFiles/dirTemplates/template3/<<<projName>>>/<<<projName2>>>/.gitignore +0/−0
- tests/testFiles/dirTemplates/templateWithImages/<<<name>>>.png binary
- tests/testFiles/dirTemplates/templateWithImages/<<<name>>>.txt +1/−0
- tests/testFiles/sampleImage.png binary
appsrc/Main.hs view
@@ -1,94 +1,33 @@-{-# 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.CmdParsing ( getConfig, Config(..), debug ) 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+import Paths_newt ( 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+main = do conf <- getConfig version+ let simpleTag = mkSimpleTag $ tagBrackets conf+ table = mapMaybe strToPair $ rawTable conf replace = replaceTable table replacement input output = replaceFile simpleTag replace input output + debug conf ("Using configuration: "++show conf)+ res <- runErrorT $ do inSpec <- inputSpec $ source conf if (list conf)@@ -113,12 +52,6 @@ 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
newt.cabal view
@@ -1,5 +1,5 @@ name: newt-version: 0.0.1.0+version: 0.0.3.0 synopsis: A trivially simple app to create things from simple templates. description: Instantiates text things from templates. category: Tools@@ -11,21 +11,24 @@ 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/templateWithImages/<<<name>>>.txt+ tests/testFiles/dirTemplates/templateWithImages/<<<name>>>.png+ tests/testFiles/dirTemplates/template2/<<<projName>>>/in.cabal+ tests/testFiles/dirTemplates/template3/<<<projName>>>/.gitignore+ tests/testFiles/dirTemplates/template3/<<<projName>>>/<<<projName2>>>/.gitignore tests/testFiles/dirTemplates/cabalProject/LICENSE+ tests/testFiles/dirTemplates/cabalProject/tests/src/Main.hs+ tests/testFiles/dirTemplates/cabalProject/src/<<<projName>>>.hs tests/testFiles/dirTemplates/cabalProject/Setup.hs+ tests/testFiles/dirTemplates/cabalProject/<<<projName>>>.cabal 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/dirTemplates/template1/<<<projName>>>/.gitignore tests/testFiles/simpleTest/in.cabal.oracle.1 tests/testFiles/simpleTest/in.cabal.oracle.2+ tests/testFiles/simpleTest/alternate1.txt+ tests/testFiles/simpleTest/in.cabal tests/testFiles/simpleTest/simple1.txt+ tests/testFiles/sampleImage.png Flag tests Description: Build the tests@@ -37,15 +40,18 @@ Exposed-modules: Newt.Newt, Newt.Inputs, Newt.Outputs,- Newt.Utilities+ Newt.Utilities,+ Newt.CmdParsing 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+ Unixutils >= 1.36 && < 1.37,+ safe >= 0.3 && < 0.4,+ cmdargs >= 0.6.9 && < 0.6.10,+ bytestring >= 0.9.1.10 && < 0.9.2,+ text if impl(ghc < 7) Build-depends: containers >= 0.3.0.0 && < 0.5,@@ -96,7 +102,9 @@ 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+ uuid >= 1.2.2 && < 1.2.3,+ Unixutils >= 1.36 && < 1.37,+ safe >= 0.3 && < 0.4 if impl(ghc < 7) Build-depends:
+ src/Newt/CmdParsing.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Newt.CmdParsing+ ( Config(..)+ , getConfig+ , debug+ , versionString+ ) where++import Data.List ( partition )+import Data.Version ( showVersion, Version )+import System.Console.CmdArgs.Implicit+import System.Console.CmdArgs.Verbosity ( whenLoud, Verbosity(..), getVerbosity )+import Safe ( headMay, tailMay )+import System.Environment ( getArgs, withArgs )++import Newt.Utilities ( isValueArg )++getConfig :: Version -> IO Config+getConfig version = do rawConf <- do args <- getArgs+ -- if no arguments were specified, print help and exit:+ case args of+ [] -> withArgs ["--help"] $ cmdArgs $ config version+ _ -> cmdArgs (config version)+ v <- getVerbosity+ return $ relaxArgs rawConf { verb = v }++data Config = Config { source :: Maybe FilePath+ , dest :: Maybe FilePath+ , rawTable :: [String]+ , list :: Bool+ , inplace :: Bool+ , prefix :: Maybe String+ , suffix :: Maybe String+ , verb :: Verbosity+ } deriving (Show, Data, Typeable)++config :: Version -> Config+config version =+ 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 "\">>>\""+ , verb = Normal+ } &= summary (versionString version) &= details detailsHeader &= program "newt" &= verbosity++customTags :: String+customTags = "\nCustomizing tag syntax"++versionString :: Version -> String+versionString version = "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"+ ]++-- | Relax the arguments a bit so -s --sourc / etc aren't strictly+-- necessary.+--+-- If --source is not specified, use the first non-value assignment+-- in args+--+-- if --dest is also not specified, use the first non-value+-- assignment in args for dest.+--+-- if neither --source or --dest is specified, use the first+-- non-value assignment for --source and the second for --dest.+relaxArgs :: Config -> Config+relaxArgs conf = let (newSrc, newDest, newTable) = findAltSourceDest (source conf) (dest conf) (partition isValueArg $ rawTable conf)+ in conf { source = newSrc+ , dest = newDest+ , rawTable = newTable+ }++findAltSourceDest :: Maybe FilePath -> Maybe FilePath -> ([String], [String]) -> (Maybe FilePath, Maybe FilePath, [String])+findAltSourceDest mbSrc mbDest (valueArgs, nonValueArgs) =+ case (mbSrc, mbDest) of+ (Nothing, Nothing) -> ( headMay nonValueArgs+ , tailMay nonValueArgs >>= headMay+ , valueArgs)+ (Just s, Nothing) -> (Just s, headMay nonValueArgs, valueArgs)+ (Nothing, Just d ) -> (headMay nonValueArgs, Just d, valueArgs)+ (Just s, Just d ) -> (Just s, Just d, valueArgs)++debug :: Config -> String -> IO ()+debug conf msg = case verb conf of+ Loud -> putStrLn msg+ _ -> return ()
src/Newt/Inputs.hs view
@@ -2,13 +2,21 @@ import System.Directory ( doesDirectoryExist, doesFileExist ) +import Control.Exception ( catch, IOException ) import Control.Monad.Error ( ErrorT, throwError, liftIO )+import Data.Text.Encoding ( decodeUtf8' )+import Data.Text ( unpack ) +import Prelude hiding (catch)++-- should be lazy?+import qualified Data.ByteString.Char8 as C8+import Data.ByteString ( ByteString )+ data InputSpec = StandardIn | TxtFile FilePath | Directory FilePath- -- | TarGz FilePath- -- | Zip FilePath+ | BinFile FilePath deriving (Show) inputSpec :: Maybe FilePath -> ErrorT String IO InputSpec@@ -18,5 +26,14 @@ case dirExists of True -> return (Directory pth) False -> case fileExists of- True -> return (TxtFile pth) False -> throwError (pth++" Does not exist!")+ True -> do isT <- liftIO $ isText pth+ case isT of+ True -> return (TxtFile pth)+ False -> return (BinFile pth)++isText :: FilePath -> IO Bool+isText path = do content <- C8.readFile path+ return $ case decodeUtf8' content of+ Left _ -> False+ Right _ -> True
src/Newt/Newt.hs view
@@ -3,18 +3,12 @@ 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 )+ , createDirectoryIfMissing, copyFile ) import System.Exit ( exitWith, ExitCode(..) ) import System.FilePath ( (</>) ) import System.FilePath.Find ( findWithHandler, always )@@ -32,17 +26,33 @@ -- 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)+ findTagStart :: a -> String -> Maybe (ShowS, String)+ findTagEnd :: a -> String -> Maybe (ShowS, String)+ mkSubstKey :: a -> String -> String data TagSyntax = TagSyntax { tagStart :: String , tagEnd :: String- , builtRegex :: Regex } +findTok :: String -> String -> Maybe (ShowS, String)+findTok t = go id+ where+ go _ "" = Nothing+ go acc s@(c:cs) = case dropPrefix t s of+ Nothing -> go (acc . (c:)) cs+ Just s' -> Just (acc, s')++dropPrefix :: String -> String -> Maybe String+dropPrefix pfx s = go pfx s+ where+ go (c1:cs1) (c2:cs2) | c1 == c2 = go cs1 cs2+ go [] s2 = Just s2+ go _ _ = Nothing+ instance Tag TagSyntax where- tagRegex tag = builtRegex tag- stripTag (TagSyntax s e _) str = reverse $ drop (length e) $ reverse $ drop (length s) str+ findTagStart = findTok . tagStart+ findTagEnd = findTok . tagEnd+ mkSubstKey t s = tagStart t ++ s ++ tagEnd t -- | The default tag prefix. defaultPrefix :: String@@ -61,30 +71,14 @@ -- 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-+mkSimpleTag :: (String, String) -> TagSyntax+mkSimpleTag (front, back) = TagSyntax front back -- | 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@@ -105,20 +99,18 @@ contentTags file = do dirExists <- doesDirectoryExist file case dirExists of True -> return $ Set.empty -- the recursive case is covered by findWithHandler.- False -> getTagsFile tag file+ False -> do isT <- liftIO $ isText file+ case isT of+ True -> getTagsFile tag file+ False -> return $ Set.empty ++ 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 @@ -138,6 +130,10 @@ -- -- XXX: return value should probably be @ErrorT String IO ()@ replaceFile :: Tag a => a -> Replace -> InputSpec -> OutputSpec -> IO ()+replaceFile _ _ (BinFile binFile) outSpec = case outSpec of+ StandardOut -> putStrLn ("Not copying bin file to stdout: "++binFile)+ File file -> copyFile binFile file+ Out.Directory _ -> putStrLn ("Inconsistent in/output formats: BinFile -> Dir: " ++ binFile) replaceFile tag replace StandardIn outSpec = do content <- hGetContents stdin let result = populate tag replace content writeTo outSpec result@@ -166,38 +162,33 @@ 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+findNextTag :: Tag a => a -> String -> Maybe (ShowS, String, String)+findNextTag t s = do+ (before, atTagStart) <- findTagStart t s+ (substKeyS, atTagEnd) <- findTagEnd t atTagStart+ return (before, substKeyS "", atTagEnd) --- | 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)+-- |Replace tags in the input string+populate :: Tag a => a -> Replace -> String -> String+populate t subst s = go s ""+ where+ go here =+ case findNextTag t here of+ Nothing -> showString here+ Just (before, substKey, atTagEnd) ->+ let substitution = case subst substKey of+ Nothing -> mkSubstKey t substKey+ Just newValue -> newValue+ in before . showString substitution . go atTagEnd --- | 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)+-- | Retrieve the set of @key@s found in a given string.+-- empty strings are not valid.+getTags :: Tag a => a -> String -> Set String+getTags tag str = Set.filter (/="") $ go Set.empty str+ where+ go found s =+ case findNextTag tag s of+ Nothing -> found+ Just (_, k, rest) -> go (Set.insert k found) rest
src/Newt/Outputs.hs view
@@ -12,7 +12,8 @@ import qualified Newt.Inputs as In data OutputSpec = StandardOut- | TxtFile FilePath+ | File FilePath -- ^ output doesn't distinguish between+ -- binary and text files. | Directory FilePath deriving (Show) @@ -24,21 +25,21 @@ fileExists <- liftIO $ doesFileExist pth when (dirExists || fileExists) (throwError (pth++" exists!")) case input of- In.StandardIn -> return $ TxtFile pth- In.TxtFile _ -> return $ TxtFile pth+ In.StandardIn -> return $ File pth+ In.TxtFile _ -> return $ File 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.TxtFile file) = return $ File 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)+writeTo (File 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
@@ -1,13 +1,22 @@ module Newt.Utilities ( copyDirectory , cleanup+ , trim+ , isValueArg ) where import Prelude hiding ( catch ) import Control.Exception ( IOException, catch, finally )++import Data.Char (isSpace) import System.Directory ( removeFile, removeDirectory ) import System.Process ( rawSystem ) ++isValueArg :: String -> Bool+isValueArg str = '=' `elem` str++ -- | Currently using rawSystem -- -- XXX this doesn't do proper exception handling, at all. Sorry about that.@@ -24,7 +33,13 @@ rmIfExists file = catch (removeFile file) (fileFailedHandler file) fileFailedHandler :: FilePath -> IOException -> IO ()- fileFailedHandler file e = catch (removeDirectory file) dirFailedHandler+ fileFailedHandler file _e = catch (removeDirectory file) dirFailedHandler dirFailedHandler :: IOException -> IO ()- dirFailedHandler e = return ()+ dirFailedHandler _e = return ()+++-- | remove leading / trailing whitespace.+trim :: String -> String+trim = reverse . dropSpaces . reverse . dropSpaces+ where dropSpaces = dropWhile isSpace
tests/src/Integration.hs view
@@ -8,6 +8,7 @@ import System.Exit ( ExitCode(..) ) import Data.UUID.V1 ( nextUUID ) import Data.UUID+import System.Unix.Directory ( withTemporaryDirectory ) import Prelude hiding (catch) @@ -17,15 +18,29 @@ import Test.Framework.Providers.HUnit import Test.Framework ( testGroup, Test ) +import Data.Version ( showVersion, Version )+import System.Process ( readProcess )+ import Newt.Utilities+import Newt.CmdParsing ( versionString ) +import Paths_newt ( version )+ tests :: [Test]-tests = [ testGroup "Simple File tests" [+tests = [ testGroup "sanity tests" [+ testCase "Check the invoked version of Newt against the cabal file"+ verifyVersion+ ]+ , 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 "Simple directory tests" [+ testCase "Cabal project generation" $+ test_dirReplace projectTable "cabalProject" "cabalProjectOracle"+ ] , testGroup "Inplace modification tests" [ testCase "Inplace replacement test 1" $ test_inplaceReplace "The Author" "in.cabal.oracle.1"@@ -34,6 +49,14 @@ ] ] +-- | Make sure we're actually invoking the version of newt that was just built.+verifyVersion :: Assertion+verifyVersion = do res <- readProcess newtCmd ["--version"] ""+ assertEqual "Invoking the wrong version of newt" (trim $ versionString version) (trim res)++projectTable :: [(String, String)]+projectTable = [ ("projName", "testProj")]+ testDir :: FilePath testDir = "tests" </> "testFiles" @@ -52,21 +75,19 @@ 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+ _ <- runNewt ([source] ++ params) -- 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")+ let source= "--source="++(testDir </> "simpleTest" </> "in.cabal") dest = "--dest="++tmpFile oracle = (testDir </> "simpleTest" </> oracleFile)- params = [ "name=myProject"- , "author="++author]+ table = [ "name=myProject"+ , "author=" ++ author ] cleanup [tmpFile] $ do- exitCode <- rawSystem newtCmd ([source, dest] ++ params)- assertEqual "invocation of newt failed" ExitSuccess exitCode+ _ <- runNewt (table ++ [source, dest]) -- check file content: assertFilesEqual "Generated file doesn't match" oracle tmpFile @@ -75,6 +96,12 @@ suspectTxt <- readFile suspect assertEqual msg oracleTxt suspectTxt +-- assertFilePathEqual :: String -> FilePath -> FilePath+-- assertFilePathEqual msg oracle suspect = ++assertDirsEqual :: String -> FilePath -> FilePath -> Assertion+assertDirsEqual msg oracle suspect = assertEqual msg False True+ -- | 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@@ -86,34 +113,15 @@ 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+runNewt :: [String] -> IO ExitCode+runNewt params = do -- putStrLn ("Invoking newt: "++show params)+ exitCode <- rawSystem newtCmd params+ assertEqual "invocation of newt failed" ExitSuccess exitCode+ return exitCode --- -- 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)+test_dirReplace :: [(String, String)] -> FilePath -> FilePath -> Assertion+test_dirReplace table inDir oracle = withTemporaryDirectory "newt-XXXXXX" $ \dir -> do+ let outDir = dir </> oracle+ params = map (\(k,v)->k++"="++v) table+ _ <- runNewt (params ++ ["--source="++inDir, "--dest="++outDir])+ assertDirsEqual "Directory replacement failed." oracle outDir
tests/src/Main.hs view
@@ -3,6 +3,7 @@ import qualified Integration as Integration import qualified ReplaceTests as ReplaceTests+import qualified UtilityTests as UtilityTests import Test.Framework ( defaultMain ) @@ -10,5 +11,6 @@ main :: IO () main = do replaceTests <- ReplaceTests.tests- defaultMain $ concat [ replaceTests+ defaultMain $ concat [ UtilityTests.tests+ , replaceTests , Integration.tests ]
tests/src/ReplaceTests.hs view
@@ -2,26 +2,31 @@ import qualified Data.Set as Set +import Safe+ import Test.HUnit ( (@=?) )-import Test.QuickCheck ( Property )+import Test.QuickCheck ( Property, (==>) )+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)+ , getTags, getTagsDirectory ) +import TestUtilities+ tests :: IO [Test]-tests = do defaultTag <- mkSimpleTag (defaultPrefix, defaultSuffix)- dashTag <- mkSimpleTag ("---", "---")+tests = do let 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")+ , ("Nested tag", "<<<<<<k>>>>>>", "<<<<<<k>>>>>>")+ , ("Simple confusing context", "<<<<k>>>", "<<<<k>>>") , ("Unknown key", "<<<BadKey>>>", "<<<BadKey>>>") , ("key uses prefix", "<<<key<<<key>>>", "ok") , ("Multi-tag 1", "<<<k>>> <<<k>>>", "v v")@@ -41,36 +46,49 @@ [ ("Empty string", "", []) , ("Empty tag", "<<<>>>", []) , ("Empty tag", "<<<k>>>", ["k"])- , ("Nested tag", "<<<<<<k>>>>>>", ["<<<k>>>"])- , ("Simple confusing context", "<<<<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 "---" "---"- ]+ -- , [ testProperty "random content, default tag" $+ -- prop_getTags defaultTag defaultPrefix defaultSuffix+ -- , testProperty "random content, dash tag" $+ -- prop_getTags dashTag "---" "---"+ -- ] ]+ , testGroup "getTagsDirectory" $ map (testGetTagsDirectory defaultTag) [+ ("Cabal Project", "tests/testFiles/dirTemplates/cabalProject",+ ["author", "authoremail", "description", "projName", "synopsis", "year"])+ , ("Sample Image Proj", "tests/testFiles/dirTemplates/templateWithImages",+ ["name", "inner"])+ ] ] -- | 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 =+prop_populateKeyInRandStr :: Tag a => a -> String -> String -> Table -> String -> Char -> String -> Char -> Property+prop_populateKeyInRandStr tag tPrefix tSuffix table pfx pCh sfx sCh = (Just pCh) /= headMay tPrefix &&+ (Just sCh) /= lastMay tSuffix ==> let key = (fst . head) table value = (snd . head) table- input = pfx ++ tPrefix ++ key ++ tSuffix ++ sfx- oracle = pfx ++ value ++ sfx+ input = pfx ++ [pCh] ++ tPrefix ++ key ++ tSuffix ++ [sCh] ++ sfx+ oracle = pfx ++ [pCh] ++ value ++ [sCh] ++ 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+emptyKorV :: (String, String) -> Bool+emptyKorV ("", _ ) = True+emptyKorV (_ , "") = True+emptyKorV (_ , _ ) = False++prop_getTags :: Tag a => a -> String -> String -> [(String, String)] -> String -> Property+prop_getTags tag tPrefix tSuffix keys end = filter (not . emptyKorV) keys /= [] ==>+ let filteredTable = filter (not . emptyKorV) keys+ input = foldr (\(filler, key) front -> front ++ filler ++ tPrefix ++ key ++ tSuffix) end filteredTable+ oracle = Set.fromList $ map snd filteredTable in getTags tag input == oracle replacements :: Table@@ -81,11 +99,15 @@ ] 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+testPopulate tag fn = genTest (populate tag fn) 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++testGetTagsDirectory :: Tag a => a -> (String, String, [String]) -> Test+testGetTagsDirectory tag (descr, input, oracle) =+ testCase (descr++" input: "++show input) assert+ where assert = do tags <- getTagsDirectory tag input+ Set.fromList oracle @=? tags
+ tests/testFiles/dirTemplates/template1/<<<projName>>>/.gitignore view
+ tests/testFiles/dirTemplates/template3/<<<projName>>>/.gitignore view
+ tests/testFiles/dirTemplates/template3/<<<projName>>>/<<<projName2>>>/.gitignore view
+ tests/testFiles/dirTemplates/templateWithImages/<<<name>>>.png view
binary file changed (absent → 40190 bytes)
+ tests/testFiles/dirTemplates/templateWithImages/<<<name>>>.txt view
@@ -0,0 +1,1 @@+test with <<<inner>>> content.
+ tests/testFiles/sampleImage.png view
binary file changed (absent → 40190 bytes)