{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE OverloadedStrings #-} module Index (elmIndexGenerator) where import Control.Monad import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as S import Data.List (sort, partition, intercalate) import Data.Time.Clock (diffUTCTime, getCurrentTime) import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime) import System.FilePath ((), takeExtension, splitDirectories) import Snap.Core (MonadSnap, modifyResponse, setContentType, writeBS) indexStyle :: S.ByteString indexStyle = S.intercalate "\n" [ "body {" , " margin: 0;" , " background: rgb(253,253,253);" , " font-family: 'Lucida Grande','Trebuchet MS','Bitstream Vera Sans',Verdana,Helvetica,sans-serif;" , "}" , "div.topbar {" , " height: 6px;" , " background-color: rgb(96,181,204);" , "}" , "div.header {" , " padding: 20px 50px;" , " font-size: 30px;" , "}" , "div.content { padding: 0 40px }" , "table {" , " width:100%;" , " border-collapse: collapse;" , " margin-bottom: 40px;" , " float: left" , "}" , "a { text-decoration: none; color:rgb(96,181,204) }" , "td { padding: 8px 10px; color:rgb(136,136,136) }" , "tr { border-bottom: solid rgb(245,245,245) 1px }" , "th {" , " text-align: left;" , " padding: 6px 10px;" , " font-weight: normal;" , " font-size: 24px;" , "}" ] writeS :: MonadSnap m => FilePath -> m () writeS = writeBS . S.pack replaceChar :: Char -> Char -> String -> String replaceChar old new string = map (\c -> if c == old then new else c) string makeSafe :: String -> String makeSafe filePath = replaceChar ' ' '+' filePath writeLink :: MonadSnap m => String -> String -> m () writeLink href name = do writeBS "" writeS name writeBS "" timeSince :: MonadSnap m => FilePath -> m String timeSince filePath = do modificationTime <- liftIO $ getModificationTime filePath currentTime <- liftIO getCurrentTime return (showDiff currentTime modificationTime) where showDiff currentTime modificationTime = case diffUTCTime currentTime modificationTime of diff | diff < minute -> format diff second "second" | diff < hour -> format diff minute "minute" | diff < day -> format diff hour "hour" | diff < year -> format diff day "day" | otherwise -> format diff year "year" format diff scale name = let t :: Integer t = round (diff / scale) in show t ++ " " ++ name ++ (if t == 1 then "" else "s") ++ " ago" second = 1 minute = 60 * second hour = 60 * minute day = 24 * hour year = 365 * day elmIndexGenerator :: MonadSnap m => FilePath -> m () elmIndexGenerator directory = do modifyResponse $ setContentType "text/html; charset=utf-8" let title = intercalate "/" $ case splitDirectories directory of "." : rest -> "~" : rest path -> path writeBS "\n\n" writeBS "" writeS title writeBS "" writeBS "" writeBS "
" writeBS "
" writeLink "/" "~" writeBS " / " case splitDirectories directory of _ : pathParts@(_:_) -> do let fullPaths = scanl1 (\a b -> a ++ "/" ++ b) pathParts forM_ (zip pathParts fullPaths) $ \(part, fullPath) -> do writeLink ("/" ++ fullPath) part writeBS " / " _ -> return () writeBS "
" writeBS "
" entries <- liftIO $ getDirectoryContents directory allDirs <- liftIO $ filterM (doesDirectoryExist . (directory )) entries files <- liftIO $ filterM (doesFileExist . (directory )) entries let (elmFiles, otherFiles) = partition (\file -> takeExtension file == ".elm") files let dotFile filePath = null filePath || head filePath == '.' let keepDir dir = dir /= "cache" && dir /= "build" && not (dotFile dir) let dirs = sort (filter keepDir allDirs) let nonElmFiles = sort $ filter (not . dotFile) otherFiles unless (null dirs) $ do writeBS "" forM_ dirs $ \dir -> do writeBS "" writeBS "
Directories
" writeLink (dir ++ "/") dir writeBS "
" unless (null elmFiles) $ do writeBS "" forM_ (sort elmFiles) $ \filePath -> do writeBS "" writeBS "" writeBS "" writeBS "" writeBS "
Elm Files
" writeLink ("/" ++ intercalate "/" (splitDirectories directory) ++ "/" ++ filePath ++ "?debug") "" writeBS " " writeLink filePath filePath writeBS "" writeS =<< timeSince (directory filePath) writeBS "
" unless (null nonElmFiles) $ do writeBS "" writeBS "" forM_ nonElmFiles $ \filePath -> do writeBS "" writeBS "" writeBS "" writeBS "" writeBS "
Other Files
" writeLink filePath filePath writeBS "" writeS =<< timeSince (directory filePath) writeBS "
" writeBS "
" writeBS "" writeBS ""