{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans
-fno-warn-missing-signatures
-fno-warn-missing-methods
-fno-warn-duplicate-exports
-fno-warn-unused-imports
-fno-warn-unused-matches #-}
module ShakeBake.StartDainoProcess (dainoProcess) where
import ShakeBake.ReadSettingFile (readSettings)
import ShakeBake.Shake2 (shakeAll)
import ShakeBake.Watch (mainWatch)
import Uniform.WebServer (runScotty)
import Foundational.SettingsPage
import Foundational.CmdLineFlags
import Paths_daino
import UniformBase
import qualified Path.Posix as Path
import qualified System.FilePath.Posix as P
import Path.IO (resolveDir, getHomeDir, createDirLink, getSymlinkTarget, removeDirLink)
dainoProcess :: NoticeLevel -> PubFlags -> ErrIO ()
dainoProcess :: NoticeLevel -> PubFlags -> ErrIO ()
dainoProcess NoticeLevel
debug PubFlags
flags = do
let useTestSite :: Bool
useTestSite = (PubFlags -> Bool
testFlag PubFlags
flags Bool -> Bool -> Bool
|| PubFlags -> Bool
testNewFlag PubFlags
flags)
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 1 useTestSite", forall {a}. Show a => a -> Text
showT Bool
useTestSite]
Path Abs Dir
currDir :: Path Abs Dir <- ErrIO (Path Abs Dir)
currentDir
let Path Rel File
relSettingsFile :: Path Rel File = FilePath -> Path Rel File
makeRelFile FilePath
"settings3.yaml"
Path Abs Dir
sett4dir <- if Bool
useTestSite
then do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 2test useTestSite"]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall b t. Path b t -> Path b Dir
Path.parent Path Abs Dir
currDir) forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> FilePath -> Path Rel Dir
makeRelDir FilePath
"dainoSite"
else if (FilePath -> Bool
P.isAbsolute (PubFlags -> FilePath
locationDir PubFlags
flags))
then do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 2test location abs dir", forall {a}. Show a => a -> Text
showT (PubFlags -> FilePath
locationDir PubFlags
flags)]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FilePath -> Path Abs Dir
makeAbsDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubFlags -> FilePath
locationDir forall a b. (a -> b) -> a -> b
$ PubFlags
flags)
else if (FilePath -> Bool
P.isRelative (PubFlags -> FilePath
locationDir PubFlags
flags))
then do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 5 location relative", forall {a}. Show a => a -> Text
showT (PubFlags -> FilePath
locationDir PubFlags
flags)]
Path Abs Dir
absdir <- forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
resolveDir Path Abs Dir
currDir (PubFlags -> FilePath
locationDir PubFlags
flags)
forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs Dir
absdir
else
forall a. [Text] -> a
errorT [Text
"dainoProcess 5 location not valid", forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ PubFlags -> FilePath
locationDir PubFlags
flags]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 5 dir of settings file", forall {a}. Show a => a -> Text
showT Path Abs Dir
sett4dir]
let sett4file :: FileResultT (Path Abs Dir) (Path Rel File)
sett4file = Path Abs Dir
sett4dir forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
relSettingsFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 5 settings file", forall {a}. Show a => a -> Text
showT FileResultT (Path Abs Dir) (Path Rel File)
sett4file]
Bool
existSett <- forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' (FileResultT (Path Abs Dir) (Path Rel File)
sett4file)
Settings
sett4 <- if Bool
existSett
then NoticeLevel -> Path Abs File -> ErrIO Settings
readSettings NoticeLevel
debug FileResultT (Path Abs Dir) (Path Rel File)
sett4file
else forall a. [Text] -> a
errorT [Text
"dainoProcess 1", Text
"error settingsFile not present in"
, forall {a}. Show a => a -> Text
showT FileResultT (Path Abs Dir) (Path Rel File)
sett4file
, Text
"perhaps need install dainoSite with `git clone git@github.com:andrewufrank/dainoSite.git"]
let themeDir1 :: Path Abs Dir
themeDir1 = SiteLayout -> Path Abs Dir
themeDir (Settings -> SiteLayout
siteLayout Settings
sett4) :: Path Abs Dir
let doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir (Settings -> SiteLayout
siteLayout Settings
sett4) :: Path Abs Dir
Bool
doughExist <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' Path Abs Dir
doughP
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doughExist forall a b. (a -> b) -> a -> b
$
forall a. [Text] -> a
errorT [Text
"dainoProcess 2", Text
"error dough not present", Text
"install dainoSite with `git clone git@github.com:andrewufrank/dainoSite.git"]
let link1 :: Path Abs Dir
link1 = Path Abs Dir
doughP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> (FilePath -> Path Rel Dir
makeRelDir FilePath
resourcesName) forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> (FilePath -> Path Rel Dir
makeRelDir FilePath
themeName) :: Path Abs Dir
let target1 :: Path Abs Dir
target1 = Path Abs Dir
themeDir1 :: Path Abs Dir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 3 check simlink \n target ", forall {a}. Show a => a -> Text
showT Path Abs Dir
target1
, Text
"\n linked to", forall {a}. Show a => a -> Text
showT Path Abs Dir
link1]
Bool
linkExists <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' Path Abs Dir
link1
Bool
targetOK <- if Bool
linkExists
then do
FilePath
targetNow <- forall (m :: * -> *) b t. MonadIO m => Path b t -> m FilePath
getSymlinkTarget Path Abs Dir
link1
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 5 current \n target for theme ", forall {a}. Show a => a -> Text
showT FilePath
targetNow]
if (FilePath -> Path Abs Dir
makeAbsDir FilePath
targetNow) forall a. Eq a => a -> a -> Bool
== Path Abs Dir
target1 then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirLink Path Abs Dir
link1
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess remove previous link"]
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
targetOK forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess 4 create simlink \n target ", forall {a}. Show a => a -> Text
showT Path Abs Dir
target1
, Text
"\n linked to", forall {a}. Show a => a -> Text
showT Path Abs Dir
link1]
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 Dir -> Path b1 Dir -> m ()
createDirLink ( Path Abs Dir
target1) ( Path Abs Dir
link1)
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"\n dainoProcess"
, Text
"currDir is doughP", forall {a}. Show a => a -> Text
showT Path Abs Dir
currDir
]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"\ndainoProcess starts baking with"
, Text
"siteLayout" , forall {a}. Show a => a -> Text
showT (Settings -> SiteLayout
siteLayout Settings
sett4)
]
Path Abs Dir -> ErrIO ()
setCurrentDir Path Abs Dir
doughP
if PubFlags -> Bool
watchFlag PubFlags
flags
then NoticeLevel -> Settings -> PubFlags -> ErrIO ()
mainWatch NoticeLevel
debug Settings
sett4 PubFlags
flags
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PubFlags -> Bool
testNewFlag PubFlags
flags) forall a b. (a -> b) -> a -> b
$ do
let bakedP :: Path Abs Dir
bakedP = SiteLayout -> Path Abs Dir
bakedDir (Settings -> SiteLayout
siteLayout Settings
sett4)
forall fp. DirOps fp => fp -> ErrIO ()
deleteDirRecursive Path Abs Dir
bakedP
NoticeLevel -> Settings -> PubFlags -> FilePath -> ErrIO ()
shakeAll NoticeLevel
debug Settings
sett4 PubFlags
flags FilePath
""
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PubFlags -> Bool
serverFlag PubFlags
flags) forall a b. (a -> b) -> a -> b
$ do
Int -> Path Abs Dir -> Path Rel File -> ErrIO ()
runScotty (Settings -> Int
localhostPort Settings
sett4)
(SiteLayout -> Path Abs Dir
bakedDir (Settings -> SiteLayout
siteLayout Settings
sett4))
(FilePath -> Path Rel File
makeRelFile FilePath
"index.html")
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"server started on "
, forall {a}. Show a => a -> Text
showT (Settings -> Int
localhostPort Settings
sett4)]
Path Abs Dir -> ErrIO ()
setCurrentDir Path Abs Dir
currDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess", Text
"again currDir as before", forall {a}. Show a => a -> Text
showT Path Abs Dir
currDir, Text
"\nwas doughP", forall {a}. Show a => a -> Text
showT Path Abs Dir
doughP]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"dainoProcess done"]
forall (m :: * -> *) a. Monad m => a -> m a
return ()