remove the old executable
This commit is contained in:
		
							parent
							
								
									5f0b66e363
								
							
						
					
					
						commit
						a1a3f0640b
					
				
							
								
								
									
										108
									
								
								oldsite.hs
									
									
									
									
									
								
							
							
						
						
									
										108
									
								
								oldsite.hs
									
									
									
									
									
								
							| 
						 | 
					@ -1,108 +0,0 @@
 | 
				
			||||||
{-# LANGUAGE OverloadedStrings #-}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
import Hakyll
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
import Control.Monad ((>=>), when)
 | 
					 | 
				
			||||||
import Data.Foldable (traverse_)
 | 
					 | 
				
			||||||
import Data.List (inits, nub)
 | 
					 | 
				
			||||||
import Data.List.Extra (groupSort)
 | 
					 | 
				
			||||||
import Data.Maybe (fromMaybe)
 | 
					 | 
				
			||||||
import System.FilePath
 | 
					 | 
				
			||||||
  ( (</>)
 | 
					 | 
				
			||||||
  , dropTrailingPathSeparator
 | 
					 | 
				
			||||||
  , joinPath
 | 
					 | 
				
			||||||
  , normalise
 | 
					 | 
				
			||||||
  , splitDirectories
 | 
					 | 
				
			||||||
  )
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
import Debug.Trace
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
getMount' :: a -> (String -> a) -> Metadata -> a
 | 
					 | 
				
			||||||
getMount' a b = maybe a b . lookupString "mount"
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
getMount :: Metadata -> Routes
 | 
					 | 
				
			||||||
getMount = getMount' idRoute constRoute
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
indexInDir :: Routes -> Routes
 | 
					 | 
				
			||||||
indexInDir = flip composeRoutes . customRoute $ (</> "index.html") . toFilePath
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
makePage :: Rules ()
 | 
					 | 
				
			||||||
makePage = do
 | 
					 | 
				
			||||||
  route $ indexInDir (metadataRoute getMount)
 | 
					 | 
				
			||||||
  compile $
 | 
					 | 
				
			||||||
    pandocCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx >>=
 | 
					 | 
				
			||||||
    loadAndApplyTemplate "templates/default.html" pageCtx >>=
 | 
					 | 
				
			||||||
    relativizeUrls
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
extractRedirs :: Identifier -> Rules (Identifier, [Identifier])
 | 
					 | 
				
			||||||
extractRedirs ident = do
 | 
					 | 
				
			||||||
  md <- getMetadata ident
 | 
					 | 
				
			||||||
  let to = getMount' ident fromFilePath md
 | 
					 | 
				
			||||||
      froms =
 | 
					 | 
				
			||||||
        fromMaybe [] $
 | 
					 | 
				
			||||||
        map (fromFilePath . dropTrailingPathSeparator . normalise) <$>
 | 
					 | 
				
			||||||
        lookupStringList "redirects" md
 | 
					 | 
				
			||||||
  pure (to, froms)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
makeRedirects :: Identifier -> [Identifier] -> Rules ()
 | 
					 | 
				
			||||||
makeRedirects to froms =
 | 
					 | 
				
			||||||
  create froms $ do
 | 
					 | 
				
			||||||
    route $ indexInDir idRoute
 | 
					 | 
				
			||||||
    compile . makeItem . Redirect . ('/' :) . toFilePath $ to
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
spawnRedirects :: [Identifier] -> Rules ()
 | 
					 | 
				
			||||||
spawnRedirects = traverse_ (extractRedirs >=> uncurry makeRedirects)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
extractHTagLinks :: Identifier -> Rules (Identifier, [[String]])
 | 
					 | 
				
			||||||
extractHTagLinks ident = do
 | 
					 | 
				
			||||||
  md <- getMetadata ident
 | 
					 | 
				
			||||||
  let to = getMount' ident fromFilePath md
 | 
					 | 
				
			||||||
      htags = maybe [] (map splitDirectories) $ lookupStringList "tags" md
 | 
					 | 
				
			||||||
  when (null htags) . fail $ "Uncategorized: " ++ show ident
 | 
					 | 
				
			||||||
  pure (to, htags)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
invTags :: [(Identifier, [[String]])] -> [([String], [String])]
 | 
					 | 
				
			||||||
invTags x =
 | 
					 | 
				
			||||||
  map (fmap (map ('/' :) . nub . map toFilePath)) $
 | 
					 | 
				
			||||||
  groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht]
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
makeTag :: [FilePath] -> [String] -> Rules ()
 | 
					 | 
				
			||||||
makeTag htag pages =
 | 
					 | 
				
			||||||
  create [fromFilePath $ joinPath ("tags" : htag)] $ do
 | 
					 | 
				
			||||||
    route (indexInDir idRoute)
 | 
					 | 
				
			||||||
    compile $ do
 | 
					 | 
				
			||||||
      let ctx =
 | 
					 | 
				
			||||||
            mconcat
 | 
					 | 
				
			||||||
              [ constField "title" ("Pages tagged " ++ joinPath htag)
 | 
					 | 
				
			||||||
              , listField
 | 
					 | 
				
			||||||
                  "htags"
 | 
					 | 
				
			||||||
                  (field "htag" (return . itemBody))
 | 
					 | 
				
			||||||
                  (traverse makeItem htag)
 | 
					 | 
				
			||||||
              , listField
 | 
					 | 
				
			||||||
                  "pages"
 | 
					 | 
				
			||||||
                  (field "page" (return . itemBody))
 | 
					 | 
				
			||||||
                  (traverse makeItem pages)
 | 
					 | 
				
			||||||
              , defaultContext
 | 
					 | 
				
			||||||
              ]
 | 
					 | 
				
			||||||
      makeItem "" >>= loadAndApplyTemplate "templates/tag.html" ctx >>=
 | 
					 | 
				
			||||||
        loadAndApplyTemplate "templates/default.html" ctx >>=
 | 
					 | 
				
			||||||
        relativizeUrls
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
spawnTags =
 | 
					 | 
				
			||||||
  traverse extractHTagLinks >=> pure . invTags >=> traverse_ (uncurry makeTag)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
main :: IO ()
 | 
					 | 
				
			||||||
main =
 | 
					 | 
				
			||||||
  hakyll $
 | 
					 | 
				
			||||||
    {- Source the pages -}
 | 
					 | 
				
			||||||
   do
 | 
					 | 
				
			||||||
    match "external/**/*.md" makePage
 | 
					 | 
				
			||||||
    {- Source and process the redirects -}
 | 
					 | 
				
			||||||
    getMatches "external/**/*.md" >>= spawnRedirects
 | 
					 | 
				
			||||||
    {- Source and process the tags -}
 | 
					 | 
				
			||||||
    getMatches "external/**/*.md" >>= spawnTags
 | 
					 | 
				
			||||||
    {- Compile the templates (no routing, cache-only) -}
 | 
					 | 
				
			||||||
    match "templates/*" $ compile templateBodyCompiler
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
pageCtx :: Context String
 | 
					 | 
				
			||||||
pageCtx = defaultContext
 | 
					 | 
				
			||||||
		Loading…
	
		Reference in a new issue