2021-04-18 15:40:32 +00:00
|
|
|
#!/usr/bin/env runhaskell
|
2021-04-18 10:23:24 +00:00
|
|
|
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Turtle
|
|
|
|
|
|
|
|
import Prelude hiding (FilePath)
|
|
|
|
import qualified Control.Foldl as Fold
|
|
|
|
import Data.Maybe (fromMaybe)
|
|
|
|
import System.Console.ANSI
|
2021-04-18 15:40:32 +00:00
|
|
|
import Turtle.Line (unsafeTextToLine)
|
2021-04-18 10:23:24 +00:00
|
|
|
import Control.Exception (catches,Handler(..))
|
|
|
|
|
|
|
|
main = mainProc `catches` [ Handler handleShellFailed
|
|
|
|
, Handler handleProcFailed
|
|
|
|
]
|
|
|
|
|
|
|
|
handleShellFailed :: ShellFailed -> IO ()
|
|
|
|
handleShellFailed (ShellFailed cmdLine _) = do
|
|
|
|
setSGR [SetColor Foreground Dull Red]
|
2021-04-18 15:40:32 +00:00
|
|
|
echo $ ("[FAILED]: " <> unsafeTextToLine cmdLine)
|
2021-04-18 10:23:24 +00:00
|
|
|
setSGR [Reset]
|
|
|
|
handleProcFailed :: ProcFailed -> IO ()
|
|
|
|
handleProcFailed (ProcFailed procCommand procArgs _) = do
|
|
|
|
setSGR [SetColor Foreground Dull Red]
|
2021-04-18 15:40:32 +00:00
|
|
|
echo $ unsafeTextToLine ("[FAILED]: " <> procCommand <> (mconcat procArgs))
|
2021-04-18 10:23:24 +00:00
|
|
|
setSGR [Reset]
|
|
|
|
|
|
|
|
|
|
|
|
mainProc :: IO ()
|
|
|
|
mainProc = do
|
|
|
|
-- So we can't have access to $0 in Haskell via stack.
|
|
|
|
-- Too bad.
|
|
|
|
-- So instead, I'll check I'm in the right directory.
|
|
|
|
debug "Checking directory"
|
2021-04-18 15:40:32 +00:00
|
|
|
pubdir <- checkDir
|
2021-04-18 10:23:24 +00:00
|
|
|
debug "Retrieving revision number"
|
|
|
|
rev <- fold (inshell "git rev-parse --short HEAD" empty) Fold.head
|
|
|
|
debug ("Revision number retrieved: " <> fromMaybe "unknow" rev)
|
2021-04-18 15:40:32 +00:00
|
|
|
debug $ unsafeTextToLine $ "cd " <> (format fp pubdir)
|
2021-04-18 10:23:24 +00:00
|
|
|
cd pubdir
|
2021-04-18 15:40:32 +00:00
|
|
|
pwd >>= echo . unsafeTextToLine . format fp
|
2021-04-18 10:23:24 +00:00
|
|
|
dshells "git init ."
|
|
|
|
dshell ("git remote add upstream " <> mainRepository)
|
|
|
|
dshells "git fetch upstream"
|
|
|
|
dshells "git reset upstream/gh-pages"
|
|
|
|
dshells "git add -A ."
|
|
|
|
echo "Commit and publish"
|
2021-04-18 15:40:32 +00:00
|
|
|
dshells ("git commit -m \"publishing at rev " <> lineToText (fromMaybe "unknow" rev) <> "\"")
|
2021-04-18 10:23:24 +00:00
|
|
|
echo "Don't `git push` this time"
|
|
|
|
dshells "git push -q upstream HEAD:gh-pages"
|
|
|
|
|
|
|
|
debug txt = do
|
|
|
|
setSGR [SetColor Foreground Dull Yellow]
|
|
|
|
echo txt
|
|
|
|
setSGR [Reset]
|
|
|
|
|
|
|
|
dshells x = do
|
2021-04-18 15:40:32 +00:00
|
|
|
debug $ unsafeTextToLine x
|
2021-04-18 10:23:24 +00:00
|
|
|
shells x empty
|
|
|
|
|
|
|
|
dshell x = do
|
2021-04-18 15:40:32 +00:00
|
|
|
debug $ unsafeTextToLine x
|
2021-04-18 10:23:24 +00:00
|
|
|
shell x empty
|
|
|
|
|
2021-04-18 15:40:32 +00:00
|
|
|
checkDir :: IO FilePath
|
2021-04-18 10:23:24 +00:00
|
|
|
checkDir = do
|
2021-04-18 15:40:32 +00:00
|
|
|
toolsExists <- testdir "engine"
|
2021-04-18 10:23:24 +00:00
|
|
|
if (not toolsExists)
|
|
|
|
then exit (ExitFailure 1)
|
2021-05-06 22:21:41 +00:00
|
|
|
else return "_site"
|
2021-04-18 10:23:24 +00:00
|
|
|
|
|
|
|
mainRepository = "git@github.com:yogsototh/yannesposito.com.git"
|
|
|
|
|
|
|
|
cloneIfNeeded :: FilePath -> IO ()
|
|
|
|
cloneIfNeeded pubdir = do
|
|
|
|
contentExists <- testdir pubdir
|
|
|
|
when (not contentExists) $
|
|
|
|
procs "git"
|
|
|
|
[ "clone"
|
|
|
|
, "-b", "gh-pages"
|
|
|
|
, mainRepository
|
|
|
|
, format fp pubdir]
|
|
|
|
empty
|