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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
--------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Arrow (first)
import Control.Monad (forM, forM_)
import Data.Char (isAlphaNum, isNumber)
import Data.List (foldl', intercalate, isPrefixOf)
import Data.Version (Version (..))
import System.Directory (canonicalizePath, copyFile,
doesFileExist)
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)
import System.FilePath (splitDirectories, (</>))
--------------------------------------------------------------------------------
import Hakyll.Core.Util.File
import Paths_hakyll
--------------------------------------------------------------------------------
import Prelude
--------------------------------------------------------------------------------
main :: IO ()
main = do
progName <- getProgName
args <- getArgs
srcDir <- getDataFileName "example"
files <- getRecursiveContents (const $ return False) srcDir
case args of
-- When the argument begins with hyphens, it's more likely that the user
-- intends to attempt some arguments like ("--help", "-h", "--version", etc.)
-- rather than create directory with that name.
-- If dstDir begins with hyphens, the guard will prevent it from creating
-- directory with that name so we can fall to the second alternative
-- which prints a usage info for user.
[dstDir] | not ("-" `isPrefixOf` dstDir) ->
createFiles False srcDir files dstDir
["-f", dstDir] ->
createFiles True srcDir files dstDir
_ -> do
putStrLn $ "Usage: " ++ progName ++ " [-f] <directory>"
exitFailure
where
createFiles force srcDir files dstDir = do
name <- makeName dstDir
let cabalPath = dstDir </> name ++ ".cabal"
diff <- if force then return []
else existingFiles dstDir (cabalPath : files)
case diff of
[] -> do
forM_ files $ \file -> do
let dst = dstDir </> file
src = srcDir </> file
putStrLn $ "Creating " ++ dst
makeDirectories dst
copyFile src dst
putStrLn $ "Creating " ++ cabalPath
createCabal cabalPath name
fs -> do
putStrLn $ "The following files will be overwritten:"
mapM_ putStrLn fs
putStrLn $ "Use -f to overwrite them"
exitFailure
existingFiles :: FilePath -> [FilePath] -> IO [FilePath]
existingFiles dstDir files = fmap concat $ forM files $ \file -> do
let dst = dstDir </> file
exists <- doesFileExist dst
return $ if exists then [dst] else []
-- | 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 =
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
|
