Skip to content
This repository
Newer
Older
100644 190 lines (174 sloc) 6.911 kb
919b20c1 »
2012-05-16 Improved categories.
1 {-# LANGUAGE CPP #-}
126bc44d »
2009-06-25 Added Network.Gitit.Page.
2 {-
3 Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 -}
19
20 {- Functions for translating between Page structures and raw
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
21 - text strings. The strings may begin with a metadata block,
1f192c3d » John MacFarlane
2009-07-01 Use YAML for metadata block.
22 - which looks like this (it is valid YAML):
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
23 -
1f192c3d » John MacFarlane
2009-07-01 Use YAML for metadata block.
24 - > ---
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
25 - > title: Custom Title
1f192c3d » John MacFarlane
2009-07-01 Use YAML for metadata block.
26 - > format: markdown+lhs
27 - > toc: yes
28 - > categories: foo bar baz
29 - > ...
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
30 -
31 - This would tell gitit to use "Custom Title" as the displayed
32 - page title (instead of the page name), to interpret the page
fab67376 »
2009-06-27 Added pageTOC to page metadata.
33 - text as markdown with literate haskell, to include a table of
34 - contents, and to include the page in the categories foo, bar,
35 - and baz.
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
36 -
d89590a6 »
2009-08-17 Don't require blank line after metadata block.
37 - The metadata block may be omitted entirely, and any particular line
38 - may be omitted. The categories in the @categories@ field should be
39 - separated by spaces. Commas will be treated as spaces.
40 -
41 - Metadata value fields may be continued on the next line, as long as
42 - it is nonblank and starts with a space character.
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
43 -
44 - Unrecognized metadata fields are simply ignored.
126bc44d »
2009-06-25 Added Network.Gitit.Page.
45 -}
46
47 module Network.Gitit.Page ( stringToPage
48 , pageToString
919b20c1 »
2012-05-16 Improved categories.
49 , readCategories
126bc44d »
2009-06-25 Added Network.Gitit.Page.
50 )
51 where
52 import Network.Gitit.Types
068e7809 »
2009-07-31 Major architectural revision of authentication system.
53 import Network.Gitit.Util (trim, splitCategories, parsePageType)
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
54 import Text.ParserCombinators.Parsec
86d5e71a »
2012-05-16 Improved categories.
55 import Data.Char (toLower)
0778ef48 » John MacFarlane
2009-07-01 Added extractCategories to Network.Gitit.Page.
56 import Data.Maybe (fromMaybe)
919b20c1 »
2012-05-16 Improved categories.
57 import Data.ByteString.UTF8 (toString)
58 import qualified Data.ByteString as B
86d5e71a »
2012-05-16 Improved categories.
59 import qualified Data.ByteString.Char8 as BC
919b20c1 »
2012-05-16 Improved categories.
60 import System.IO (withFile, Handle, IOMode(..))
34432804 »
2012-05-16 Improved hGetLinesTill so that it doesn't crash on eof.
61 import Prelude hiding (catch)
62 import Control.Exception (catch, throwIO)
63 import System.IO.Error (isEOFError)
86d5e71a »
2012-05-16 Improved categories.
64 #if MIN_VERSION_base(4,5,0)
65 #else
66 import Codec.Binary.UTF8.String (encodeString)
67 #endif
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
68
69 parseMetadata :: String -> ([(String, String)], String)
70 parseMetadata raw =
71 case parse pMetadataBlock "" raw of
1f192c3d » John MacFarlane
2009-07-01 Use YAML for metadata block.
72 Left _ -> ([], raw)
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
73 Right (ls, rest) -> (ls, rest)
74
75 pMetadataBlock :: GenParser Char st ([(String, String)], String)
1f192c3d » John MacFarlane
2009-07-01 Use YAML for metadata block.
76 pMetadataBlock = try $ do
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
77 _ <- string "---"
78 _ <- pBlankline
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
79 ls <- many pMetadataLine
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
80 _ <- string "..."
81 _ <- pBlankline
d89590a6 »
2009-08-17 Don't require blank line after metadata block.
82 skipMany pBlankline
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
83 rest <- getInput
84 return (ls, rest)
85
86 pBlankline :: GenParser Char st Char
87 pBlankline = try $ many (oneOf " \t") >> newline
88
89 pMetadataLine :: GenParser Char st (String, String)
90 pMetadataLine = try $ do
91 ident <- many1 letter
f34834d7 »
2009-07-03 Allow space btw key name and colon in metadata fields.
92 skipMany (oneOf " \t")
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
93 _ <- char ':'
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
94 rawval <- many $ noneOf "\n\r"
95 <|> (try $ newline >> notFollowedBy pBlankline >>
96 skipMany1 (oneOf " \t") >> return ' ')
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
97 _ <- newline
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
98 return (ident, trim rawval)
99
126bc44d »
2009-06-25 Added Network.Gitit.Page.
100 -- | Read a string (the contents of a page file) and produce a Page
101 -- object, using defaults except when overridden by metadata.
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
102 stringToPage :: Config -> String -> String -> Page
103 stringToPage conf pagename raw =
104 let (ls, rest) = parseMetadata raw
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
105 page' = Page { pageName = pagename
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
106 , pageFormat = defaultPageType conf
107 , pageLHS = defaultLHS conf
fab67376 »
2009-06-27 Added pageTOC to page metadata.
108 , pageTOC = tableOfContents conf
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
109 , pageTitle = pagename
110 , pageCategories = []
a29df145 » John MacFarlane
2009-10-04 Added metadata to Page and Context, provided askMeta for plugins.
111 , pageText = filter (/= '\r') rest
112 , pageMeta = ls }
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
113 in foldr adjustPage page' ls
114
115 adjustPage :: (String, String) -> Page -> Page
116 adjustPage ("title", val) page' = page' { pageTitle = val }
117 adjustPage ("format", val) page' = page' { pageFormat = pt, pageLHS = lhs }
118 where (pt, lhs) = parsePageType val
fab67376 »
2009-06-27 Added pageTOC to page metadata.
119 adjustPage ("toc", val) page' = page' {
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
120 pageTOC = map toLower val `elem` ["yes","true"] }
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
121 adjustPage ("categories", val) page' =
366a085e »
2009-06-28 Allow multiple '!categories:' lines in metadata.
122 page' { pageCategories = splitCategories val ++ pageCategories page' }
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
123 adjustPage (_, _) page' = page'
126bc44d »
2009-06-25 Added Network.Gitit.Page.
124
125 -- | Write a string (the contents of a page file) corresponding to
126 -- a Page object, using explicit metadata only when needed.
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
127 pageToString :: Config -> Page -> String
128 pageToString conf page' =
129 let pagename = pageName page'
130 pagetitle = pageTitle page'
131 pageformat = pageFormat page'
132 pagelhs = pageLHS page'
fab67376 »
2009-06-27 Added pageTOC to page metadata.
133 pagetoc = pageTOC page'
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
134 pagecats = pageCategories page'
135 metadata' = (if pagename /= pagetitle
136 then "!title: " ++ pagetitle ++ "\n"
137 else "") ++
138 (if pageformat /= defaultPageType conf ||
139 pagelhs /= defaultLHS conf
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
140 then "!format: " ++
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
141 map toLower (show pageformat) ++
142 if pagelhs then "+lhs\n" else "\n"
143 else "") ++
fab67376 »
2009-06-27 Added pageTOC to page metadata.
144 (if pagetoc /= tableOfContents conf
145 then "!toc: " ++
146 (if pagetoc then "yes" else "no") ++ "\n"
147 else "") ++
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
148 (if not (null pagecats)
2465bcbb » gwern
2011-04-13 Strip trailing whitespace; misc -Wall and hlint
149 then "!categories: " ++ unwords pagecats ++ "\n"
b25bf219 »
2009-06-25 Finished working version of Network.Gitit.Page.
150 else "")
151 in metadata' ++ (if null metadata' then "" else "\n") ++ pageText page'
126bc44d »
2009-06-25 Added Network.Gitit.Page.
152
919b20c1 »
2012-05-16 Improved categories.
153 -- | Read categories from metadata strictly.
154 readCategories :: FilePath -> IO [String]
155 readCategories f =
156 #if MIN_VERSION_base(4,5,0)
86d5e71a »
2012-05-16 Improved categories.
157 withFile f ReadMode $ \h ->
919b20c1 »
2012-05-16 Improved categories.
158 #else
86d5e71a »
2012-05-16 Improved categories.
159 withFile (encodeString f) ReadMode $ \h ->
919b20c1 »
2012-05-16 Improved categories.
160 #endif
86d5e71a »
2012-05-16 Improved categories.
161 catch (do fl <- B.hGetLine h
162 if dashline fl
163 then do -- get rest of metadata
164 rest <- hGetLinesTill h dotline
165 let (md,_) = parseMetadata $ unlines $ "---":rest
166 return $ splitCategories $ fromMaybe ""
167 $ lookup "categories" md
168 else return [])
169 (\e -> if isEOFError e then return [] else throwIO e)
170
171 dashline :: B.ByteString -> Bool
172 dashline x =
173 case BC.unpack x of
174 ('-':'-':'-':xs) | all (==' ') xs -> True
175 _ -> False
176
177 dotline :: B.ByteString -> Bool
178 dotline x =
179 case BC.unpack x of
180 ('.':'.':'.':xs) | all (==' ') xs -> True
181 _ -> False
182
183 hGetLinesTill :: Handle -> (B.ByteString -> Bool) -> IO [String]
919b20c1 »
2012-05-16 Improved categories.
184 hGetLinesTill h end = do
86d5e71a »
2012-05-16 Improved categories.
185 next <- B.hGetLine h
186 if end next
187 then return [toString next]
919b20c1 »
2012-05-16 Improved categories.
188 else do
189 rest <- hGetLinesTill h end
86d5e71a »
2012-05-16 Improved categories.
190 return (toString next:rest)
Something went wrong with that request. Please try again.