yogsototh/her.esy.fun
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

starting to work

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2020-06-22 11:44:11 +02:00
parent 1eb4a6de5a
commit e3a33d9ecf
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
1 changed files with 83 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

142
Shakefile.hs
View file

@ -1,83 +1,107 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
import Protolude hiding ((*>)) import Protolude
import Development.Shake import Development.Shake
import Development.Shake.Command import Development.Shake.Command
import Development.Shake.FilePath import Development.Shake.FilePath
import Development.Shake.Util import Development.Shake.Util
import Data.Default (Default(def)) import Control.Monad.Fail
import qualified Data.Set as Set import Data.Default ( Default(def) )
import qualified Data.Text as T import qualified Data.Set as Set
import Text.Pandoc.Class (PandocPure,PandocMonad) import qualified Data.Text as T
import qualified Text.Pandoc.Class as Pandoc import Text.Pandoc.Class ( PandocPure
import Text.Pandoc.Definition (Pandoc(..),Block(..),Inline,nullMeta,docTitle,docDate,docAuthors) , PandocMonad
import Text.Pandoc.Extensions (getDefaultExtensions) )
import Text.Pandoc.Options (ReaderOptions(..),TrackChanges(RejectChanges)) import qualified Text.Pandoc.Class as Pandoc
import qualified Text.Pandoc.Readers as Readers import Text.Pandoc.Definition ( Pandoc(..)
import qualified Text.Pandoc.Writers as Writers , Block(..)
, Inline
, nullMeta
, docTitle
, docDate
, docAuthors
)
import Text.Pandoc.Extensions ( getDefaultExtensions )
import Text.Pandoc.Options ( ReaderOptions(..)
, TrackChanges(RejectChanges)
)
import qualified Text.Pandoc.Readers as Readers
import qualified Text.Pandoc.Writers as Writers
main :: IO () main :: IO ()
main = do main = do
let shOpts = shakeOptions { shakeVerbosity = Chatty, shakeLintInside = ["\\"] } let
shakeArgs shOpts buildRules shOpts = shakeOptions { shakeVerbosity = Chatty
, shakeLintInside = ["\\"]
}
shakeArgs shOpts buildRules
data BlogPost = data BlogPost =
BlogPost { postTitle :: T.Text BlogPost { postTitle :: T.Text
, postDate :: T.Text , postDate :: T.Text
, postAuthors :: [T.Text] , postAuthors :: [T.Text]
, postUrl :: FilePath , postUrl :: FilePath
, postP :: Pandoc , postBody :: Pandoc
} }
inlineToText :: PandocMonad m => [Inline] -> m T.Text inlineToText :: PandocMonad m => [Inline] -> m T.Text
inlineToText inline = inlineToText inline =
Writers.writeAsciiDoc def (Pandoc nullMeta [Plain inline]) Writers.writeAsciiDoc def (Pandoc nullMeta [Plain inline])
getBlogpostFromMetas
:: (MonadIO m, MonadFail m) => [Char] -> Pandoc -> m BlogPost
getBlogpostFromMetas path pandoc@(Pandoc meta _) = do
eitherBlogpost <- liftIO $ Pandoc.runIO $ do
title <- inlineToText $ docTitle meta
date <- inlineToText $ docDate meta
authors <- mapM inlineToText $ docAuthors meta
-- let url = dropExtension path
return $ BlogPost title date authors path pandoc
case eitherBlogpost of
Left _ -> fail "BAD"
Right bp -> return bp
sortByPostDate :: [BlogPost] -> [BlogPost]
sortByPostDate =
sortBy (\a b -> compare (Down (postDate a)) (Down (postDate b)))
buildRules :: Rules () buildRules :: Rules ()
buildRules = do buildRules = do
let let siteDir = "_site"
siteDir = "_site" optimDir = "_optim"
optimDir = "_optim" build = (</>) siteDir
build = (</>) siteDir phony "clean" $ do
phony "clean" $ do putInfo "Cleaning files in _site and _optim"
putInfo "Cleaning files in _site and _optim" removeFilesAfter siteDir ["//*"]
removeFilesAfter siteDir ["//*"] removeFilesAfter optimDir ["//*"]
removeFilesAfter optimDir ["//*"] getPost <- newCache $ \path -> do
getPost <- newCache $ \path -> do fileContent <- readFile' path
fileContent <- readFile' path eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg def (T.pack fileContent) def
case eitherResult of (T.pack fileContent)
Left _ -> liftIO $ putText "Problem" case eitherResult of
Right pandoc@(Pandoc meta _) -> liftIO $ Pandoc.runIO $ do Left _ -> fail "BAD"
title <- inlineToText $ docTitle meta Right pandoc -> getBlogpostFromMetas path pandoc
date <- inlineToText $ docDate meta getPosts <-
authors <- map inlineToText $ docAuthors meta newCache
let url = dropExtension path $ \() -> mapM getPost =<< getDirectoryFiles
return $ BlogPost title date authors url pandoc ""
getPosts <- newCache $ \() -> ["src/posts//*.org"]
mapM getPost =<< getDirectoryFiles "" ["src/posts//*.org"] let -- hsDeps = return ["AsciiArt.hs", "Index.hs", "Rot13.hs"]
let hsDeps = return ["AsciiArt.hs", "Index.hs", "Rot13.hs"] cssDeps = map (siteDir </>)
cssDeps = map (siteDir </>) <$> getDirectoryFiles "" ["src/css/*.css"] <$> getDirectoryFiles "" ["src/css/*.css"]
build "index.html" *> \out -> do build "index.html" %> \out -> do
hs <- hsDeps -- hs <- hsDeps
css <- cssDeps css <- cssDeps
posts <- getPosts () posts <- getPosts ()
need $ hs need $ css <> map postUrl posts
<> css -- <> [build "atom.xml"]
<> map ( combine "build" let titles = map postTitle posts
. flip combine "index.html" writeFile' out (mconcat (map T.unpack titles))
. postUrl ) posts build "src/css/*.css" %> \out -> copyFile' (dropDirectory1 out) out
<> [build "atom.xml"]
writeFile' out
. renderHtml . index ""
. sortBy (\a b ->
compare (Down (postDate a)) (Down (postDate b)))
$ posts
build "src/css/*.css" *> \out ->
copyFile' (dropDirectory1 out) out
-- "_site//*.html" %> buildPost -- "_site//*.html" %> buildPost