summaryrefslogtreecommitdiff
path: root/src/Hakyll/Init.hs
blob: 71055f09c0605d0563fc7acf4aa8ae5c4abea381 (plain)
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
--------------------------------------------------------------------------------
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, isPrefixOf)
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
        -- 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) -> 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