From eded57b49def0231c9646b2977227b75ae04b51a Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 9 Feb 2017 11:46:55 -0500 Subject: Revert "Move hakyll-init to https://github.com/jaspervdj/hakyll-init" This reverts commit e46adb860c2548db519940a36768482d7b49f0ef. --- src/Hakyll/Init.hs | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 src/Hakyll/Init.hs (limited to 'src/Hakyll/Init.hs') diff --git a/src/Hakyll/Init.hs b/src/Hakyll/Init.hs new file mode 100644 index 0000000..71055f0 --- /dev/null +++ b/src/Hakyll/Init.hs @@ -0,0 +1,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 ++ " " + 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 -- cgit v1.2.3