@@ -25,6 +25,8 @@ import System.FilePath
25
25
import qualified Text.Pandoc as Pandoc
26
26
import qualified Text.Pandoc.Definition as Pandoc
27
27
28
+ import Debug.Trace
29
+
28
30
main :: IO ()
29
31
main = hakyll $ do
30
32
-- Necessary to have GitHub Pages point at the right domain
@@ -68,19 +70,48 @@ main = hakyll $ do
68
70
<&> \ ident ->
69
71
fromFilePath $ takeDirectory (takeDirectory (toFilePath ident)) </> " index.md"
70
72
bread <- breadcrumbField [" index.html" , thisMessage]
73
+
71
74
pandocCompiler
72
75
>>= loadAndApplyTemplate
73
76
" templates/example.html"
74
77
( mconcat
75
78
[ listField
76
79
" files"
77
80
( mconcat
78
- [ indexlessUrlField " url" ,
79
- field " name" (pure . view _1 . itemBody),
80
- -- TODO: pick the right language
81
- field " beforeHighlighted" (maybe (pure " <not present>" ) (fmap (T. unpack . highlight " haskell" . T. pack) . fmap itemBody . load . itemIdentifier) . view _2 . itemBody),
82
- field " afterHighlighted" (maybe (pure " <not present>" ) (fmap (T. unpack . highlight " haskell" . T. pack) . fmap itemBody . load . itemIdentifier) . view _3 . itemBody)
83
- ]
81
+ (
82
+ let getName = view _1 . itemBody
83
+ nameField = field " name" (pure . getName)
84
+ beforeField =
85
+ field " beforeHighlighted" $ \ item -> do
86
+ let name = getName item
87
+ case view _2 $ itemBody item of
88
+ Nothing -> pure " <not present>"
89
+ Just beforeItem -> do
90
+ beforeText <- fmap itemBody $ load $ itemIdentifier beforeItem
91
+ let language =
92
+ case takeExtension name of
93
+ " .hs" -> " haskell"
94
+ _ -> " "
95
+ pure $ T. unpack $ highlight language $ T. pack $ beforeText
96
+ afterField =
97
+ field " afterHighlighted" $ \ item -> do
98
+ let name = getName item
99
+ case view _2 $ itemBody item of
100
+ Nothing -> pure " <not present>"
101
+ Just afterItem -> do
102
+ afterText <- fmap itemBody $ load $ itemIdentifier afterItem
103
+ let language =
104
+ case takeExtension name of
105
+ " .hs" -> " haskell"
106
+ _ -> " "
107
+ pure $ T. unpack $ highlight language $ T. pack $ afterText
108
+ in
109
+
110
+ [ indexlessUrlField " url" ,
111
+ nameField,
112
+ beforeField,
113
+ afterField
114
+ ])
84
115
)
85
116
(return files),
86
117
defaultContext
0 commit comments