PrintRepo.hs

-- usage: runhaskell PrintRepo.hs | pandoc -fjson -thtml --standalone

module Main where

import Control.Monad (liftM, forM)
import Data.Monoid (mconcat, mempty, mappend)
import System.FilePath (FilePath, splitDirectories, takeExtension, (</>))
import System.Posix.Directory (getWorkingDirectory)
import System.Directory (doesDirectoryExist, getDirectoryContents)
import qualified Text.Pandoc as P
import qualified Text.Pandoc.Builder as PB
import Text.Pandoc.Highlighting (languagesByExtension)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (formatTime)
import System.Locale (defaultTimeLocale)
import Text.JSON.Generic (encodeJSON)

main :: IO ()
main = do
  cwd <- getWorkingDirectory
  let projectName = last $ splitDirectories $ cwd
  utcTime <- getCurrentTime
  let date = formatTime defaultTimeLocale "%c" utcTime
  blocks <- printRepo cwd ""
  let doc = PB.setTitle (PB.text projectName)
          $ PB.setDate  (PB.text date)
          $ PB.doc blocks
  putStrLn $ encodeJSON doc

printRepo :: FilePath -> FilePath -> IO PB.Blocks
printRepo dir reldir = do
  names <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents dir
  liftM mconcat $ forM names $ \name -> do
    let path = dir </> name
    isDirectory <- doesDirectoryExist path
    (if isDirectory then printRepo else printFile) path $ reldir </> name

printFile :: FilePath -> FilePath -> IO PB.Blocks
printFile fp relp = case languagesByExtension (takeExtension fp) of
  [] -> return mempty
  lang:_ -> do
    let header = PB.header 1 $ PB.text relp
    contents <- readFile fp
    let code = PB.codeBlockWith ("", [lang], []) contents
    return $ header `mappend` code