@@ -5,11 +5,15 @@ module Main
55
66
77--------------------------------------------------------------------------------
8+import Control.Arrow (first)
89import Control.Monad (forM_)
9−import System.Directory (copyFile)
10+import Data.Char (isAlphaNum, isNumber)
11+import Data.List (intercalate)
12+import Data.Version (Version(..))
13+import System.Directory (copyFile, canonicalizePath)
1014import System.Environment (getArgs, getProgName)
1115import System.Exit (exitFailure)
12−import System.FilePath ((</>))
16+import System.FilePath ((</>), splitDirectories)
1317
1418
1519--------------------------------------------------------------------------------
@@ -26,12 +30,52 @@ main = do
2630 files <- getRecursiveContents (const $ return False) srcDir
2731
2832 case args of
29− [dstDir] -> forM_ files $ \file -> do
30− let dst = dstDir </> file
31− src = srcDir </> file
32− putStrLn $ "Creating " ++ dst
33− makeDirectories dst
34− copyFile src dst
33+ [dstDir] -> do
34+ forM_ files $ \file -> do
35+ let dst = dstDir </> file
36+ src = srcDir </> file
37+ putStrLn $ "Creating " ++ dst
38+ makeDirectories dst
39+ copyFile src dst
40+ -- canonicalizePath is safe because the destination
41+ -- directory should exist at this point
42+ canonicalizePath dstDir >>= createCabal
3543 _ -> do
3644 putStrLn $ "Usage: " ++ progName ++ " <directory>"
3745 exitFailure
46+
47+
48+createCabal :: FilePath -> IO ()
49+createCabal dstDir = do
50+ putStrLn $ "Creating " ++ name ++ ".cabal"
51+ writeFile (dstDir </> name ++ ".cabal") $ unlines [
52+ "name: " ++ name
53+ , "version: 0.1.0.0"
54+ , "build-type: Simple"
55+ , "cabal-version: >= 1.10"
56+ , ""
57+ , "executable site"
58+ , " main-is: site.hs"
59+ , " build-depends: base == 4.*"
60+ , " , hakyll == " ++ version' ++ ".*"
61+ , " ghc-options: -threaded"
62+ , " default-language: Haskell2010"
63+ ]
64+ where
65+ -- Major hakyll version
66+ version' = intercalate "." . take 2 . map show $ versionBranch version
67+ -- last is safe here as the path is canonicalised and "/" is just
68+ -- a very rare but possible corner case
69+ name = case last (splitDirectories dstDir) of
70+ "/" -> fallbackName
71+ x -> repair (fallbackName ++) id x
72+ -- Package name repair code comes from
73+ -- cabal-install.Distribution.Client.Init.Heuristics
74+ repair invalid valid x = case dropWhile (not . isAlphaNum) x of
75+ "" -> repairComponent ""
76+ x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'
77+ in c ++ repairRest r
78+ where repairComponent c | all isNumber c = invalid c
79+ | otherwise = valid c
80+ repairRest = repair id ('-' :)
81+ fallbackName = "site"