module Stagen.Build where import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import qualified Data.ByteString.Lazy as BL import qualified Data.List as L import Control.Arrow import Control.Monad (void) import System.FilePath.Find import Data.Monoid import Data.Maybe import Lucid import Stagen.Opts import Stagen.Date import Stagen.Template import Stagen.Page import Stagen.Job import Stagen.AtomFeed (createAtomFeed) import Stagen.RssFeed (createRssFeed) import Stagen.JsonFeed (createJsonFeed) import Stagen.File runBuild :: Opts -> IO () runBuild opts@Opts{..} = do tpl <- mkTemplate opts let ignore = optsIgnore ++ catMaybes [optsHeader, optsFooter, optsArchive] files <- find (pure True) (eligable ignore) optsTargetDirectory htmlPathAndPages <- sequence $ map (fromMarkdown optsVerbose optsBaseUrl) files let archive = archiveJob optsVerbose tpl optsBaseUrl htmlPathAndPages optsArchive let pageAndHtmlPaths = map (\(page, path) -> (path, page)) htmlPathAndPages let feedPages = reverse (map snd htmlPathAndPages) let atomFeed = fromMaybe (return ()) $ fmap writeAtomXml $ createAtomFeed optsTitle optsBaseUrl feedPages let rssFeed = fromMaybe (return ()) $ fmap writeRssXml $ createRssFeed optsTitle optsBaseUrl feedPages let jsonFeed = writeFeedJson $ createJsonFeed optsTitle optsBaseUrl feedPages let jobs = archive : atomFeed : rssFeed : jsonFeed : map (uncurry (writePage tpl)) pageAndHtmlPaths void $ runJobs optsJobs jobs build :: Template -> Page -> TL.Text build Template{..} Page{..} = renderText $ doctypehtml_ $ do head_ $ do void $ title_ (toHtmlRaw pageTitle) mapM_ (\href -> link_ [rel_ "stylesheet", type_ "text/css", href_ href]) (map TL.toStrict tplStyleSheets) mapM_ (\src -> termWith "script" [src_ src] "") (map TL.toStrict tplScripts) mapM_ (\href -> link_ [rel_ "icon", type_ "image/png", href_ href]) tplFavicon body_ . div_ [id_ "wrapper"] $ do div_ [id_ "header"] (try tplHeader) div_ [id_ "content"] (toHtmlRaw pageContent) div_ [id_ "footer"] (try tplFooter) where try = toHtmlRaw . fromMaybe TL.empty archiveJob :: Verbose -> Template -> FilePath -> [(FilePath, Page)] -> Maybe FilePath -> IO () archiveJob verbose tpl baseUrl htmlPathAndPages mMdPath = fromMaybe (return ()) $ do mdPath <- mMdPath return $ do (htmlPath, page) <- fromMarkdown verbose baseUrl mdPath writePage tpl (addArchiveEntries baseUrl mdPath page htmlPathAndPages) htmlPath writePageFromMarkdown :: Verbose -> Template -> FilePath -> FilePath -> IO () writePageFromMarkdown verbose tpl baseUrl mdPath = do (htmlPath, page) <- fromMarkdown verbose baseUrl mdPath writePage tpl page htmlPath writePage :: Template -> Page -> FilePath -> IO () writePage tpl page htmlPath = TL.writeFile htmlPath (build tpl page) writeAtomXml :: TL.Text -> IO () writeAtomXml = TL.writeFile "atom.xml" writeRssXml :: TL.Text -> IO () writeRssXml = TL.writeFile "rss.xml" writeFeedJson :: BL.ByteString -> IO () writeFeedJson = BL.writeFile "feed.json" addArchiveEntries :: FilePath -> FilePath -> Page -> [(FilePath, Page)] -> Page addArchiveEntries baseUrl archivePath page htmlPathAndPages = let pathAndTitles = map (second pageTitle) htmlPathAndPages sorter = L.sortBy (\(_,_,a) (_,_,b)-> compare b a) content = (pageContent page) <> (toLinks . sorter . getEntries) pathAndTitles in Page{pageTitle = pageTitle page, pageContent = content, pageDate = Nothing, pageAbsoluteUrl = absoluteUrl baseUrl archivePath } where getEntries :: [(FilePath, TL.Text)] -> [(FilePath, TL.Text, Date)] getEntries = catMaybes . map (\(f,t) -> fmap (f,t,) (parseMay datePrefix (baseName f))) toLinks :: [(FilePath, TL.Text, Date)] -> TL.Text toLinks = renderText . ul_ . toHtmlRaw . TL.concat . map toLink toLink :: (FilePath, TL.Text, Date) -> TL.Text toLink (path, title, date) = renderText (li_ (a_ [href_ (T.pack path)] (toHtmlRaw $ displayDate date <> " <span id=\"title\">" <> title <> "</span>"))) displayDate :: Date -> TL.Text displayDate Date{..} = TL.concat [ TL.pack (show dateYear) , "-" , TL.pack (showTwoDigits dateMonth) , "-" , TL.pack (showTwoDigits dateDay) ] mkTemplate :: Opts -> IO Template mkTemplate Opts{..} = do let tplStyleSheets = map TL.pack optsStyleSheets let tplScripts = map TL.pack optsScripts let tplFavicon = T.pack <$> optsFavicon tplHeader <- go optsHeader tplFooter <- go optsFooter return Template{..} where go Nothing = return Nothing go (Just path) = Just <$> render <$> TL.readFile path