2012-12-05 22:29:42 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
module Main
|
|
|
|
( main
|
|
|
|
) where
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2014-06-13 09:52:08 +00:00
|
|
|
import Control.Arrow (first)
|
2012-12-06 12:41:16 +00:00
|
|
|
import Control.Monad (forM_)
|
2014-06-13 09:52:08 +00:00
|
|
|
import Data.Char (isAlphaNum, isNumber)
|
|
|
|
import Data.List (intercalate)
|
|
|
|
import Data.Version (Version(..))
|
|
|
|
import System.Directory (copyFile, canonicalizePath)
|
2012-12-06 12:41:16 +00:00
|
|
|
import System.Environment (getArgs, getProgName)
|
|
|
|
import System.Exit (exitFailure)
|
2014-06-13 09:52:08 +00:00
|
|
|
import System.FilePath ((</>), splitDirectories)
|
2012-12-05 22:29:42 +00:00
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Hakyll.Core.Util.File
|
|
|
|
import Paths_hakyll
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
2012-12-06 12:41:16 +00:00
|
|
|
progName <- getProgName
|
|
|
|
args <- getArgs
|
|
|
|
srcDir <- getDataFileName "example"
|
2013-04-03 10:02:06 +00:00
|
|
|
files <- getRecursiveContents (const $ return False) srcDir
|
2012-12-06 12:41:16 +00:00
|
|
|
|
|
|
|
case args of
|
2014-06-13 09:52:08 +00:00
|
|
|
[dstDir] -> do
|
|
|
|
forM_ files $ \file -> do
|
|
|
|
let dst = dstDir </> file
|
|
|
|
src = srcDir </> file
|
|
|
|
putStrLn $ "Creating " ++ dst
|
|
|
|
makeDirectories dst
|
|
|
|
copyFile src dst
|
|
|
|
-- canonicalizePath is safe because the destination
|
|
|
|
-- directory should exist at this point
|
|
|
|
canonicalizePath dstDir >>= createCabal
|
2012-12-06 12:41:16 +00:00
|
|
|
_ -> do
|
|
|
|
putStrLn $ "Usage: " ++ progName ++ " <directory>"
|
|
|
|
exitFailure
|
2014-06-13 09:52:08 +00:00
|
|
|
|
|
|
|
|
|
|
|
createCabal :: FilePath -> IO ()
|
|
|
|
createCabal dstDir = do
|
|
|
|
putStrLn $ "Creating " ++ name ++ ".cabal"
|
|
|
|
writeFile (dstDir </> name ++ ".cabal") $ 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
|
|
|
|
-- last is safe here as the path is canonicalised and "/" is just
|
|
|
|
-- a very rare but possible corner case
|
|
|
|
name = case last (splitDirectories dstDir) of
|
|
|
|
"/" -> fallbackName
|
|
|
|
x -> repair (fallbackName ++) id x
|
|
|
|
-- 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"
|