@@ -18,6 +18,7 @@ import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
1818import Data.Monoid (mappend )
1919import qualified Data.Text as T
2020import Data.Traversable
21+ import Debug.Trace
2122import Hakyll
2223import Lens.Micro (_1 , _2 , _3 )
2324import Lens.Micro.Extras (view )
@@ -68,19 +69,37 @@ main = hakyll $ do
6869 <&> \ ident ->
6970 fromFilePath $ takeDirectory (takeDirectory (toFilePath ident)) </> " index.md"
7071 bread <- breadcrumbField [" index.html" , thisMessage]
72+
7173 pandocCompiler
7274 >>= loadAndApplyTemplate
7375 " templates/example.html"
7476 ( mconcat
7577 [ listField
7678 " files"
7779 ( 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- ]
80+ ( let getName = view _1 . itemBody
81+ nameField = field " name" (pure . getName)
82+
83+ highlightField ident lens = field ident $ \ item -> do
84+ let name = getName item
85+ case view lens $ itemBody item of
86+ Nothing -> pure " <not present>"
87+ Just exampleItem -> do
88+ exampleText <- fmap itemBody $ load $ itemIdentifier exampleItem
89+ let language =
90+ case takeExtension name of
91+ " .hs" -> " haskell"
92+ _ -> " "
93+ pure $ T. unpack $ highlight language $ T. pack $ exampleText
94+
95+ beforeField = highlightField " beforeHighlighted" _2
96+ afterField = highlightField " afterHighlighted" _3
97+ in [ indexlessUrlField " url" ,
98+ nameField,
99+ beforeField,
100+ afterField
101+ ]
102+ )
84103 )
85104 (return files),
86105 defaultContext
0 commit comments