1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
--------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Arrow (first)
import Control.Monad (forM_)
import Data.Char (isAlphaNum, isNumber)
import Data.List (foldl')
import Data.List (intercalate)
import Data.Version (Version (..))
import System.Directory (canonicalizePath, copyFile)
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)
import System.FilePath (splitDirectories, (</>))
--------------------------------------------------------------------------------
import Hakyll.Core.Util.File
import Paths_hakyll
--------------------------------------------------------------------------------
main :: IO ()
main = do
progName <- getProgName
args <- getArgs
srcDir <- getDataFileName "example"
files <- getRecursiveContents (const $ return False) srcDir
case args of
[dstDir] -> do
forM_ files $ \file -> do
let dst = dstDir </> file
src = srcDir </> file
putStrLn $ "Creating " ++ dst
makeDirectories dst
copyFile src dst
name <- makeName dstDir
let cabalPath = dstDir </> name ++ ".cabal"
putStrLn $ "Creating " ++ cabalPath
createCabal cabalPath name
_ -> do
putStrLn $ "Usage: " ++ progName ++ " <directory>"
exitFailure
-- | Figure out a good cabal package name from the given (existing) directory
-- name
makeName :: FilePath -> IO String
makeName dstDir = do
canonical <- canonicalizePath dstDir
return $ case safeLast (splitDirectories canonical) of
Nothing -> fallbackName
Just "/" -> fallbackName
Just x -> repair (fallbackName ++) id x
where
-- Package name repair code comes from
-- cabal-install.Distribution.Client.Init.Heuristics
repair invalid valid x = case dropWhile (not . isAlphaNum) x of
"" -> repairComponent ""
x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'
in c ++ repairRest r
where repairComponent c | all isNumber c = invalid c
| otherwise = valid c
repairRest = repair id ('-' :)
fallbackName = "site"
safeLast = foldl' (\_ x -> Just x) Nothing
createCabal :: FilePath -> String -> IO ()
createCabal path name = do
writeFile path $ unlines [
"name: " ++ name
, "version: 0.1.0.0"
, "build-type: Simple"
, "cabal-version: >= 1.10"
, ""
, "executable site"
, " main-is: site.hs"
, " build-depends: base == 4.*"
, " , hakyll == " ++ version' ++ ".*"
, " ghc-options: -threaded"
, " default-language: Haskell2010"
]
where
-- Major hakyll version
version' = intercalate "." . take 2 . map show $ versionBranch version
|
