git.iko.soy/hakyll
on v4.12.5.2 help sign in
hakyll/src/Init.hs
123 lines 4.7 kB history raw
1--------------------------------------------------------------------------------
2module Main
3 ( main
4 ) where
7--------------------------------------------------------------------------------
8import Control.Arrow (first)
9import Control.Monad (forM, forM_)
10import Data.Char (isAlphaNum, isNumber)
11import Data.List (foldl', intercalate, isPrefixOf)
12import Data.Version (Version (..))
13import System.Directory (canonicalizePath, copyFile,
14 doesFileExist)
15import System.Environment (getArgs, getProgName)
16import System.Exit (exitFailure)
17import System.FilePath (splitDirectories, (</>))
20--------------------------------------------------------------------------------
21import Hakyll.Core.Util.File
22import Paths_hakyll
25--------------------------------------------------------------------------------
26import Prelude
29--------------------------------------------------------------------------------
30main :: IO ()
31main = do
32 progName <- getProgName
33 args <- getArgs
34 srcDir <- getDataFileName "example"
35 files <- getRecursiveContents (const $ return False) srcDir
37 case args of
38 -- When the argument begins with hyphens, it's more likely that the user
39 -- intends to attempt some arguments like ("--help", "-h", "--version", etc.)
40 -- rather than create directory with that name.
41 -- If dstDir begins with hyphens, the guard will prevent it from creating
42 -- directory with that name so we can fall to the second alternative
43 -- which prints a usage info for user.
44 [dstDir] | not ("-" `isPrefixOf` dstDir) ->
45 createFiles False srcDir files dstDir
46 ["-f", dstDir] ->
47 createFiles True srcDir files dstDir
48 _ -> do
49 putStrLn $ "Usage: " ++ progName ++ "[-f] <directory>"
50 exitFailure
52 where
53 createFiles force srcDir files dstDir = do
54 name <- makeName dstDir
55 let cabalPath = dstDir </> name ++ ".cabal"
57 diff <- if force then return []
58 else existingFiles dstDir (cabalPath : files)
60 case diff of
61 [] -> do
62 forM_ files $ \file -> do
63 let dst = dstDir </> file
64 src = srcDir </> file
65 putStrLn $ "Creating " ++ dst
66 makeDirectories dst
67 copyFile src dst
69 putStrLn $ "Creating " ++ cabalPath
70 createCabal cabalPath name
71 fs -> do
72 putStrLn $ "The following files will be overwritten:"
73 mapM_ putStrLn fs
74 putStrLn $ "Use -f to overwrite them"
75 exitFailure
77existingFiles :: FilePath -> [FilePath] -> IO [FilePath]
78existingFiles dstDir files = fmap concat $ forM files $ \file -> do
79 let dst = dstDir </> file
80 exists <- doesFileExist dst
81 return $ if exists then [dst] else []
83-- | Figure out a good cabal package name from the given (existing) directory
84-- name
85makeName :: FilePath -> IO String
86makeName dstDir = do
87 canonical <- canonicalizePath dstDir
88 return $ case safeLast (splitDirectories canonical) of
89 Nothing -> fallbackName
90 Just "/" -> fallbackName
91 Just x -> repair (fallbackName ++) id x
92 where
93 -- Package name repair code comes from
94 -- cabal-install.Distribution.Client.Init.Heuristics
95 repair invalid valid x = case dropWhile (not . isAlphaNum) x of
96 "" -> repairComponent ""
97 x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'
98 in c ++ repairRest r
99 where repairComponent c | all isNumber c = invalid c
100 | otherwise = valid c
101 repairRest = repair id ('-' :)
102 fallbackName = "site"
104 safeLast = foldl' (\_ x -> Just x) Nothing
106createCabal :: FilePath -> String -> IO ()
107createCabal path name =
108 writeFile path $ unlines [
109 "name: " ++ name
110 , "version: 0.1.0.0"
111 , "build-type: Simple"
112 , "cabal-version: >= 1.10"
113 , ""
114 , "executable site"
115 , " main-is: site.hs"
116 , " build-depends: base == 4.*"
117 , " , hakyll == " ++ version' ++ ".*"
118 , " ghc-options: -threaded"
119 , " default-language: Haskell2010"
120 ]
121 where
122 -- Major hakyll version
123 version' = intercalate "." . take 2 . map show $ versionBranch version