gdritter repos khuzd / a7cb940
Initial state Getty Ritter 11 years ago
10 changed file(s) with 794 addition(s) and 0 deletion(s). Collapse all Expand all
+41
-0
khuzd.cabal less more
1 Name: khuzd
2 Version: 0.1
3 Synopsis: Project Synopsis Here
4 Description: Project Description Here
5 License: AllRightsReserved
6 Author: Author
7 Maintainer: maintainer@example.com
8 Stability: Experimental
9 Category: Web
10 Build-type: Simple
11 Cabal-version: >=1.2
12
13 Executable khuzd
14 hs-source-dirs: src
15 main-is: Main.hs
16
17 Build-depends:
18 base >= 4 && < 5,
19 bytestring >= 0.9.1 && < 0.11,
20 MonadCatchIO-transformers >= 0.2.1 && < 0.4,
21 mtl >= 2 && < 3,
22 snap-core >= 0.9 && < 0.11,
23 snap-server >= 0.9 && < 0.11,
24 snap,
25 lens,
26 blaze-html,
27 blaze-markup,
28 transformers,
29 pandoc,
30 time,
31 sqlite-simple,
32 snaplet-sqlite-simple,
33 data-default,
34 text,
35 old-locale
36
37 if impl(ghc >= 6.12.0)
38 ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
39 -fno-warn-unused-do-bind
40 else
41 ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+18
-0
schema.sql less more
1 CREATE TABLE posts
2 ( id integer primary key autoincrement
3 , title text not null
4 , contents text not null
5 , author text not null
6 , time integer not null
7 , next integer
8 , prev integer
9 );
10
11 CREATE TABLE lookup
12 ( id integer primary key autoincrement
13 , year integer
14 , month integer
15 , time integer
16 , slug text
17 , post_id integer references posts(id)
18 );
+23
-0
src/Application.hs less more
1 {-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleInstances #-}
2
3 module Application where
4
5 import Control.Lens
6 import Control.Monad.State (get)
7 import Snap.Snaplet
8 import Snap.Snaplet.Auth
9 import Snap.Snaplet.Session
10 import Snap.Snaplet.SqliteSimple
11
12 data App = App
13 { _sess :: Snaplet SessionManager
14 , _db :: Snaplet Sqlite
15 , _auth :: Snaplet (AuthManager App)
16 }
17
18 makeLenses ''App
19
20 type AppHandler = Handler App App
21
22 instance HasSqlite (Handler App App) where
23 getSqliteState = with db get
+207
-0
src/Main.hs less more
1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
2
3 module Main where
4
5 import Application
6 import Templates
7 import Types
8
9 import Control.Applicative ((<|>))
10 import Control.Monad.IO.Class (liftIO)
11 import Data.ByteString.Char8 (ByteString, readInt, unpack)
12 import Data.Default (def)
13 import qualified Data.Text as T
14 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
15 import Snap.Core
16 import Snap.Util.FileServe
17 import Snap.Http.Server
18 import Snap.Snaplet
19 import Snap.Snaplet.Auth
20 import Snap.Snaplet.Auth.Backends.SqliteSimple
21 import Snap.Snaplet.Session.Backends.CookieSession
22 import Snap.Snaplet.SqliteSimple
23 import Text.Blaze (toMarkup)
24 import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
25
26
27 basicError :: Response
28 basicError = setResponseCode 400 emptyResponse
29
30 main :: IO ()
31 main = do
32 (_, s, _) <- runSnaplet Nothing app
33 quickHttpServe s
34
35 handleLogin :: Maybe T.Text -> Handler App (AuthManager App) ()
36 handleLogin _ = writeBuilder (renderHtmlBuilder (errorPage err msg))
37 where err = "Authentication failed!"
38 msg = "Unknown user or password"
39
40 handleLoginSubmit :: Handler App (AuthManager App) ()
41 handleLoginSubmit = loginUser "user" "passwd" Nothing (\_ -> handleLogin err) (redirect "/")
42 where err = Just "Unknown user or password"
43
44 handleLogout :: Handler App (AuthManager App) ()
45 handleLogout = logout >> redirect "/"
46
47 app :: SnapletInit App App
48 app = makeSnaplet "khuzd" "Strike the earth!" Nothing $ do
49 s <- nestSnaplet "sess" sess $ initCookieSessionManager "site_key.txt" "sess" (Just 3600)
50 d <- nestSnaplet "db" db sqliteInit
51 a <- nestSnaplet "auth" auth $ initSqliteAuth sess d
52 addRoutes routes
53 return $ App s d a
54
55 routes :: [(ByteString, AppHandler ())]
56 routes = [ ("/", method POST doAddPost <|>
57 (doIndex >>= doPage))
58 , ("/auth", doLoginForm >>= doPage)
59 , ("/archive", doArchive >>= doPage)
60 , ("/create", doCreate >>= doPage)
61 , ("/:year/:month/:slug", doPost >>= doPage)
62 , ("/:year/:month/:slug/edit", editPost >>= doPage)
63 , ("/login", with auth handleLoginSubmit)
64 , ("/logout", with auth handleLogout)
65 , ("/newest", doNewestRedirect)
66 , ("/oldest", doOldestRedirect)
67 , ("/change", method POST doPasswdChange <|>
68 (doPasswdForm >>= doPage))
69 , ("/static", serveDirectory "static")
70 , ("/newuser", method POST doNewUser)
71 ]
72
73 doPasswdForm :: AppHandler Page
74 doPasswdForm = do
75 user <- fmap userLogin `fmap` with auth currentUser
76 case user of
77 Just u -> return (PasswdForm u)
78 Nothing -> redirect "/"
79
80 doPasswdChange :: AppHandler ()
81 doPasswdChange = do
82 Just op <- getParam "oldpasswd"
83 Just p1 <- getParam "p1"
84 Just p2 <- getParam "p2"
85 user <- with auth currentUser
86 case user of
87 Nothing -> finishWith basicError
88 Just u ->
89 case authenticatePassword u (ClearText op) of
90 Just _ -> finishWith basicError
91 Nothing ->
92 if p1 /= p2
93 then finishWith basicError
94 else do a <- liftIO (setPassword u p1)
95 with auth $ saveUser a
96 redirect "/"
97
98
99 doLoginForm :: AppHandler Page
100 doLoginForm = do
101 user <- fmap userLogin `fmap` with auth currentUser
102 return (LoginForm user)
103
104 doNewUser :: AppHandler ()
105 doNewUser = do
106 Just user <- getParam "user"
107 Just passwd <- getParam "pass"
108 with auth $ createUser (T.pack (unpack user)) passwd
109 redirect "/"
110
111 doCreate :: AppHandler Page
112 doCreate = do
113 user <- fmap userLogin `fmap` with auth currentUser
114 case user of
115 Just u -> return (Edit u def)
116 _ -> redirect "/"
117
118 doIndex :: AppHandler Page
119 doIndex = do
120 newest <- withSqlite newestPost
121 user <- fmap userLogin `fmap` with auth currentUser
122 case newest of
123 Just pg -> return (Index user pg)
124 Nothing -> finishWith basicError
125
126 doAddPost :: AppHandler ()
127 doAddPost = do
128 allowed <- with auth isLoggedIn
129 if allowed then do
130 rp <- getRawPost
131 Just uname <- fmap userLogin `fmap` with auth currentUser
132 success <- withSqlite (submitPost uname rp)
133 if success
134 then redirect "/"
135 else finishWith basicError
136 else
137 redirect "/"
138
139 doArchive :: AppHandler Page
140 doArchive = do
141 user <- fmap userLogin `fmap` with auth currentUser
142 posts <- withSqlite listPosts
143 return (List user posts)
144
145 doOldestRedirect :: AppHandler ()
146 doOldestRedirect = do
147 oldest <- withSqlite oldestPostRef
148 case oldest of
149 Nothing -> finishWith basicError
150 Just pr -> do
151 let url = urlFor pr
152 redirect (encodeUtf8 url)
153
154 doNewestRedirect :: AppHandler ()
155 doNewestRedirect = do
156 newest <- withSqlite newestPostRef
157 case newest of
158 Nothing -> finishWith basicError
159 Just pr -> do
160 let url = urlFor pr
161 redirect (encodeUtf8 url)
162
163 toInt :: ByteString -> AppHandler Int
164 toInt bs = case readInt bs of
165 Just (n, "") -> return n
166 _ -> finishWith basicError
167
168 getPost :: AppHandler (Maybe Post)
169 getPost = do
170 Just year <- getParam "year"
171 Just month <- getParam "month"
172 Just slug <- getParam "slug"
173 year' <- toInt year
174 month' <- toInt month
175 let slug' = unpack slug
176 withSqlite (postByDateAndSlug year' month' slug')
177
178 getRawPost :: AppHandler RawPost
179 getRawPost = do
180 Just rpTitle <- fmap decodeUtf8 `fmap` getParam "title"
181 Just rpAuthor <- fmap decodeUtf8 `fmap` getParam "author"
182 Just rpContents <- fmap decodeUtf8 `fmap` getParam "contents"
183 idNum <- getParam "id"
184 let rpId = case idNum of
185 Just "none" -> Nothing
186 _ -> maybe Nothing (fmap fst . readInt) idNum
187 return RawPost { .. }
188
189 doPost :: AppHandler Page
190 doPost = do
191 post <- getPost
192 user <- fmap userLogin `fmap` with auth currentUser
193 case post of
194 Just pg -> return (Entry user pg)
195 Nothing -> finishWith basicError
196
197 editPost :: AppHandler Page
198 editPost = do
199 post <- getPost
200 user <- fmap userLogin `fmap` with auth currentUser
201 case (post, user) of
202 (Just pg, Just u)
203 | u == postAuthor pg -> return (Edit u (toRaw pg))
204 _ -> finishWith basicError
205
206 doPage :: Page -> AppHandler ()
207 doPage = writeBuilder . renderHtmlBuilder . toMarkup
+8
-0
src/Site.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Site where
4
5 import Application
6 import Templates (errorPage)
7
8 type Routes = [(B.ByteString, Handler App App ())]
+167
-0
src/Templates.hs less more
1 {-# LANGUAGE OverloadedStrings, RecordWildCards, BangPatterns #-}
2
3 module Templates(Page(..), errorPage) where
4
5 import Types
6
7 import Data.Maybe (isJust)
8 import Data.Monoid ((<>))
9 import Data.Text (Text)
10 import qualified Data.Text as T
11 import Data.Time (UTCTime)
12 import Data.Time.Format (formatTime)
13 import Prelude (String, ($), (++), (==), return, Bool(..), Maybe(..), show)
14 import qualified Prelude as P
15 import System.Locale (defaultTimeLocale)
16 import Text.Blaze.Html5
17 import Text.Blaze.Html5.Attributes hiding (title, form, span)
18 import Text.Pandoc (writeHtml, readMarkdown, def)
19 import Text.Pandoc.Options (WriterOptions(..))
20
21 -- A data representation of a page to be rendered
22 data Page
23 = Index (Maybe Text) Post
24 | List (Maybe Text) [PostRef]
25 | Entry (Maybe Text) Post
26 | Edit Text RawPost
27 | LoginForm (Maybe Text)
28 | PasswdForm Text
29
30 instance ToMarkup Page where
31 toMarkup (Index lg post@(Post { .. })) =
32 page lg postTitle (postBody lg post)
33 toMarkup (List lg ps) =
34 page lg "Past Entries" (listBody ps)
35 toMarkup (Entry lg post@(Post { .. })) =
36 page lg postTitle (postBody lg post)
37 toMarkup (Edit uname rawPost) =
38 page (Just uname) "Create Post" (editForm uname rawPost)
39 toMarkup (PasswdForm uname) =
40 page (Just uname) "Change Password" (passwdForm uname)
41 toMarkup (LoginForm lg) =
42 page lg "Log In" loginForm
43
44 page :: Maybe Text -> Text -> Html -> Html
45 page isLoggedIn pgName pgContents = docTypeHtml $ do
46 head $ do
47 meta ! charset "utf-8"
48 link ! rel "stylesheet" ! type_ "text/css" ! href "/static/main.css"
49 script ! src "/static/main.js" $ return ()
50 title (toHtml ("Baruk Khazâd: " `T.append` pgName))
51 body ! id "bg" $ do
52 userText
53 div ! class_ "title" $ h1 ("Baruk Khazâd! Khazâd ai-Mênu!")
54 div ! class_ "nav" $ titlebar isLoggedIn
55 div ! class_ "main" $ pgContents
56 where userText = case isLoggedIn of
57 Just user -> div ! class_ "username" $ do
58 span ! class_ "msg" $ toMarkup ("Logged in as " <> user)
59 " — "
60 span ! class_ "lnk" $ do
61 a ! href "/change" $ "Change My Password"
62 " — "
63 span ! class_ "lnk" $ do
64 a ! href "/logout" $ "Log Out"
65 Nothing -> return ()
66
67 errorPage :: Text -> Text -> Html
68 errorPage err desc = page Nothing ("Error: " <> err ) $ do
69 div ! class_ "errmsg" $ toMarkup desc
70
71 passwdForm :: Text -> Html
72 passwdForm uname = do
73 form ! name "passwd"
74 ! action "/change"
75 ! method "POST"
76 ! enctype "application/x-www-form-urlencoded;charset=UTF-8" $ do
77 toMarkup ("Old password for " <> uname <> ": ")
78 br
79 input ! type_ "password" ! name "oldpasswd"
80 br
81 "New password: "
82 br
83 input ! type_ "password" ! name "p1"
84 br
85 input ! type_ "password" ! name "p2"
86 br
87 input ! type_ "submit"
88
89 loginForm :: Html
90 loginForm = div ! class_ "login" $ do
91 form ! name "login"
92 ! action "/login"
93 ! method "POST"
94 ! enctype "application/x-www-form-urlencoded;charset=UTF-8" $ do
95 input ! type_ "text" ! name "user"
96 br
97 input ! type_ "password" ! name "passwd"
98 br
99 input ! type_ "submit"
100
101 editForm :: Text -> RawPost -> Html
102 editForm uname (RawPost { .. }) = div ! class_ "edit" $ do
103 form ! name "newpost"
104 ! action "/"
105 ! method "POST"
106 ! enctype "application/x-www-form-urlencoded;charset=UTF-8" $ do
107 let idVal = case rpId of
108 Nothing -> toValue ("none" :: String)
109 Just n -> toValue n
110 input ! type_ "hidden" ! name "id" ! value idVal
111 "Title: "
112 input ! type_ "text" ! name "title" ! value (toValue rpTitle)
113 input ! type_ "hidden" ! name "author" ! value (toValue uname)
114 br
115 textarea ! cols "80" ! rows "40" ! name "contents" $ toHtml rpContents
116 br
117 input ! type_ "submit"
118
119 titlebar :: Maybe Text -> Html
120 titlebar user = P.mapM_ go links
121 where go (lname, url) = a ! class_ "navitem" ! href url $ lname
122 links = if isJust user then
123 [ ("Newest", "/newest")
124 , ("Archive", "/archive")
125 , ("Create", "/create")
126 , ("Oldest", "/oldest")
127 ]
128 else
129 [ ("Newest", "/newest")
130 , ("Archive", "/archive")
131 , ("Log In", "/auth")
132 , ("Oldest", "/oldest")
133 ]
134
135 postLink :: PostRef -> Html
136 postLink (post@PostRef { .. }) =
137 a ! href (toValue (urlFor post)) $ toHtml prName
138
139 postBody :: Maybe Text -> Post -> Html
140 postBody user (post@Post { .. }) = div ! class_ "post" $ do
141 h2 (toHtml postTitle)
142 div ! class_ "author" $ toHtml postAuthor
143
144 let htmlOpts = def { writerHtml5 = True }
145 let convPost = T.replace "\r\n" "\n" postContents
146 writeHtml htmlOpts (readMarkdown def (T.unpack convPost))
147 editLink user
148 div ! class_ "new" $ maybeLink postNext "Newer"
149 div ! class_ "old" $ maybeLink postPrev "Older"
150 where maybeLink Nothing _ = return ()
151 maybeLink (Just pr) n = postLink (pr { prName = n })
152 editLink (Just uname)
153 | uname == postAuthor = a ! href editURL $ "Edit this post"
154 editLink _ = return ()
155 editURL = toValue (urlForPost post <> "/edit")
156
157 formatDate :: UTCTime -> String
158 formatDate = formatTime defaultTimeLocale "%e %B, %Y"
159
160 listBody :: [PostRef] -> Html
161 listBody ps = div ! class_ "list" $ P.mapM_ go ps
162 where go ref = do
163 p $ do
164 postLink ref
165 span ! class_ "date" $ do
166 " on "
167 toMarkup (formatDate (prDate ref))
+167
-0
src/Types.hs less more
1 {-# LANGUAGE RecordWildCards, ScopedTypeVariables, OverloadedStrings #-}
2
3 module Types
4 ( submitPost
5 , newestPost
6 , newestPostRef
7 , oldestPostRef
8 , listPosts
9 , postByDateAndSlug
10
11 , PostRef(..)
12 , Post(..)
13 , RawPost(..)
14
15 , urlFor
16 , urlForPost
17 , toRaw
18 ) where
19
20 import Data.Char (isAlphaNum, toLower)
21 import Data.Default (Default(..))
22 import Data.Maybe (listToMaybe)
23 import Data.Text (Text)
24 import qualified Data.Text as T
25 import Data.Time (UTCTime(utctDay), toGregorian, getCurrentTime)
26 import Database.SQLite.Simple
27
28 singleResult :: IO [Only a] -> IO (Maybe a)
29 singleResult = fmap (fmap fromOnly . listToMaybe)
30
31 slugify :: Text -> Text
32 slugify = T.map conv
33 where conv c | isAlphaNum c = toLower c
34 | otherwise = '-'
35
36 submitPost :: Text -> RawPost -> Connection -> IO Bool
37 submitPost uname rp c = case rpId rp of
38 Just _ -> updatePost uname rp c
39 Nothing -> insertPost uname rp c
40
41 updatePost :: Text -> RawPost -> Connection -> IO Bool
42 updatePost uname (RawPost { .. }) c = do
43 if uname /= rpAuthor then return False else do
44 let Just n = rpId
45 execute c "UPDATE posts SET title = ?, author = ?, contents = ? WHERE id = ?"
46 (rpTitle, rpAuthor, rpContents, n)
47 execute c "UPDATE lookup SET slug = ? WHERE post_id = ?" (slugify rpTitle, n)
48 return True
49
50 insertPost :: Text -> RawPost -> Connection -> IO Bool
51 insertPost uname (RawPost { .. }) c = do
52 time <- getCurrentTime
53 prev <- singleResult $ query_ c "SELECT id FROM posts ORDER BY time DESC LIMIT 1"
54 execute c "INSERT INTO posts (title, contents, author, time, next, prev) VALUES (?,?,?,?,?,?)"
55 (rpTitle, rpContents, uname, time, Nothing :: Maybe Int, prev :: Maybe Int)
56 Just new <- singleResult $ query c "SELECT id FROM posts WHERE time = ?" (Only time)
57 case prev of
58 Just p -> execute c "UPDATE posts SET next = ? WHERE id = ?" (new :: Int, p)
59 _ -> return ()
60 let (year, month, _) = toGregorian (utctDay time)
61 execute c "INSERT INTO lookup (year, month, time, slug, post_id) VALUES (?,?,?,?,?)"
62 (year, month, time, slugify rpTitle, new)
63 return True
64
65 newestPost :: Connection -> IO (Maybe Post)
66 newestPost c = do
67 [Only n] <- query_ c "SELECT id FROM posts ORDER BY time DESC LIMIT 1"
68 postById n c
69
70 newestPostRef :: Connection -> IO (Maybe PostRef)
71 newestPostRef c = do
72 [Only n] <- query_ c "SELECT id FROM posts ORDER BY time DESC LIMIT 1"
73 postRefById n c
74
75 oldestPostRef :: Connection -> IO (Maybe PostRef)
76 oldestPostRef c = do
77 [Only n] <- query_ c "SELECT id FROM posts ORDER BY time ASC LIMIT 1"
78 postRefById n c
79
80 listPosts :: Connection -> IO [PostRef]
81 listPosts c = do
82 posts <- query_ c "SELECT year, month, slug, post_id FROM lookup ORDER BY time DESC"
83 mapM go posts
84 where go (prYear, prMonth, prSlug, n :: Int) =
85 do [(prName, prDate)] <- query c "SELECT title, time FROM posts WHERE id = ?" (Only n)
86 return (PostRef { .. })
87
88 postById :: Int -> Connection -> IO (Maybe Post)
89 postById n c = do
90 vals <- query c "SELECT id, title, contents, author, time, next, prev FROM posts WHERE id = ?" (Only n)
91 case vals of
92 [] -> return Nothing
93 (postId, postTitle, postContents, postAuthor, postDate, nextId, prevId):_ -> do
94 postNext <- maybe (return Nothing) (flip postRefById c) nextId
95 postPrev <- maybe (return Nothing) (flip postRefById c) prevId
96 return (Just (Post { .. }))
97
98 postByDateAndSlug :: Int -> Int -> String -> Connection -> IO (Maybe Post)
99 postByDateAndSlug year month slug c = do
100 vals <- query c "SELECT post_id FROM lookup WHERE year = ? AND month = ? AND slug = ?"
101 (year, month, slug)
102 case vals of
103 [] -> return Nothing
104 (Only n:_) -> postById n c
105
106 postRefById :: Int -> Connection -> IO (Maybe PostRef)
107 postRefById n c = do
108 vals <- query c "SELECT year, month, slug, post_id FROM lookup WHERE id = ?" (Only n)
109 case vals of
110 [] -> return Nothing
111 (prYear, prMonth, prSlug, postId :: Int):_ -> do
112 (prName, prDate):_ <- query c "SELECT title, time FROM posts WHERE id = ?" (Only postId)
113 return (Just (PostRef { .. }))
114
115 -- Every post is referred to by a year, a month, a slug, and a name
116 data PostRef = PostRef
117 { prYear :: Int
118 , prMonth :: Int
119 , prSlug :: Text
120 , prName :: Text
121 , prDate :: UTCTime
122 } deriving Show
123
124 -- All the data for a particular post
125 data Post = Post
126 { postId :: Int
127 , postDate :: UTCTime
128 , postTitle :: Text
129 , postContents :: Text
130 , postAuthor :: Text
131 , postNext :: Maybe PostRef
132 , postPrev :: Maybe PostRef
133 } deriving Show
134
135 -- And all the data necessary to create a new post
136 data RawPost = RawPost
137 { rpId :: Maybe Int
138 , rpTitle :: Text
139 , rpAuthor :: Text
140 , rpContents :: Text
141 } deriving Show
142
143 instance Default RawPost where
144 def = RawPost Nothing "" "" ""
145
146 urlForPost :: Post -> Text
147 urlForPost (Post { .. }) =
148 let (year, month, _) = toGregorian (utctDay postDate) in
149 T.concat [ "/", T.pack (show year)
150 , "/", T.pack (show month)
151 , "/", slugify postTitle
152 ]
153
154 urlFor :: PostRef -> Text
155 urlFor (PostRef { .. }) =
156 T.concat [ "/", T.pack (show prYear)
157 , "/", T.pack (show prMonth)
158 , "/", prSlug
159 ]
160
161 toRaw :: Post -> RawPost
162 toRaw (Post { .. }) = RawPost
163 { rpId = Just postId
164 , rpTitle = postTitle
165 , rpContents = postContents
166 , rpAuthor = postAuthor
167 }
static/back.gif less more
Binary diff not shown
+98
-0
static/main.css less more
1 body {
2 font-family: "Arial", "Helvetica", sans-serif;
3 background-color: #140d07;
4 background-image: url('/static/back.gif');
5 background-attachment: fixed;
6 color: #6b7355;
7 }
8
9 .username {
10 width: 100%;
11 background-color: rgba(176,189,140,0.8);
12 color: #1d1309;
13 text-align: center;
14 margin-bottom: 10px;
15 }
16
17 .title {
18 width:60%;
19 margin-left: auto;
20 margin-right: auto;
21 text-align: center;
22 padding: 1px;
23 background-color: rgba(176,189,140,0.8);
24 color: #1d1309;
25 margin-bottom: 20px;
26 -moz-border-radius: 15px;
27 border-radius: 15px;
28 }
29
30 .nav {
31 width: 60%;
32 margin-left: auto;
33 margin-right: auto;
34 background-color: rgba(30,20,10,0.95);
35 padding: 12px;
36 margin-bottom: 10px;
37 text-align: center;
38 -moz-border-radius: 15px;
39 border-radius: 15px;
40 }
41
42 .navitem {
43 padding: 50px;
44 }
45
46 .main {
47 width: 60%;
48 margin-left: auto;
49 margin-right: auto;
50 background-color: rgba(30,20,10,0.95);
51 padding-left: 20px;
52 padding-right: 20px;
53 padding-top: 10px;
54 padding-bottom: 30px;
55 -moz-border-radius: 15px;
56 border-radius: 15px;
57 }
58
59 .main h2 {
60 background-color: rgba(176,189,140,0.8);
61 text-align: center;
62 padding: 10px;
63 -moz-border-radius: 15px;
64 border-radius: 15px;
65 color: #1d1309;
66 }
67
68 .author {
69 font-style: italic;
70 text-align: center;
71 background-color: rgba(176,189,140,0.2);
72 padding: 10px;
73 -moz-border-radius: 15px;
74 border-radius: 15px;
75 width: 60%;
76 margin-left: auto;
77 margin-right: auto;
78 }
79
80 a {
81 color: #fab40a;
82 }
83
84 a visited {
85 color: #896305;
86 }
87
88 .new {
89 display: inline-block;
90 width: 50%;
91 text-align: left;
92 }
93
94 .old {
95 display: inline-block;
96 width: 50%;
97 text-align: right;
98 }⏎
+65
-0
static/main.js less more
1 function toDwarfMonth(t){
2 return(t.replace('January','Granite')
3 .replace('February','Slate')
4 .replace('March','Felsite')
5 .replace('April','Hematite')
6 .replace('May','Malachite')
7 .replace('June','Galena')
8 .replace('July','Limestone')
9 .replace('August','Sandstone')
10 .replace('September','Timber')
11 .replace('October','Moonstone')
12 .replace('November','Opal')
13 .replace('December','Obsidian'));
14 };
15
16 function fromDwarfMonth(t) {
17 return(t.replace('Granite','January')
18 .replace('Slate','February')
19 .replace('Felsite','March')
20 .replace('Hematite','April')
21 .replace('Malachite','May')
22 .replace('Galena','June')
23 .replace('Limestone','July')
24 .replace('Sandstone','August')
25 .replace('Timber','September')
26 .replace('Moonstone','October')
27 .replace('Opal','November')
28 .replace('Obsidian','December'));
29 };
30
31 function dateReplace(f){
32 var spans=document.getElementsByTagName('span');
33 for(var i in spans) {
34 if(spans[i].className&&spans[i].className.search('date')!== -1)
35 spans[i].innerHTML=f(spans[i].innerHTML);
36 }
37 };
38
39 window.onload = function() {
40 function toggle(){
41 is_dwarf=!is_dwarf;
42 if (window.localStorage)
43 window.localStorage.setItem('dwarvish',is_dwarf);
44 dateReplace(is_dwarf?toDwarfMonth:fromDwarfMonth);
45 };
46 function scroll() {
47 var posY=( document.documentElement.scrollTop
48 ? document.documentElement.scrollTop
49 : window.pageYOffset);
50 bg.style.backgroundPosition='' + (-posY*(0.01)) + 'px ' + (-posY*(0.1)) + 'px';
51 };
52 var bg=document.getElementById('bg');
53 var is_dwarf=(window.localStorage&&window.localStorage.getItem('dwarvish')=='true');
54 var spans=document.getElementsByTagName('span');
55 for (var i in spans) {
56 if (spans[i].className&&spans[i].className.search('date')!==-1) {
57 spans[i].onclick=toggle
58 }
59 }
60 dateReplace(is_dwarf?toDwarfMonth:fromDwarfMonth);
61 scroll();
62
63 window.onscroll=scroll;
64 };
65