File: mkindex.hs

package info (click to toggle)
mighttpd2 4.0.3-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 212 kB
  • sloc: haskell: 1,287; ansic: 44; makefile: 4
file content (103 lines) | stat: -rw-r--r-- 2,597 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
{-# LANGUAGE CPP #-}

-- mkindex :: Making index.html for the current directory.

#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
#endif
import Data.Bits
import Data.Time (formatTime)
import Data.Time.Clock.POSIX
import System.Directory
import System.Posix.Files
import Text.Printf

#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif

indexFile :: String
indexFile = "index.html"

main :: IO ()
main = do
    contents <- mkContents
    writeFile indexFile $ header ++ contents ++ tailer
    setFileMode indexFile mode
  where
    mode = ownerReadMode .|. ownerWriteMode .|. groupReadMode .|. otherReadMode

mkContents :: IO String
mkContents = do
    fileNames <- filter dotAndIndex <$> getDirectoryContents "."
    stats <- mapM getFileStatus fileNames
    let fmsls = zipWith pp fileNames stats
        maxLen = maximum $ map (\(_,_,_,x) -> x) fmsls
        contents = concatMap (content maxLen) fmsls
    return contents
  where
    dotAndIndex x = head x /= '.' && x /= indexFile

pp :: String -> FileStatus -> (String,String,String,Int)
pp f st = (file,mtime,size,flen)
  where
    file = ppFile f st
    flen = length file
    mtime = ppMtime st
    size = ppSize st

ppFile :: String -> FileStatus -> String
ppFile f st
  | isDirectory st = f ++ "/"
  | otherwise      = f

ppMtime :: FileStatus -> String
ppMtime st = dateFormat . epochTimeToUTCTime $ st
  where
    epochTimeToUTCTime = posixSecondsToUTCTime . realToFrac . modificationTime
    dateFormat = formatTime defaultTimeLocale "%d-%b-%Y %H:%M"

ppSize :: FileStatus -> String
ppSize st
  | isDirectory st = "  - "
  | otherwise      = sizeFormat . fromIntegral . fileSize $ st
  where
    sizeFormat siz = unit siz " KMGT"
    unit _ []  = error "unit"
    unit s [u] = format s u
    unit s (u:us)
      | s >= 1024 = unit (s `div` 1024) us
      | otherwise = format s u
    format :: Integer -> Char -> String
    format = printf "%3d%c"

header :: String
header = "\
<html>\n\
<head>\n\
<style type=\"text/css\">\n\
<!--\n\
body { padding-left: 10%; }\n\
h1 { font-size: x-large; }\n\
pre { font-size: large; }\n\
hr { text-align: left; margin-left: 0px; width: 80% }\n\
-->\n\
</style>\n\
</head>\n\
<title>Directory contents</title>\n\
<body>\n\
<h1>Directory contents</h1>\n\
<hr>\n\
<pre>\n"

content :: Int -> (String,String,String,Int) -> String
content lim (f,m,s,len) = "<a href=\"" ++ f ++ "\">" ++ f ++ "</a>  " ++ replicate (lim - len) ' ' ++ m ++ "  " ++ s ++ "\n"

tailer :: String
tailer = "\
</pre>\n\
<hr>\n\
</body>\n\
</html>\n"