1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (unless, when)
import Control.Monad.IO.Class
import Control.Monad.Trans.State.Lazy
import Data.Default (def)
import Data.Foldable (traverse_)
import Data.List.Extra (stripSuffix)
import qualified Data.Map as M
import Data.Maybe (isJust)
import qualified Data.Text as T
import qualified Data.Text.Encoding
import qualified Data.Text.IO as TIO
import qualified Data.Yaml as Y
import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories)
import Lens.Micro
import Lens.Micro.Aeson
import Lens.Micro.Mtl
import Lens.Micro.TH
import System.Environment (getArgs)
import System.FilePath ((</>), splitPath)
import Text.Pandoc.Class (runIOorExplode)
import qualified Text.Pandoc.Definition
import qualified Text.Pandoc.Extensions
import Text.Pandoc.Options (ReaderOptions(..))
import Text.Pandoc.Readers.Markdown (readMarkdown)
import Debug.Trace
io :: MonadIO m => IO a -> m a
io = liftIO
just _ (Just val) = val
just err Nothing = error ("Missing: " ++ err)
data SiteState =
SiteState
{ _pages :: M.Map FilePath ( FilePath
, Y.Value
, Text.Pandoc.Definition.Pandoc -- loc -> (source, meta, markdown)
)
, _redirects :: M.Map FilePath FilePath -- from -> to
, _htags :: M.Map [String] [FilePath] -- tag sequence -> tagged locs
, _installs :: M.Map FilePath FilePath -- file hash -> install location
, _templates :: M.Map FilePath () -- TODO mustache templates
, _outputDir :: FilePath
}
deriving (Show)
makeLenses ''SiteState
emptySiteState out =
SiteState
{ _pages = M.empty
, _redirects = M.empty
, _htags = M.empty
, _installs = M.empty
, _templates = M.empty
, _outputDir = out
}
type Site a = StateT SiteState IO a
hasSuffix s = isJust . stripSuffix s
sourcePages :: FilePath -> Site ()
sourcePages fp = do
links <-
io $ filter (hasSuffix ".md" . last . splitPath) <$>
getRecursiveContents (pure . const False) fp
traverse_ loadPage (map (fp </>) links)
markdownReadOpts =
def
{ readerExtensions =
Text.Pandoc.Extensions.enableExtension
Text.Pandoc.Extensions.Ext_smart
Text.Pandoc.Extensions.pandocExtensions
}
loadPage :: FilePath -> Site ()
loadPage fp = do
txt <- io $ TIO.readFile fp
(T.take 4 txt == "---\n") `unless`
error ("metadata block start missing in " ++ fp)
let (meta, markdown) = T.breakOn "\n---\n" (T.drop 4 txt)
T.null meta `when` error ("metadata block bad in " ++ fp)
yml <- Y.decodeThrow $ Data.Text.Encoding.encodeUtf8 meta
md <- io $ runIOorExplode $ readMarkdown markdownReadOpts (T.drop 5 markdown)
let mount =
T.unpack . just ("mount point of " ++ fp) $ yml ^? key "title" . _String
pages %= M.insert mount (fp, yml, md)
sourceTemplates :: FilePath -> Site ()
sourceTemplates _ = pure ()
installPage :: FilePath -> Site ()
installPage = undefined
installFile :: FilePath -> Site FilePath
installFile = undefined
makeRedirect :: FilePath -> FilePath -> Site ()
makeRedirect = undefined
makeRedirects :: Site ()
makeRedirects = undefined
renderTag :: [String] -> Site ()
renderTag = undefined
renderTags :: Site ()
renderTags = undefined
main = do
[targetDir] <- getArgs
flip runStateT (emptySiteState targetDir) $ do
traverse sourceTemplates ["templates"]
traverse sourcePages ["external"]
get >>= io . print
|
