create template-info.yaml

README.md

@@ -50,3 +50,7 @@ parameters, use this Mustache syntax:
 ```
 author:              {{author-name}}{{^author-name}}Author name here{{/author-name}}
 ```
+
+## `template-info.yaml`
+
+When contributing a new template, please remember to add a corresponding entry to `template-info.yaml`. Additional descriptive information for the template may be provided, but is not required.

template-info.yaml

@@ -0,0 +1,86 @@
+chrisdone:
+  description:
+
+franklinchen:
+  description:
+
+ghcjs:
+  description: Haskell to JavaScript compiler, based on GHC
+
+ghcjs-old-base:
+  description:
+
+hakyll-template:
+  description: a static website compiler library
+
+haskeleton:
+  description: a project skeleton for Haskell packages
+
+hspec:
+  description: a testing framework for Haskell inspired by the Ruby library RSpec
+
+new-template:
+  description:
+
+quickcheck-test-framework:
+  description: a library for random testing of program properties
+
+rubik:
+  description:
+
+scotty-hello-world:
+  description:
+
+scotty-hspec-wai:
+  description:
+
+servant:
+  description: a set of packages for declaring web APIs at the type-level
+
+servant-docker:
+  description:
+
+simple:
+  description:
+
+simple-hpack:
+  description:
+
+simple-library:
+  description:
+
+tasty-discover:
+  description:
+
+tasty-travis:
+  description:
+
+unicode-syntax-exe:
+  description:
+
+unicode-syntax-lib:
+  description:
+
+yesod-hello-world:
+  description:
+
+yesod-minimal:
+  description:
+
+yesod-mongo:
+  description:
+
+yesod-mysql:
+  description:
+
+yesod-postgres:
+  description:
+
+yesod-postgres-fay:
+  description:
+
+yesod-simple:
+  description:
+
+yesod-sqlite:
+  description:

test-templates.hs

@@ -1,10 +1,13 @@
 #!/usr/bin/env stack
 {-
 stack runghc
---resolver lts-5.8 --install-ghc
+--resolver lts-5.11 --install-ghc
 --no-terminal
 --package mockery
 --package getopt-generics
+--package text
+--package unordered-containers
+--package yaml
 --
 -Wall -Werror
 -}
@@ -13,11 +16,18 @@ stack runghc
 
 module Main (main) where
 
-import           Control.Monad
+import           Control.Arrow       ((***))
+import           Control.Monad       (forM_, unless)
+import           Data.HashMap.Strict (keys)
 import           Data.List
+import           Data.Maybe          (fromMaybe)
+import           Data.Monoid
+import qualified Data.Text           as T
+import           Data.Yaml           (ParseException, Object)
+import qualified Data.Yaml           as Yaml
 import           System.Directory
-import           System.Exit
-import           System.FilePath
+import           System.Exit         (die)
+import           System.FilePath     ((</>), dropExtension, takeExtension, takeBaseName)
 import           System.IO
 import           System.Process
 import           Test.Mockery.Directory
@@ -41,35 +51,73 @@ isExcluded :: FilePath -> Bool
 isExcluded file = dropExtension file `elem` excluded
 
 main :: IO ()
-main = withHsfiles $ \ hsfiles -> do
-  forM_ hsfiles $ \ hsfile -> do
-    logImportant ("testing " ++ takeBaseName hsfile)
-    inTempDirectory $ do
-      callCommand ("stack new test-project " ++ hsfile ++ " --no-terminal")
-      setCurrentDirectory "test-project"
-      callCommand "stack test --fast --no-terminal"
+main = do 
+
+  logImportant $ "Verifying " <> templateInfoFile
+  verified <- verifyInfo
+  case verified of
+    Left err -> die err
+    _ -> return () 
+
+  withHsfiles $ \ hsfiles ->
+    forM_ hsfiles $ \ hsfile -> do
+      logImportant ("testing " ++ takeBaseName hsfile)
+      inTempDirectory $ do
+        callCommand ("stack new test-project " ++ hsfile ++ " --no-terminal")
+        setCurrentDirectory "test-project"
+        callCommand "stack test --fast --no-terminal"
 
 withHsfiles :: ([FilePath] -> IO ()) -> IO ()
 withHsfiles action = withCli $ \ (args :: [FilePath]) -> do
   hsfiles <- case args of
-    [] -> getHsfiles
+    [] -> fmap (filter $ not . isExcluded) getHsfiles
     _ -> do
       mapM_ checkExists args
       return args
   currentDirectory <- canonicalizePath =<< getCurrentDirectory
   action $ map (currentDirectory </>) hsfiles
 
+verifyInfo :: IO (Either String ())
+verifyInfo = do
+  checkExists templateInfoFile
+  decoded <- Yaml.decodeFileEither templateInfoFile :: IO (Either ParseException Object)
+  case decoded of
+    Left ex -> return . Left $ "Invalid " <> templateInfoFile <> " file. " <> show ex
+    Right o -> do
+      templates <- getHsfiles
+      let info   = map T.unpack (keys o)
+          check  = uniqueElems (map takeBaseName templates) info
+          output = notEnough *** tooMuch $ check
+      case check of
+        (Nothing, Nothing) -> return $ Right ()
+        _                  -> return $ Left $ uncurry (<>) output 
+  where
+    formatOutput header items = 
+      fromMaybe "" $ unlines . (header :) . map (" - " <>) <$> items    
+    notEnough = formatOutput $ "Add the following templates to " <> templateInfoFile <> ":"
+    tooMuch   = formatOutput $ "Remove the following templates from " <> templateInfoFile <> ":"
+
+uniqueElems :: Eq a => [a] -> [a] -> (Maybe [a], Maybe [a])
+uniqueElems = bothWays unique
+  where 
+    bothWays f xs ys = (f xs ys, f ys xs)
+    unique xs ys = 
+      case xs \\ ys of
+        []   -> Nothing
+        diff -> Just diff
+
+templateInfoFile :: String
+templateInfoFile = "template-info.yaml"
+
 getHsfiles :: IO [FilePath]
 getHsfiles =
-  sort <$>
-  filter (not . isExcluded) <$>
-  filter ((== ".hsfiles") . takeExtension) <$>
+  sort . filter ((== ".hsfiles") . takeExtension) <$>
   getDirectoryContents "."
 
 checkExists :: FilePath -> IO ()
 checkExists file = do
   exists <- doesFileExist file
-  when (not exists) $
+  unless exists $
     die ("file not found: " ++ file)
 
 logImportant :: String -> IO ()