gitit 0.12.2.1 → 0.12.3
raw patch · 27 files changed
+401/−399 lines, 27 filesdep +skylightingdep +uri-bytestringdep +xml-conduitdep −highlighting-katedep ~aesondep ~basedep ~feedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: skylighting, uri-bytestring, xml-conduit
Dependencies removed: highlighting-kate
Dependency ranges changed: aeson, base, feed, happstack-server, hoauth2, http-conduit, pandoc, pandoc-types, time
API changes (from Hackage documentation)
- Network.Gitit.Types: JsMathScript :: MathMethod
- Network.Gitit.Types: sessionDataGithubState :: String -> SessionData
+ Network.Gitit.Types: data SessionGithubData
+ Network.Gitit.Types: instance GHC.Classes.Eq Network.Gitit.Types.SessionGithubData
+ Network.Gitit.Types: instance GHC.Read.Read Network.Gitit.Types.SessionGithubData
+ Network.Gitit.Types: instance GHC.Show.Show Network.Gitit.Types.SessionGithubData
+ Network.Gitit.Types: sessionDataGithubStateUrl :: String -> String -> SessionData
+ Network.Gitit.Types: sessionGithubData :: SessionData -> Maybe SessionGithubData
+ Network.Gitit.Types: sessionGithubDestination :: SessionGithubData -> String
+ Network.Gitit.Util: getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions
+ Paths_gitit: getDynLibDir :: IO FilePath
- Network.Gitit.Authentication.Github: loginGithubUser :: OAuth2 -> Handler
+ Network.Gitit.Authentication.Github: loginGithubUser :: OAuth2 -> Params -> Handler
- Network.Gitit.Compat.Except: catchError :: MonadError e m => forall a. m a -> (e -> m a) -> m a
+ Network.Gitit.Compat.Except: catchError :: MonadError e m => m a -> e -> m a -> m a
- Network.Gitit.Compat.Except: class Error a where noMsg = strMsg "" strMsg _ = noMsg
+ Network.Gitit.Compat.Except: class Error a
- Network.Gitit.Compat.Except: data ExceptT e (m :: * -> *) a :: * -> (* -> *) -> * -> *
+ Network.Gitit.Compat.Except: data ExceptT e (m :: * -> *) a
- Network.Gitit.Compat.Except: runExcept :: Except e a -> Either e a
+ Network.Gitit.Compat.Except: runExcept :: () => Except e a -> Either e a
- Network.Gitit.Compat.Except: runExceptT :: ExceptT e m a -> m (Either e a)
+ Network.Gitit.Compat.Except: runExceptT :: () => ExceptT e m a -> m Either e a
- Network.Gitit.Compat.Except: throwError :: MonadError e m => forall a. e -> m a
+ Network.Gitit.Compat.Except: throwError :: MonadError e m => e -> m a
- Network.Gitit.Interface: Config :: FilePath -> FileStoreType -> PageType -> String -> MathMethod -> Bool -> Bool -> (Handler -> Handler) -> AuthenticationLevel -> Handler -> FilePath -> Int -> FilePath -> FilePath -> Priority -> FilePath -> [String] -> Bool -> Integer -> Integer -> String -> Int -> Bool -> String -> [String] -> [String] -> String -> String -> Maybe (String, [String]) -> Bool -> String -> String -> String -> String -> Bool -> Bool -> FilePath -> Map String String -> String -> String -> String -> Bool -> String -> Bool -> String -> Integer -> Integer -> Bool -> Maybe FilePath -> Bool -> Int -> GithubConfig -> Config
+ Network.Gitit.Interface: Config :: FilePath -> FileStoreType -> PageType -> String -> MathMethod -> Bool -> Bool -> Handler -> Handler -> AuthenticationLevel -> Handler -> FilePath -> Int -> FilePath -> FilePath -> Priority -> FilePath -> [String] -> Bool -> Integer -> Integer -> String -> Int -> Bool -> String -> [String] -> [String] -> String -> String -> Maybe (String, [String]) -> Bool -> String -> String -> String -> String -> Bool -> Bool -> FilePath -> Map String String -> String -> String -> Text -> Bool -> String -> Bool -> String -> Integer -> Integer -> Bool -> Maybe FilePath -> Bool -> Int -> GithubConfig -> Config
- Network.Gitit.Interface: PageLayout :: String -> Maybe String -> Bool -> [String] -> String -> [String] -> Bool -> Bool -> Maybe String -> [Tab] -> Tab -> Bool -> PageLayout
+ Network.Gitit.Interface: PageLayout :: String -> Maybe String -> Bool -> [String] -> String -> [String] -> Bool -> Bool -> Maybe Text -> [Tab] -> Tab -> Bool -> PageLayout
- Network.Gitit.Interface: [markupHelp] :: Config -> String
+ Network.Gitit.Interface: [markupHelp] :: Config -> Text
- Network.Gitit.Interface: [pgMarkupHelp] :: PageLayout -> Maybe String
+ Network.Gitit.Interface: [pgMarkupHelp] :: PageLayout -> Maybe Text
- Network.Gitit.Interface: data Request :: *
+ Network.Gitit.Interface: data Request
- Network.Gitit.Interface: liftIO :: MonadIO m => forall a. IO a -> m a
+ Network.Gitit.Interface: liftIO :: MonadIO m => IO a -> m a
- Network.Gitit.Types: Config :: FilePath -> FileStoreType -> PageType -> String -> MathMethod -> Bool -> Bool -> (Handler -> Handler) -> AuthenticationLevel -> Handler -> FilePath -> Int -> FilePath -> FilePath -> Priority -> FilePath -> [String] -> Bool -> Integer -> Integer -> String -> Int -> Bool -> String -> [String] -> [String] -> String -> String -> Maybe (String, [String]) -> Bool -> String -> String -> String -> String -> Bool -> Bool -> FilePath -> Map String String -> String -> String -> String -> Bool -> String -> Bool -> String -> Integer -> Integer -> Bool -> Maybe FilePath -> Bool -> Int -> GithubConfig -> Config
+ Network.Gitit.Types: Config :: FilePath -> FileStoreType -> PageType -> String -> MathMethod -> Bool -> Bool -> Handler -> Handler -> AuthenticationLevel -> Handler -> FilePath -> Int -> FilePath -> FilePath -> Priority -> FilePath -> [String] -> Bool -> Integer -> Integer -> String -> Int -> Bool -> String -> [String] -> [String] -> String -> String -> Maybe (String, [String]) -> Bool -> String -> String -> String -> String -> Bool -> Bool -> FilePath -> Map String String -> String -> String -> Text -> Bool -> String -> Bool -> String -> Integer -> Integer -> Bool -> Maybe FilePath -> Bool -> Int -> GithubConfig -> Config
- Network.Gitit.Types: GititState :: Sessions SessionData -> Map String User -> FilePath -> (PageLayout -> Html -> Handler) -> [Plugin] -> GititState
+ Network.Gitit.Types: GititState :: Sessions SessionData -> Map String User -> FilePath -> PageLayout -> Html -> Handler -> [Plugin] -> GititState
- Network.Gitit.Types: PageLayout :: String -> Maybe String -> Bool -> [String] -> String -> [String] -> Bool -> Bool -> Maybe String -> [Tab] -> Tab -> Bool -> PageLayout
+ Network.Gitit.Types: PageLayout :: String -> Maybe String -> Bool -> [String] -> String -> [String] -> Bool -> Bool -> Maybe Text -> [Tab] -> Tab -> Bool -> PageLayout
- Network.Gitit.Types: [markupHelp] :: Config -> String
+ Network.Gitit.Types: [markupHelp] :: Config -> Text
- Network.Gitit.Types: [pgMarkupHelp] :: PageLayout -> Maybe String
+ Network.Gitit.Types: [pgMarkupHelp] :: PageLayout -> Maybe Text
- Network.Gitit.Types: sessionGithubState :: SessionData -> Maybe String
+ Network.Gitit.Types: sessionGithubState :: SessionGithubData -> String
- Network.Gitit.Util: readFileUTF8 :: FilePath -> IO String
+ Network.Gitit.Util: readFileUTF8 :: FilePath -> IO Text
Files
- CHANGES +27/−0
- README.markdown +4/−10
- data/default.conf +5/−7
- data/markup.DocBook +1/−1
- data/markup.Markdown +1/−1
- data/markup.Org +1/−1
- data/markup.Textile +1/−1
- data/static/css/custom.css +1/−1
- data/static/css/highlighting.css +61/−0
- data/static/css/hk-pyg.css +0/−17
- data/static/css/screen.css +1/−2
- data/static/js/preview.js +0/−2
- gitit.cabal +23/−27
- gitit.hs +3/−2
- src/Network/Gitit/Authentication.hs +5/−6
- src/Network/Gitit/Authentication/Github.hs +32/−21
- src/Network/Gitit/Config.hs +27/−24
- src/Network/Gitit/ContentTransformer.hs +28/−56
- src/Network/Gitit/Export.hs +74/−127
- src/Network/Gitit/Feed.hs +24/−11
- src/Network/Gitit/Framework.hs +2/−2
- src/Network/Gitit/Handlers.hs +0/−1
- src/Network/Gitit/Initialize.hs +38/−47
- src/Network/Gitit/Page.hs +1/−8
- src/Network/Gitit/Plugins.hs +0/−13
- src/Network/Gitit/Types.hs +17/−9
- src/Network/Gitit/Util.hs +24/−2
CHANGES view
@@ -1,3 +1,30 @@+Version 0.12.3 released 09 Oct 2018++ * Change hk-pyg.css to highlighting.css with new CSS for pandoc 2+ and skylighting 0.7.4. NOTE: You must change your existing+ custom.css to refer to highlighting.css instead of+ hk-pyg.css, or highlighted code will not display properly.+ * Ensure that the proper extensions are used for each format.+ * Add Ext_emoji to readerExtensions (#616).+ * Add Paths_gitit to other-modules to avoid warning.+ * screen.css: remove special padding and border and color for code.+ This interferes with pandoc's new highlighting.+ * Fixed static in gitignore+ * Update stack.yaml, use latest lts-12.+ * Updates for pandoc 2.x (Myron Wu).+ * Require skylighting >= 0.7.4.+ * Remove jsMath as it was dropped from pandoc >= 2 (#617, Myron Wu).+ * Add Ext_emoji to readerExtensions (#616, Conal Elliott).+ * Changes to use recent versions of dependencies.+ Especially feed 1.0, which uses a different xml type+ and requires a new dependency on xml-conduit to render it.+ * Remove support for ghc versions < 8 (Myron Wu).+ * Bump hoauth2 to 1.3.0 && < 1.6 to catch up with nix and other+ curated package sets (Myron Wu).+ * Updated mathjax cdn to cloudflare.+ * Redirect to requested wiki page after github oauth callback (Myron Wu).+ * Use skylighting instead of deprecated highlighting-kate.+ Version 0.12.2.1 released 14 Feb 2017 * Bump version bounds for time, pandoc, blaze-html, aeson.
README.markdown view
@@ -307,21 +307,15 @@ Gitit can display TeX math in three different ways, depending on the setting of `math` in the configuration file: -1. `mathml` (default): Math will be converted to MathML using+1. `mathjax` (default): Math will be rendered using the [MathJax] javascript.++2. `mathml`: Math will be converted to MathML using [texmath]. This method works with IE+mathplayer, Firefox, and Opera, but not Safari. -2. `jsMath`: Math will be rendered using the [jsMath] javascript.- If you want to use this method, download `jsMath` and `jsMath- Image Fonts` from the [jsMath download page]. You'll have two- `.zip` archives. Unzip them both in the `static/js` directory (a new- subdirectory, `jsMath`, will be created). This works with all- browsers, but is slower and not as nice looking as MathML.- 3. `raw`: Math will be rendered as raw LaTeX codes. -[jsMath]: http://www.math.union.edu/~dpvc/jsmath/-[jsMath download page]: http://sourceforge.net/project/showfiles.php?group_id=172663+[MathJax]: https://www.mathjax.org/ Restricting access ------------------
data/default.conf view
@@ -72,19 +72,17 @@ math: mathjax # specifies how LaTeX math is to be displayed. Possible values-# are MathML, raw, mathjax, jsMath, and google. If mathml is selected,+# are MathML, raw, mathjax, and google. If mathml is selected, # gitit will convert LaTeX math to MathML and link in a script, # MathMLinHTML.js, that allows the MathML to be seen in Gecko browsers, IE + # mathplayer, and Opera. In other browsers you may get a jumble of characters. # If raw is selected, the LaTeX math will be displayed as raw LaTeX math. # If mathjax is selected, gitit will link to the remote mathjax script.-# If jsMath is selected, gitit will link to the script /js/jsMath/easy/load.js,-# and will assume that jsMath has been installed into the js/jsMath directory.-# This is the most portable solution. If google is selected, the google chart-# API is called to render the formula as an image. This requires a connection-# to google, and might raise a technical or a privacy problem.+# If google is selected, the google chart API is called to render the formula+# as an image. This requires a connection to google, and might raise a+# technical or a privacy problem. -mathjax-script: https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML+mathjax-script: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS_CHTML-full # specifies the path to MathJax rendering script. # You might want to use your own MathJax script to render formulas without # Internet connection or if you want to use some special LaTeX packages.
data/markup.DocBook view
@@ -112,7 +112,7 @@ <td> $x = \frac{{ - b \pm \sqrt {b^2 - 4ac} }}{{2a}}$<footnote> <para>- If this looks like code, it's because jsMath is not installed on+ If this looks like code, it's because MathJax is not installed on your system. Contact your administrator to request it. </para> </footnote>
data/markup.Markdown view
@@ -63,7 +63,7 @@ </td> <td> $x = \frac{{ - b \pm \sqrt {b^2 - 4ac} }}{{2a}}$^[If this looks like-code, it's because jsMath is+code, it's because MathJax is not installed on your system. Contact your administrator to request it.] </td> </tr>
data/markup.Org view
@@ -350,7 +350,7 @@ To link to a directory listing for a subdirectory, use a trailing slash: =[Wine/]()= will link to a listing of the =Wine= subdirectory. -[1] If this looks like code, it's because jsMath is not installed on+[1] If this looks like code, it's because MathJax is not installed on your system. Contact your administrator to request it. [2] Or is it so simple?
data/markup.Textile view
@@ -245,7 +245,7 @@ To link to a directory listing for a subdirectory, use a trailing slash: @[Wine/]()@ will link to a listing of the @Wine@ subdirectory. -fn1. If this looks like code, it's because jsMath is not installed on your system. Contact your administrator to request it.+fn1. If this looks like code, it's because MathJax is not installed on your system. Contact your administrator to request it. fn2. Or is it so simple?
data/static/css/custom.css view
@@ -1,5 +1,5 @@ @import url("screen.css"); /* default gitit screen styles */-@import url("hk-pyg.css"); /* for syntax highlighting */+@import url("highlighting.css"); /* for syntax highlighting */ /* Put your custom style modifications here: */
+ data/static/css/highlighting.css view
@@ -0,0 +1,61 @@+a.sourceLine { display: inline-block; line-height: 1.25; }+a.sourceLine { pointer-events: none; color: inherit; text-decoration: inherit; }+a.sourceLine:empty { height: 1.2em; }+.sourceCode { overflow: visible; }+code.sourceCode { white-space: pre; position: relative; }+div.sourceCode { margin: 1em 0; }+pre.sourceCode { margin: 0; }+@media screen {+div.sourceCode { overflow: auto; }+}+@media print {+code.sourceCode { white-space: pre-wrap; }+a.sourceLine { text-indent: -1em; padding-left: 1em; }+}+pre.numberSource a.sourceLine+ { position: relative; left: -4em; }+pre.numberSource a.sourceLine::before+ { content: attr(title);+ position: relative; left: -1em; text-align: right; vertical-align: baseline;+ border: none; pointer-events: all; display: inline-block;+ -webkit-touch-callout: none; -webkit-user-select: none;+ -khtml-user-select: none; -moz-user-select: none;+ -ms-user-select: none; user-select: none;+ padding: 0 4px; width: 4em;+ color: #aaaaaa;+ }+pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }+div.sourceCode+ { }+@media screen {+a.sourceLine::before { text-decoration: underline; }+}+code span.al { color: #ff0000; font-weight: bold; } /* Alert */+code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */+code span.at { color: #7d9029; } /* Attribute */+code span.bn { color: #40a070; } /* BaseN */+code span.bu { } /* BuiltIn */+code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */+code span.ch { color: #4070a0; } /* Char */+code span.cn { color: #880000; } /* Constant */+code span.co { color: #60a0b0; font-style: italic; } /* Comment */+code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */+code span.do { color: #ba2121; font-style: italic; } /* Documentation */+code span.dt { color: #902000; } /* DataType */+code span.dv { color: #40a070; } /* DecVal */+code span.er { color: #ff0000; font-weight: bold; } /* Error */+code span.ex { } /* Extension */+code span.fl { color: #40a070; } /* Float */+code span.fu { color: #06287e; } /* Function */+code span.im { } /* Import */+code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */+code span.kw { color: #007020; font-weight: bold; } /* Keyword */+code span.op { color: #666666; } /* Operator */+code span.ot { color: #007020; } /* Other */+code span.pp { color: #bc7a00; } /* Preprocessor */+code span.sc { color: #4070a0; } /* SpecialChar */+code span.ss { color: #bb6688; } /* SpecialString */+code span.st { color: #4070a0; } /* String */+code span.va { color: #19177c; } /* Variable */+code span.vs { color: #4070a0; } /* VerbatimString */+code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
− data/static/css/hk-pyg.css
@@ -1,17 +0,0 @@-table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {- margin: 0; padding: 0; vertical-align: baseline; border: none; }-table.sourceCode { width: 100%; }-td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }-td.sourceCode { padding-left: 5px; }-code > span.kw { color: #007020; font-weight: bold; }-code > span.dt { color: #902000; }-code > span.dv { color: #40a070; }-code > span.bn { color: #40a070; }-code > span.fl { color: #40a070; }-code > span.ch { color: #4070a0; }-code > span.st { color: #4070a0; }-code > span.co { color: #60a0b0; font-style: italic; }-code > span.ot { color: #007020; }-code > span.al { color: #ff0000; font-weight: bold; }-code > span.fu { color: #06287e; }-code > span.er { color: #ff0000; font-weight: bold; }
data/static/css/screen.css view
@@ -106,8 +106,7 @@ .search_result { margin-bottom: 15px; } .search_result .match { margin-bottom: 15px; } -pre>code { display: block; padding: 0.7em 1em; }-code { font-size: 93%; background-color: #f8f8f8; border: 1px solid #ddd; overflow: auto; border-radius: 0.2em; }+pre>code { display: block; } pre.matches { margin: 0; padding: 0; } #pattern { background-color: yellow; font-weight: bold; } pre.matches span.highlighted { background-color: yellow; }
data/static/js/preview.js view
@@ -8,8 +8,6 @@ $('#previewpane').html(data); // Process any mathematics if we're using MathML if (typeof(convert) == 'function') { convert(); }- // Process any mathematics if we're using jsMath- if (typeof(jsMath) == 'object') { jsMath.ProcessBeforeShowing(); } // Process any mathematics if we're using MathJax if (typeof(window.MathJax) == 'object') { // http://docs.mathjax.org/en/latest/typeset.html
gitit.cabal view
@@ -1,5 +1,5 @@ name: gitit-version: 0.12.2.1+version: 0.12.3 Cabal-version: >= 1.8 build-type: Simple synopsis: Wiki using happstack, git or darcs, and pandoc.@@ -49,7 +49,7 @@ data/static/js/jquery-ui.draggable-1.6rc2.js data/static/js/jquery-ui.tabs-1.6rc2.js data-files: data/static/css/screen.css, data/static/css/print.css,- data/static/css/ie.css, data/static/css/hk-pyg.css,+ data/static/css/ie.css, data/static/css/highlighting.css, data/static/css/reset-fonts-grids.css, data/static/css/custom.css, data/static/img/logo.png, data/static/img/icons/feed.png,@@ -122,12 +122,14 @@ Network.Gitit.Authentication.Github, Network.Gitit.Util, Network.Gitit.Server Network.Gitit.Cache, Network.Gitit.State,- Paths_gitit, Network.Gitit.Export,+ Network.Gitit.Export, Network.Gitit.Handlers, Network.Gitit.Plugins, Network.Gitit.Rpxnow, Network.Gitit.Page, Network.Gitit.Feed,- Network.Gitit.Compat.Except- build-depends: base >= 3 && < 5,+ Network.Gitit.Compat.Except,+ Paths_gitit+ build-depends: base >= 4.9 && < 5,+ syb, filepath, safe, parsec,@@ -139,9 +141,9 @@ directory, mtl, old-time,- pandoc >= 1.12.4 && < 1.20,- pandoc-types >= 1.12.3 && < 1.18,- highlighting-kate >= 0.5.0.1 && < 0.7,+ pandoc >= 2.2,+ pandoc-types >= 1.17.4.2 && < 1.18,+ skylighting >= 0.7.4 && < 0.8, bytestring, text, random,@@ -150,30 +152,30 @@ HTTP >= 4000.0 && < 4000.4, HStringTemplate >= 0.6 && < 0.9, old-locale >= 1,- time >= 1.1 && < 1.8,+ time >= 1.1 && < 1.10, recaptcha >= 0.1, filestore >= 0.6 && < 0.7, zlib >= 0.5 && < 0.7, url >= 2.1 && < 2.2,- happstack-server >= 7.0 && < 7.5,+ happstack-server >= 7.0 && < 7.6, base64-bytestring >= 0.1 && < 1.1, xml >= 1.3.5, hslogger >= 1 && < 1.3, ConfigFile >= 1 && < 1.2,- feed >= 0.3.6 && < 0.4,+ feed >= 1.0 && < 1.1, xss-sanitize >= 0.3 && < 0.4, tagsoup >= 0.13 && < 0.15, blaze-html >= 0.4 && < 0.10, json >= 0.4 && < 0.10, uri >= 0.1 && < 0.2,+ uri-bytestring >= 0.2.3.3 && <= 0.4, split,- hoauth2 >= 0.4.2 && < 0.6,- http-conduit >= 2.1.4 && < 2.3,+ hoauth2 >= 1.3.0 && < 1.8,+ xml-conduit >= 1.5 && < 1.9,+ http-conduit >= 2.1.6 && < 2.4, http-client-tls >= 0.2.2 && < 0.4,- aeson >= 0.7 && < 1.2,+ aeson >= 0.7 && < 1.5, uuid >= 1.3 && < 1.4- if impl(ghc >= 6.10)- build-depends: base >= 4, syb if flag(network-uri) build-depends: network-uri >= 2.6 && < 2.7, network >= 2.6 else@@ -183,10 +185,7 @@ build-depends: ghc, ghc-paths cpp-options: -D_PLUGINS extensions: CPP- if impl(ghc >= 6.12)- ghc-options: -Wall -fno-warn-unused-do-bind- else- ghc-options: -Wall+ ghc-options: -Wall -fno-warn-unused-do-bind ghc-prof-options: -fprof-auto-exported Executable gitit@@ -197,28 +196,25 @@ mtl, hslogger, bytestring,+ text, utf8-string, directory+ other-modules: Paths_gitit if flag(network-uri) build-depends: network-uri >= 2.6 && < 2.7, network >= 2.6 else build-depends: network >= 2 && < 2.6 extensions: CPP- if impl(ghc >= 6.12)- ghc-options: -Wall -threaded -fno-warn-unused-do-bind- else- ghc-options: -Wall -threaded+ ghc-options: -Wall -threaded -fno-warn-unused-do-bind ghc-prof-options: -fprof-auto-exported -rtsopts Executable expireGititCache hs-source-dirs: . main-is: expireGititCache.hs- build-depends: base >=3 && < 5, HTTP, url, filepath+ build-depends: base >= 4.9 && < 5, HTTP, url, filepath, syb if flag(network-uri) build-depends: network-uri >= 2.6 && < 2.7, network >= 2.6 else build-depends: network >= 2 && < 2.6- if impl(ghc >= 6.10)- build-depends: base >= 4, syb ghc-options: -Wall
gitit.hs view
@@ -24,6 +24,7 @@ import Network.Gitit.Util (readFileUTF8) import System.Directory import Data.Maybe (isNothing)+import Data.Text.Encoding (encodeUtf8) import Network.Gitit.Compat.Except() import Control.Monad.Reader import System.Log.Logger (Priority(..), setLevel, setHandlers,@@ -54,7 +55,7 @@ putErr ExitSuccess (progname ++ " version " ++ showVersion version ++ compileInfo ++ copyrightMessage) Left PrintDefaultConfig -> getDataFileName "data/default.conf" >>=- readFileUTF8 >>= B.putStrLn . fromString >> exitSuccess+ readFileUTF8 >>= B.putStrLn . encodeUtf8 >> exitSuccess Right xs -> return xs conf' <- case [f | ConfigFile f <- opts] of@@ -96,7 +97,7 @@ sock <- socket AF_INET Stream defaultProtocol setSocketOption sock ReuseAddr 1 device <- inet_addr (address conf)- bindSocket sock (SockAddrInet (toEnum (portNumber conf)) device)+ bind sock (SockAddrInet (toEnum (portNumber conf)) device) listen sock 10 -- start the server
src/Network/Gitit/Authentication.hs view
@@ -446,13 +446,12 @@ withData $ \(sk :: Maybe SessionKey) -> do mbSd <- maybe (return Nothing) getSession sk- mbGititState <- case mbSd of- Nothing -> return Nothing- Just sd -> return $ sessionGithubState sd- let gititState = fromMaybe (error "No Github state found in session (is it the same domain?)") mbGititState+ let mbGititState = mbSd >>= sessionGithubData+ githubData = fromMaybe (error "No Github state found in session (is it the same domain?)") mbGititState+ gititState = sessionGithubState githubData+ destination = sessionGithubDestination githubData mUser <- getGithubUser ghConfig githubCallbackPars gititState base' <- getWikiBase- let destination = base' ++ "/" case mUser of Right user -> do let userEmail = uEmail user@@ -475,7 +474,7 @@ -> [Handler] githubAuthHandlers ghConfig = [ dir "_logout" $ withData logoutUser- , dir "_login" $ loginGithubUser $ oAuth2 ghConfig+ , dir "_login" $ withData $ loginGithubUser $ oAuth2 ghConfig , dir "_loginFailure" $ githubLoginFailure , dir "_githubCallback" $ withData $ oauthGithubCallback ghConfig , dir "_user" currentUser ]
src/Network/Gitit/Authentication/Github.hs view
@@ -10,11 +10,14 @@ import Network.Gitit.Types import Network.Gitit.Server import Network.Gitit.State+import Network.Gitit.Util+import Network.Gitit.Framework import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL+import qualified URI.ByteString as URI import Network.HTTP.Conduit-import Network.HTTP.Client.TLS import Network.OAuth.OAuth2+import Network.OAuth.OAuth2.TokenRequest as OA import Control.Monad (liftM, mplus, mzero) import Data.Maybe import Data.Aeson@@ -27,16 +30,18 @@ import qualified Control.Exception as E import Prelude -loginGithubUser :: OAuth2 -> Handler-loginGithubUser githubKey = do+loginGithubUser :: OAuth2 -> Params -> Handler+loginGithubUser githubKey params = do state <- liftIO $ fmap toString nextRandom- key <- newSession (sessionDataGithubState state)+ base' <- getWikiBase+ let destination = pDestination params `orIfNull` (base' ++ "/")+ key <- newSession $ sessionDataGithubStateUrl state destination cfg <- getConfig addCookie (MaxAge $ sessionTimeout cfg) (mkCookie "sid" (show key)) let usingOrg = isJust $ org $ githubAuth cfg let scopes = "user:email" ++ if usingOrg then ",read:org" else ""- let url = authorizationUrl githubKey `appendQueryParam` [("state", BS.pack state), ("scope", BS.pack scopes)]- seeOther (BS.unpack url) $ toResponse ("redirecting to github" :: String)+ let url = appendQueryParams [("state", BS.pack state), ("scope", BS.pack scopes)] $ authorizationUrl githubKey+ seeOther (BS.unpack (URI.serializeURIRef' url)) $ toResponse ("redirecting to github" :: String) data GithubLoginError = GithubLoginError { ghUserMessage :: String , ghDetails :: Maybe String@@ -46,8 +51,8 @@ -> GithubCallbackPars -- ^ Authentication code gained after authorization -> String -- ^ Github state, we expect the state we sent in loginGithubUser -> GititServerPart (Either GithubLoginError User) -- ^ user email and name (password 'none')-getGithubUser ghConfig githubCallbackPars githubState =- withManagerSettings tlsManagerSettings getUserInternal+getGithubUser ghConfig githubCallbackPars githubState = liftIO $+ newManager tlsManagerSettings >>= getUserInternal where getUserInternal mgr = liftIO $ do@@ -57,13 +62,13 @@ let (Just code) = rCode githubCallbackPars ifSuccess "No access token found yet"- (fetchAccessToken mgr (oAuth2 ghConfig) (sToBS code))+ (fetchAccessToken mgr (oAuth2 ghConfig) (ExchangeToken $ pack code)) (\at -> ifSuccess "User Authentication failed"- (userInfo mgr at)+ (userInfo mgr (accessToken at)) (\githubUser -> ifSuccess ("No email for user " ++ unpack (gLogin githubUser) ++ " returned by Github")- (mailInfo mgr at)+ (mailInfo mgr (accessToken at)) (\githubUserMail -> do let gitLogin = gLogin githubUser user <- mkUser (unpack gitLogin)@@ -74,7 +79,7 @@ Nothing -> return $ Right user Just githuborg -> ifSuccess ("Membership check failed: the user " ++ unpack gitLogin ++ " is required to be a member of the organization " ++ unpack githuborg ++ ".")- (orgInfo gitLogin githuborg mgr at)+ (orgInfo gitLogin githuborg mgr (accessToken at)) (\_ -> return $ Right user)))) else return $ Left $@@ -97,17 +102,26 @@ vState <- liftM Just (look "state") `mplus` return Nothing return GithubCallbackPars {rCode = vCode, rState = vState} -userInfo :: Manager -> AccessToken -> IO (OAuth2Result GithubUser)-userInfo mgr token = authGetJSON mgr token "https://api.github.com/user"+userInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors GithubUser)+userInfo mgr token = authGetJSON mgr token $ githubUri "/user" -mailInfo :: Manager -> AccessToken -> IO (OAuth2Result [GithubUserMail])-mailInfo mgr token = authGetJSON mgr token "https://api.github.com/user/emails"+mailInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors [GithubUserMail])+mailInfo mgr token = authGetJSON mgr token $ githubUri "/user/emails" -orgInfo :: Text -> Text -> Manager -> AccessToken -> IO (OAuth2Result BSL.ByteString)+orgInfo :: Text -> Text -> Manager -> AccessToken -> IO (OAuth2Result OA.Errors BSL.ByteString) orgInfo gitLogin githubOrg mgr token = do- let url = "https://api.github.com/orgs/" `BS.append` encodeUtf8 githubOrg `BS.append` "/members/" `BS.append` encodeUtf8 gitLogin+ let url = githubUri $ "/orgs/" `BS.append` encodeUtf8 githubOrg `BS.append` "/members/" `BS.append` encodeUtf8 gitLogin authGetBS mgr token url +type UriPath = BS.ByteString++githubUri :: UriPath -> URI.URI+githubUri p = URI.URI { URI.uriScheme = URI.Scheme "https"+ , URI.uriAuthority = Just $ URI.Authority Nothing (URI.Host "api.github.com") Nothing+ , URI.uriPath = p+ , URI.uriQuery = URI.Query []+ , URI.uriFragment = Nothing }+ data GithubUser = GithubUser { gLogin :: Text } deriving (Show, Eq) @@ -125,6 +139,3 @@ <$> o .: "email" <*> o .: "primary" parseJSON _ = mzero--sToBS :: String -> BS.ByteString-sToBS = encodeUtf8 . pack
src/Network/Gitit/Config.hs view
@@ -35,24 +35,20 @@ import Data.ConfigFile hiding (readfile) import Data.List (intercalate) import Data.Char (toLower, toUpper, isDigit)-import Data.Text (pack)+import qualified Data.Text as T import Paths_gitit (getDataFileName) import System.FilePath ((</>))-import Text.Pandoc hiding (MathML, WebTeX, MathJax)+import Text.Pandoc hiding (ERROR, WARNING, MathJax, MathML, WebTeX, getDataFileName) import qualified Control.Exception as E-import Network.OAuth.OAuth2+import Network.OAuth.OAuth2 (OAuth2(..), oauthCallback, oauthOAuthorizeEndpoint, oauthClientId, oauthClientSecret)+import URI.ByteString (parseURI, laxURIParserOptions) import qualified Data.ByteString.Char8 as BS import Network.Gitit.Compat.Except import Control.Monad import Control.Monad.Trans--#if MIN_VERSION_pandoc(1,14,0) import Text.Pandoc.Error (handleError)-#else-handleError :: Pandoc -> Pandoc-handleError = id-#endif + forceEither :: Show e => Either e a -> a forceEither = either (error . show) id @@ -83,7 +79,7 @@ -> IO (m ConfigParser) readfile cp path' = do contents <- readFileUTF8 path'- return $ readstring cp contents+ return $ readstring cp $ T.unpack contents extractConfig :: ConfigParser -> IO Config extractConfig cp = do@@ -141,9 +137,10 @@ let (pt, lhs) = parsePageType cfDefaultPageType let markupHelpFile = show pt ++ if lhs then "+LHS" else "" markupHelpPath <- liftIO $ getDataFileName $ "data" </> "markupHelp" </> markupHelpFile- markupHelpText <- liftM (writeHtmlString def . handleError .- readMarkdown def) $- liftIO $ readFileUTF8 markupHelpPath+ markupHelp' <- liftIO $ readFileUTF8 markupHelpPath+ markupHelpText <- liftIO $ handleError $ runPure $ do + helpDoc <- readMarkdown def{ readerExtensions = getDefaultExtensions "markdown" } markupHelp'+ writeHtml5String def helpDoc mimeMap' <- liftIO $ readMimeTypesFile cfMimeTypesFile let authMethod = map toLower cfAuthenticationMethod@@ -166,7 +163,6 @@ , defaultPageType = pt , defaultExtension = cfDefaultExtension , mathMethod = case map toLower cfMathMethod of- "jsmath" -> JsMathScript "mathml" -> MathML "mathjax" -> MathJax cfMathjaxScript "google" -> WebTeX "http://chart.apis.google.com/chart?cht=tx&chl="@@ -253,21 +249,28 @@ extractGithubConfig cp = do cfOauthClientId <- getGithubProp "oauthClientId" cfOauthClientSecret <- getGithubProp "oauthClientSecret"- cfOauthCallback <- getGithubProp "oauthCallback"- cfOauthOAuthorizeEndpoint <- getGithubProp "oauthOAuthorizeEndpoint"- cfOauthAccessTokenEndpoint <- getGithubProp "oauthAccessTokenEndpoint"+ cfOauthCallback <- getUrlProp "oauthCallback"+ cfOauthOAuthorizeEndpoint <- getUrlProp "oauthOAuthorizeEndpoint"+ cfOauthAccessTokenEndpoint <- getUrlProp "oauthAccessTokenEndpoint" cfOrg <- if hasGithubProp "github-org" then fmap Just (getGithubProp "github-org") else return Nothing- let cfgOAuth2 = OAuth2 { oauthClientId = BS.pack cfOauthClientId- , oauthClientSecret = BS.pack cfOauthClientSecret- , oauthCallback = Just $ BS.pack cfOauthCallback- , oauthOAuthorizeEndpoint = BS.pack cfOauthOAuthorizeEndpoint- , oauthAccessTokenEndpoint = BS.pack cfOauthAccessTokenEndpoint+ let cfgOAuth2 = OAuth2 { oauthClientId = T.pack cfOauthClientId+ , oauthClientSecret = T.pack cfOauthClientSecret+ , oauthCallback = Just cfOauthCallback+ , oauthOAuthorizeEndpoint = cfOauthOAuthorizeEndpoint+ , oauthAccessTokenEndpoint = cfOauthAccessTokenEndpoint }- return $ githubConfig cfgOAuth2 $ fmap pack cfOrg+ return $ githubConfig cfgOAuth2 $ fmap T.pack cfOrg where getGithubProp = get cp "Github" hasGithubProp = has_option cp "Github"+ getUrlProp prop = getGithubProp prop >>= \s ->+ case parseURI laxURIParserOptions (BS.pack s) of+ Left e -> throwError (ParseError $ "couldn't parse url " ++ s+ ++ " from (Github/" ++ prop ++ "): "+ ++ (show e)+ , "getUrlProp")+ Right uri -> return uri fromQuotedMultiline :: String -> String fromQuotedMultiline = unlines . map doline . lines . dropWhile (`elem` " \t\n")@@ -315,7 +318,7 @@ -- extensions, separated by spaces. Example: text/plain txt text readMimeTypesFile :: FilePath -> IO (M.Map String String) readMimeTypesFile f = E.catch- (liftM (foldr (go . words) M.empty . lines) $ readFileUTF8 f)+ (liftM (foldr (go . words) M.empty . lines . T.unpack) $ readFileUTF8 f) handleMimeTypesFileNotFound where go [] m = m -- skip blank lines go (x:xs) m = foldr (`M.insert` x) m xs
src/Network/Gitit/ContentTransformer.hs view
@@ -73,8 +73,10 @@ import Control.Monad.State import Control.Monad.Reader (ask) import Data.Foldable (traverse_)+import Data.Char (toLower) import Data.List (stripPrefix) import Data.Maybe (isNothing, mapMaybe)+import Data.Semigroup ((<>)) import Network.Gitit.Cache (lookupCache, cacheContents) import Network.Gitit.Export (exportFormats) import Network.Gitit.Framework hiding (uriPath)@@ -83,13 +85,15 @@ import Network.Gitit.Server import Network.Gitit.State import Network.Gitit.Types+import Network.Gitit.Util (getPageTypeDefaultExtensions) import Network.HTTP (urlDecode) import Network.URI (isUnescapedInURI) import Network.URL (encString) import System.FilePath import qualified Text.Pandoc.Builder as B+import Text.Pandoc.Extensions (getDefaultExtensions) import Text.HTML.SanitizeXSS (sanitizeBalance)-import Text.Highlighting.Kate+import Skylighting hiding (Context) import Text.Pandoc hiding (MathML, WebTeX, MathJax) import Text.XHtml hiding ( (</>), dir, method, password, rev ) import Text.XHtml.Strict (stringToHtmlString)@@ -99,7 +103,6 @@ import Text.Blaze.Renderer.String as Blaze ( renderHtml ) #endif import qualified Data.Text as T-import qualified Data.Set as Set import qualified Data.ByteString as S (concat) import qualified Data.ByteString.Char8 as SC (unpack) import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)@@ -107,12 +110,6 @@ import qualified Text.Pandoc as Pandoc import Text.URI (parseURI, URI(..), uriQueryItems) -#if MIN_VERSION_pandoc(1,14,0)-import Text.Pandoc.Error (handleError)-#else-handleError :: Pandoc -> Pandoc-handleError = id-#endif -- -- ContentTransformer runners --@@ -362,7 +359,7 @@ modifyContext $ \ctx -> ctx{ ctxTOC = pageTOC page' , ctxCategories = pageCategories page' , ctxMeta = pageMeta page' }- return $ readerFor (pageFormat page') (pageLHS page') (pageText page')+ either (liftIO . E.throwIO) return $ readerFor (pageFormat page') (pageLHS page') (pageText page') -- | Detects if the page is a redirect page and handles accordingly. The exact -- behaviour is as follows:@@ -525,32 +522,24 @@ -- | Converts pandoc document to HTML. pandocToHtml :: Pandoc -> ContentTransformer Html pandocToHtml pandocContents = do- base' <- lift getWikiBase toc <- liftM ctxTOC get bird <- liftM ctxBirdTracks get cfg <- lift getConfig let tpl = "$if(toc)$<div id=\"TOC\">\n$toc$\n</div>\n$endif$\n$body$" return $ primHtml $ T.unpack .- (if xssSanitize cfg then sanitizeBalance else id) . T.pack $- writeHtmlString def{-#if MIN_VERSION_pandoc(1,19,0)+ (if xssSanitize cfg then sanitizeBalance else id) $+ either E.throw id . runPure $ writeHtml5String def{ writerTemplate = Just tpl-#else- writerStandalone = True- , writerTemplate = tpl-#endif , writerHTMLMathMethod = case mathMethod cfg of- MathML -> Pandoc.MathML Nothing+ MathML -> Pandoc.MathML WebTeX u -> Pandoc.WebTeX u MathJax u -> Pandoc.MathJax u- _ -> JsMath (Just $ base' ++- "/js/jsMath/easy/load.js")+ RawTeX -> Pandoc.PlainMath , writerTableOfContents = toc- , writerHighlight = True+ , writerHighlightStyle = Just pygments , writerExtensions = if bird- then Set.insert- Ext_literate_haskell+ then enableExtension Ext_literate_haskell $ writerExtensions def else writerExtensions def -- note: javascript obfuscation gives problems on preview@@ -563,11 +552,15 @@ highlightSource (Just source) = do file <- getFileName let formatOpts = defaultFormatOpts { numberLines = True, lineAnchors = True }- case languagesByExtension $ takeExtension file of+ case syntaxesByFilename defaultSyntaxMap file of [] -> mzero- (l:_) -> return $ primHtml $ Blaze.renderHtml- $ formatHtmlBlock formatOpts- $! highlightAs l $ filter (/='\r') source+ (l:_) -> case tokenize TokenizerConfig{+ syntaxMap = defaultSyntaxMap+ , traceOutput = False} l+ $ T.pack $ filter (/='\r') source of+ Left e -> fail (show e)+ Right r -> return $ primHtml $ Blaze.renderHtml+ $ formatHtmlBlock formatOpts r -- -- Plugin combinators@@ -651,7 +644,6 @@ conf <- lift getConfig updateLayout $ \l -> case mathMethod conf of- JsMathScript -> addScripts l ["jsMath/easy/load.js"] MathML -> addScripts l ["MathMLinHTML.js"] WebTeX _ -> l MathJax u -> addScripts l [u]@@ -693,29 +685,23 @@ -- Pandoc and wiki content conversion support -- -readerFor :: PageType -> Bool -> String -> Pandoc+readerFor :: PageType -> Bool -> String -> Either PandocError Pandoc readerFor pt lhs =- let defPS = def{ readerSmart = True- , readerExtensions = if lhs- then Set.insert Ext_literate_haskell- $ readerExtensions def- else readerExtensions def- , readerParseRaw = True- }- in handleError . case pt of+ let defExts = getDefaultExtensions $ map toLower $ show pt+ defPS = def{ readerExtensions = defExts+ <> extensionsFromList [Ext_emoji]+ <> getPageTypeDefaultExtensions pt lhs+ <> readerExtensions def }+ in runPure . (case pt of RST -> readRST defPS Markdown -> readMarkdown defPS-#if MIN_VERSION_pandoc(1,14,0) CommonMark -> readCommonMark defPS-#else- CommonMark -> error "CommonMark input requires pandoc 1.14"-#endif LaTeX -> readLaTeX defPS HTML -> readHtml defPS Textile -> readTextile defPS Org -> readOrg defPS DocBook -> readDocBook defPS- MediaWiki -> readMediaWiki defPS+ MediaWiki -> readMediaWiki defPS) . T.pack wikiLinksTransform :: Pandoc -> PluginM Pandoc wikiLinksTransform pandoc@@ -724,17 +710,10 @@ -- | Convert links with no URL to wikilinks. convertWikiLinks :: Config -> Inline -> Inline-#if MIN_VERSION_pandoc(1,16,0) convertWikiLinks cfg (Link attr ref ("", "")) | useAbsoluteUrls cfg = Link attr ref ("/" </> baseUrl cfg </> inlinesToURL ref, "Go to wiki page") convertWikiLinks _cfg (Link attr ref ("", "")) = Link attr ref (inlinesToURL ref, "Go to wiki page")-#else-convertWikiLinks cfg (Link ref ("", "")) | useAbsoluteUrls cfg =- Link ref ("/" </> baseUrl cfg </> inlinesToURL ref, "Go to wiki page")-convertWikiLinks _cfg (Link ref ("", "")) =- Link ref (inlinesToURL ref, "Go to wiki page")-#endif convertWikiLinks _cfg x = x -- | Derives a URL from a list of Pandoc Inline elements.@@ -757,21 +736,14 @@ Cite _ xs -> concatMap go xs Code _ s -> s Space -> " "-#if MIN_VERSION_pandoc(1,16,0) SoftBreak -> " "-#endif LineBreak -> " " Math DisplayMath s -> "$$" ++ s ++ "$$" Math InlineMath s -> "$" ++ s ++ "$" RawInline (Format "tex") s -> s RawInline _ _ -> ""-#if MIN_VERSION_pandoc(1,16,0) Link _ xs _ -> concatMap go xs Image _ xs _ -> concatMap go xs-#else- Link xs _ -> concatMap go xs- Image xs _ -> concatMap go xs-#endif Note _ -> "" Span _ xs -> concatMap go xs
src/Network/Gitit/Export.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {- Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu> @@ -21,14 +20,14 @@ -} module Network.Gitit.Export ( exportFormats ) where-import Text.Pandoc hiding (HTMLMathMethod(..))+import Control.Exception (throwIO)+import Text.Pandoc hiding (HTMLMathMethod(..), getDataFileName) import qualified Text.Pandoc as Pandoc import Text.Pandoc.PDF (makePDF) import Text.Pandoc.SelfContained as SelfContained-import Text.Pandoc.Shared (readDataFileUTF8) import qualified Text.Pandoc.UTF8 as UTF8 import Network.Gitit.Server-import Network.Gitit.Framework (pathForPage, getWikiBase)+import Network.Gitit.Framework (pathForPage) import Network.Gitit.State (getConfig) import Network.Gitit.Types import Network.Gitit.Cache (cacheContents, lookupCache)@@ -38,118 +37,87 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import System.FilePath ((</>), takeDirectory)-import Control.Exception (throwIO) import System.Directory (doesFileExist) import Text.HTML.SanitizeXSS-import Text.Pandoc.Writers.RTF (writeRTFWithEmbeddedImages)+import Text.Pandoc.Writers.RTF (writeRTF)+import Data.ByteString.Lazy (fromStrict)+import Data.Text (Text) import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8) import Data.List (isPrefixOf)-import Text.Highlighting.Kate (styleToCss, pygments)+import Skylighting (styleToCss, pygments) import Paths_gitit (getDataFileName) defaultRespOptions :: WriterOptions-defaultRespOptions = def { writerHighlight = True }--respond :: String- -> String- -> (Pandoc -> IO L.ByteString)- -> String- -> Pandoc- -> Handler-respond mimetype ext fn page doc = liftIO (fn doc) >>=- ok . setContentType mimetype .- (if null ext then id else setFilename (page ++ "." ++ ext)) .- toResponseBS B.empty+defaultRespOptions = def { writerHighlightStyle = Just pygments } respondX :: String -> String -> String- -> (WriterOptions -> Pandoc -> IO L.ByteString)+ -> (WriterOptions -> Pandoc -> PandocIO L.ByteString) -> WriterOptions -> String -> Pandoc -> Handler respondX templ mimetype ext fn opts page doc = do cfg <- getConfig- template' <- liftIO $ getDefaultTemplate (pandocUserData cfg) templ- template <- case template' of- Right t -> return t- Left e -> liftIO $ throwIO e doc' <- if ext `elem` ["odt","pdf","beamer","epub","docx","rtf"] then fixURLs page doc else return doc- respond mimetype ext (fn opts{-#if MIN_VERSION_pandoc(1,19,0)- writerTemplate = Just template-#else- writerTemplate = template- ,writerStandalone = True-#endif- ,writerUserDataDir = pandocUserData cfg})- page doc'+ doc'' <- liftIO $ runIO $ do+ setUserDataDir $ pandocUserData cfg+ template <- getDefaultTemplate templ+ fn opts{ writerTemplate = Just template } doc'+ either (liftIO . throwIO)+ (ok . setContentType mimetype .+ (if null ext then id else setFilename (page ++ "." ++ ext)) .+ toResponseBS B.empty)+ doc'' -respondS :: String -> String -> String -> (WriterOptions -> Pandoc -> String)+respondS :: String -> String -> String -> (WriterOptions -> Pandoc -> PandocIO Text) -> WriterOptions -> String -> Pandoc -> Handler respondS templ mimetype ext fn =- respondX templ mimetype ext (\o d -> return $ UTF8.fromStringLazy $ fn o d)+ respondX templ mimetype ext (\o d -> fromStrict . encodeUtf8 <$> fn o d) -respondSlides :: String -> HTMLSlideVariant -> String -> Pandoc -> Handler-respondSlides templ slideVariant page doc = do+respondSlides :: String -> (WriterOptions -> Pandoc -> PandocIO Text) -> String -> Pandoc -> Handler+respondSlides templ fn page doc = do cfg <- getConfig- base' <- getWikiBase let math = case mathMethod cfg of- MathML -> Pandoc.MathML Nothing+ MathML -> Pandoc.MathML WebTeX u -> Pandoc.WebTeX u- JsMathScript -> Pandoc.JsMath- (Just $ base' ++ "/js/jsMath/easy/load.js") _ -> Pandoc.PlainMath- let opts' = defaultRespOptions {- writerSlideVariant = slideVariant- ,writerIncremental = True- ,writerHtml5 = templ == "dzslides"- ,writerHTMLMathMethod = math}+ let opts' = defaultRespOptions { writerIncremental = True+ , writerHTMLMathMethod = math} -- We sanitize the body only, to protect against XSS attacks. -- (Sanitizing the whole HTML page would strip out javascript -- needed for the slides.) We then pass the body into the -- slide template using the 'body' variable. Pandoc meta blocks <- fixURLs page doc- let body' = writeHtmlString opts' (Pandoc meta blocks) -- just body- let body'' = T.unpack- $ (if xssSanitize cfg then sanitizeBalance else id)- $ T.pack body'- variables' <- if mathMethod cfg == MathML- then do- s <- liftIO $ readDataFileUTF8 (pandocUserData cfg)- "MathMLinHTML.js"- return [("mathml-script", s)]- else return []- template' <- liftIO $ getDefaultTemplate (pandocUserData cfg) templ- template <- case template' of- Right t -> return t- Left e -> liftIO $ throwIO e- dzcore <- if templ == "dzslides"- then do- dztempl <- liftIO $ readDataFileUTF8 (pandocUserData cfg)- $ "dzslides" </> "template.html"- return $ unlines- $ dropWhile (not . isPrefixOf "<!-- {{{{ dzslides core")- $ lines dztempl- else return ""- let opts'' = opts'{- writerVariables =- ("body",body''):("dzslides-core",dzcore):("highlighting-css",pygmentsCss):variables'-#if MIN_VERSION_pandoc(1,19,0)- ,writerTemplate = Just template-#else- ,writerTemplate = template- ,writerStandalone = True-#endif- ,writerUserDataDir = pandocUserData cfg- }- let h = writeHtmlString opts'' (Pandoc meta [])-#if MIN_VERSION_pandoc(1,13,0)- h' <- liftIO $ makeSelfContained opts'' h-#else- h' <- liftIO $ makeSelfContained (pandocUserData cfg) h-#endif- ok . setContentType "text/html;charset=UTF-8" .- -- (setFilename (page ++ ".html")) .- toResponseBS B.empty $ UTF8.fromStringLazy h'+ docOrError <- liftIO $ runIO $ do + setUserDataDir $ pandocUserData cfg+ body' <- writeHtml5String opts' (Pandoc meta blocks) -- just body+ let body'' = T.unpack+ $ (if xssSanitize cfg then sanitizeBalance else id)+ $ body'+ variables' <- if mathMethod cfg == MathML+ then do+ s <- readDataFile "MathMLinHTML.js"+ return [("mathml-script", UTF8.toString s)]+ else return []+ template <- getDefaultTemplate templ+ dzcore <- if templ == "dzslides"+ then do+ dztempl <- readDataFile $ "dzslides" </> "template.html"+ return $ unlines+ $ dropWhile (not . isPrefixOf "<!-- {{{{ dzslides core")+ $ lines $ UTF8.toString dztempl+ else return ""+ let opts'' = opts'{+ writerVariables =+ ("body",body''):("dzslides-core",dzcore):("highlighting-css",pygmentsCss):variables'+ ,writerTemplate = Just template }+ h <- fn opts'' (Pandoc meta [])+ makeSelfContained (T.unpack h)+ either (liftIO . throwIO)+ (ok . setContentType "text/html;charset=UTF-8" .+ (setFilename (page ++ ".html")) .+ toResponseBS B.empty . UTF8.fromStringLazy)+ docOrError respondLaTeX :: String -> Pandoc -> Handler respondLaTeX = respondS "latex" "application/x-latex" "tex"@@ -162,7 +130,7 @@ respondRTF :: String -> Pandoc -> Handler respondRTF = respondX "rtf" "application/rtf" "rtf"- (\o d -> UTF8.fromStringLazy `fmap` writeRTFWithEmbeddedImages o d) defaultRespOptions+ (\o d -> L.fromStrict . UTF8.fromText <$> writeRTF o d) defaultRespOptions respondRST :: String -> Pandoc -> Handler respondRST = respondS "rst" "text/plain; charset=utf-8" ""@@ -172,11 +140,9 @@ respondMarkdown = respondS "markdown" "text/plain; charset=utf-8" "" writeMarkdown defaultRespOptions{writerReferenceLinks = True} -#if MIN_VERSION_pandoc(1,14,0) respondCommonMark :: String -> Pandoc -> Handler respondCommonMark = respondS "commonmark" "text/plain; charset=utf-8" "" writeCommonMark defaultRespOptions{writerReferenceLinks = True}-#endif respondPlain :: String -> Pandoc -> Handler respondPlain = respondS "plain" "text/plain; charset=utf-8" ""@@ -192,21 +158,16 @@ respondDocbook :: String -> Pandoc -> Handler respondDocbook = respondS "docbook" "application/docbook+xml" "xml"- writeDocbook defaultRespOptions+ writeDocbook5 defaultRespOptions respondOrg :: String -> Pandoc -> Handler respondOrg = respondS "org" "text/plain; charset=utf-8" "" writeOrg defaultRespOptions -#if MIN_VERSION_pandoc(1,16,0) respondICML :: String -> Pandoc -> Handler respondICML = respondX "icml" "application/xml; charset=utf-8" ""- (\o d -> fmap UTF8.fromStringLazy $ writeICML o d)+ (\o d -> L.fromStrict . UTF8.fromText <$> writeICML o d) defaultRespOptions-#else-respondICML = respondS "icml" "application/xml; charset=utf-8" ""- writeICML defaultRespOptions-#endif respondTextile :: String -> Pandoc -> Handler respondTextile = respondS "textile" "text/plain; charset=utf-8" ""@@ -225,7 +186,7 @@ "odt" writeODT defaultRespOptions respondEPUB :: String -> Pandoc -> Handler-respondEPUB = respondX "html" "application/epub+zip" "epub" writeEPUB+respondEPUB = respondX "html" "application/epub+zip" "epub" writeEPUB3 defaultRespOptions respondDocx :: String -> Pandoc -> Handler@@ -244,25 +205,19 @@ pdf' <- case cached of Just (_modtime, bs) -> return $ Right $ L.fromChunks [bs] Nothing -> do- template' <- liftIO $ getDefaultTemplate (pandocUserData cfg)- $ if useBeamer then "beamer" else "latex"- template <- liftIO $ either throwIO return template' let toc = tableOfContents cfg- res <- liftIO $ makePDF "pdflatex" writeLaTeX- defaultRespOptions{-#if MIN_VERSION_pandoc(1,19,0)- writerTemplate = Just template-#else- writerTemplate = template- ,writerStandalone = True-#endif- ,writerSourceURL = Just $ baseUrl cfg- ,writerTableOfContents = toc- ,writerBeamer = useBeamer} pndc- return res+ res <- liftIO $ runIO $ do+ setUserDataDir $ pandocUserData cfg+ setInputFiles [baseUrl cfg]+ template <- getDefaultTemplate $ if useBeamer then "beamer" else "latex"+ makePDF "pdflatex" [] (if useBeamer then writeBeamer else writeLaTeX)+ defaultRespOptions{ writerTemplate = Just template+ , writerTableOfContents = toc } pndc+ either (liftIO . throwIO) return res+ case pdf' of- Left logOutput -> simpleErrorHandler ("PDF creation failed:\n"- ++ UTF8.toStringLazy logOutput)+ Left logOutput' -> simpleErrorHandler ("PDF creation failed:\n"+ ++ UTF8.toStringLazy logOutput') Right pdfBS -> do case cached of Nothing ->@@ -286,15 +241,9 @@ let static = staticDir cfg let repoPath = repositoryPath cfg -#if MIN_VERSION_pandoc(1,16,0) let go (Image attr ils (url, title)) = do fixedURL <- fixURL url return $ Image attr ils (fixedURL, title)-#else- let go (Image ils (url, title)) = do- fixedURL <- fixURL url- return $ Image ils (fixedURL, title)-#endif go x = return x fixURL ('/':url) = resolve url@@ -319,9 +268,7 @@ , ("Texinfo", respondTexinfo) , ("reST", respondRST) , ("Markdown", respondMarkdown)-#if MIN_VERSION_pandoc(1,14,0) , ("CommonMark",respondCommonMark)-#endif , ("Plain text",respondPlain) , ("MediaWiki", respondMediaWiki) , ("Org-mode", respondOrg)@@ -330,9 +277,9 @@ , ("AsciiDoc", respondAsciiDoc) , ("Man page", respondMan) , ("DocBook", respondDocbook)- , ("DZSlides", respondSlides "dzslides" DZSlides)- , ("Slidy", respondSlides "slidy" SlidySlides)- , ("S5", respondSlides "s5" S5Slides)+ , ("DZSlides", respondSlides "dzslides" writeDZSlides)+ , ("Slidy", respondSlides "slidy" writeSlidy)+ , ("S5", respondSlides "s5" writeS5) , ("EPUB", respondEPUB) , ("ODT", respondODT) , ("DOCX", respondDocx)
src/Network/Gitit/Feed.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2009 Gwern Branwen <gwern0@gmail.com> and John MacFarlane <jgm@berkeley.edu>@@ -21,6 +22,8 @@ module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where +import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Data.Time (UTCTime, formatTime, getCurrentTime, addUTCTime) #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale)@@ -40,7 +43,9 @@ Date, Entry(..), Feed(..), Link(linkRel), Generator(..), Person(personName), EntryContent(..), TextContent(TextString)) import Text.Atom.Feed.Export (xmlFeed)-import Text.XML.Light (ppTopElement, showContent, Content(..), Element(..), blank_element, QName(..), blank_name, CData(..), blank_cdata)+import Text.XML.Light as XML (showContent, Content(..), Element(..), blank_element, QName(..), blank_name, CData(..), blank_cdata)+import Text.XML as Text.XML (renderText, Document(..), Element(..),+ Prologue(..), def, fromXMLElement) import Data.Version (showVersion) import Paths_gitit (version) @@ -52,14 +57,20 @@ gititGenerator :: Generator gititGenerator = Generator {genURI = Just "http://github.com/jgm/gitit"- , genVersion = Just (showVersion version)+ , genVersion = Just (T.pack (showVersion version)) , genText = "gitit"} filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg gititGenerator f xmlFeedToString :: Feed -> String-xmlFeedToString = ppTopElement . xmlFeed+xmlFeedToString elt = TL.unpack . renderText def $+ Document{ documentPrologue = Prologue{ prologueBefore = []+ , prologueDoctype = Nothing+ , prologueAfter = [] }+ , documentRoot = either (const $ Text.XML.Element "feed" mempty []) id+ $ fromXMLElement $ xmlFeed elt+ , documentEpilogue = [] } generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe FilePath -> IO Feed generateFeed cfg generator fs mbPath = do@@ -69,7 +80,7 @@ let home = fcBaseUrl cfg ++ "/" -- TODO: 'nub . sort' `persons` - but no Eq or Ord instances! persons = map authorToPerson $ nub $ sortBy (comparing authorName) $ map revAuthor revs- basefeed = generateEmptyfeed generator (fcTitle cfg) home mbPath persons (formatFeedTime now)+ basefeed = generateEmptyfeed generator (fcTitle cfg) home mbPath persons (T.pack (formatFeedTime now)) revisions = map (revisionToEntry home) (zip revs diffs) return basefeed {feedEntries = revisions} @@ -110,21 +121,23 @@ generateEmptyfeed generator title home mbPath authors now = baseNull {feedAuthors = authors, feedGenerator = Just generator,- feedLinks = [ (nullLink $ home ++ "_feed/" ++ escape (fromMaybe "" mbPath))+ feedLinks = [ (nullLink $ T.pack $+ home ++ "_feed/" ++ escape (fromMaybe "" mbPath)) {linkRel = Just (Left "self")}] }- where baseNull = nullFeed home (TextString title) now+ where baseNull = nullFeed (T.pack home) (TextString (T.pack title)) now revisionToEntry :: String -> (Revision, [(FilePath, [Diff [String]])]) -> Entry revisionToEntry home (Revision{ revId = rid, revDateTime = rdt, revAuthor = ra, revDescription = rd, revChanges = rv}, diffs) =- baseEntry{ entryContent = Just $ HTMLContent $ concat $ map showContent $ map diffFile diffs+ baseEntry{ entryContent = Just $ HTMLContent $ T.pack $ concat $ map showContent $ map diffFile diffs , entryAuthors = [authorToPerson ra], entryLinks = [ln] }- where baseEntry = nullEntry url title (formatFeedTime rdt)+ where baseEntry = nullEntry (T.pack url) title+ (T.pack $ formatFeedTime rdt) url = home ++ escape (extract $ head rv) ++ "?revision=" ++ rid- ln = (nullLink url) {linkRel = Just (Left "alternate")}- title = TextString $ (takeWhile ('\n' /=) rd) ++ " - " ++ (intercalate ", " $ map show rv)+ ln = (nullLink (T.pack url)) {linkRel = Just (Left "alternate")}+ title = TextString $ T.pack $ (takeWhile ('\n' /=) rd) ++ " - " ++ (intercalate ", " $ map show rv) diffFile :: (FilePath, [Diff [String]]) -> Content diffFile (fp, d) =@@ -149,7 +162,7 @@ -- gitit is set up not to reveal registration emails authorToPerson :: Author -> Person-authorToPerson ra = nullPerson {personName = authorName ra}+authorToPerson ra = nullPerson {personName = T.pack $ authorName ra} -- TODO: replace with Network.URI version of shortcut if it ever is added escape :: String -> String
src/Network/Gitit/Framework.hs view
@@ -65,10 +65,10 @@ import qualified Data.Map as M import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8+import Skylighting (syntaxesByFilename, defaultSyntaxMap) import Data.Maybe (fromJust, fromMaybe) import Data.List (intercalate, isPrefixOf, isInfixOf) import System.FilePath ((<.>), takeExtension, takeFileName)-import Text.Highlighting.Kate import Text.ParserCombinators.Parsec import Network.URL (decString, encString) import Network.URI (isUnescapedInURI)@@ -277,7 +277,7 @@ isSourceCode :: String -> Bool isSourceCode path' =- let langs = languagesByFilename $ takeFileName path'+ let langs = syntaxesByFilename defaultSyntaxMap $ takeFileName path' ext = takeExtension path' in not (null langs || ext == ".svg" || ext == ".eps") -- allow svg or eps to be served as image
src/Network/Gitit/Handlers.hs view
@@ -551,7 +551,6 @@ ] let pgScripts' = ["preview.js"] let pgScripts'' = case mathMethod cfg of- JsMathScript -> "jsMath/easy/load.js" : pgScripts' MathML -> "MathMLinHTML.js" : pgScripts' MathJax url -> url : pgScripts' _ -> pgScripts'
src/Network/Gitit/Initialize.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify@@ -26,9 +27,11 @@ , createTemplateIfMissing ) where import System.FilePath ((</>), (<.>))+import Data.Semigroup ((<>))+import Data.Text (Text)+import qualified Data.Text as T import Data.FileStore import qualified Data.Map as M-import qualified Data.Set as Set import Network.Gitit.Util (readFileUTF8) import Network.Gitit.Types import Network.Gitit.State@@ -38,17 +41,11 @@ import Paths_gitit (getDataFileName) import Control.Exception (throwIO, try) import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)-import Control.Monad (unless, forM_, liftM)-import Text.Pandoc+import Control.Monad ((<=<), unless, forM_, liftM)+import Text.Pandoc hiding (getDataFileName, WARNING) import System.Log.Logger (logM, Priority(..))-import qualified Text.StringTemplate as T+import qualified Text.StringTemplate as ST -#if MIN_VERSION_pandoc(1,14,0)-import Text.Pandoc.Error (handleError)-#else-handleError :: Pandoc -> Pandoc-handleError = id-#endif -- | Initialize Gitit State. initializeGititState :: Config -> IO ()@@ -59,7 +56,7 @@ userFileExists <- doesFileExist userFile' users' <- if userFileExists- then liftM (M.fromList . read) $ readFileUTF8 userFile'+ then liftM (M.fromList . read . T.unpack) $ readFileUTF8 userFile' else return M.empty templ <- compilePageTemplate (templatesDir conf)@@ -78,19 +75,19 @@ updateGititState $ \st -> st{renderPage = defaultRenderPage ct} --- | Compile a master page template named @page.st@ in the directory specified.-compilePageTemplate :: FilePath -> IO (T.StringTemplate String)+compilePageTemplate :: FilePath -> IO (ST.StringTemplate String) compilePageTemplate tempsDir = do- defaultGroup <- getDataFileName ("data" </> "templates") >>= T.directoryGroup+ defaultGroup <- getDataFileName ("data" </> "templates") >>= ST.directoryGroup customExists <- doesDirectoryExist tempsDir combinedGroup <- if customExists -- default templates from data directory will be "shadowed" -- by templates from the user's template dir- then do customGroup <- T.directoryGroup tempsDir- return $ T.mergeSTGroups customGroup defaultGroup+ then do customGroup <- ST.directoryGroup tempsDir+ return $ ST.mergeSTGroups customGroup defaultGroup else do logM "gitit" WARNING $ "Custom template directory not found" return defaultGroup- case T.getStringTemplate "page" combinedGroup of+ case ST.getStringTemplate "page" combinedGroup of Just t -> return t Nothing -> error "Could not get string template" @@ -126,56 +123,50 @@ createDefaultPages conf = do let fs = filestoreFromConfig conf pt = defaultPageType conf- toPandoc = handleError . readMarkdown def{ readerSmart = True }- defOpts = def{ writerHTMLMathMethod = JsMath- (Just "/js/jsMath/easy/load.js")- , writerExtensions = if showLHSBirdTracks conf- then Set.insert+ toPandoc = readMarkdown def{ readerExtensions = enableExtension Ext_smart (readerExtensions def) }+ defOpts = def{ writerExtensions = if showLHSBirdTracks conf+ then enableExtension Ext_literate_haskell $ writerExtensions def else writerExtensions def } -- note: we convert this (markdown) to the default page format- converter = case pt of- Markdown -> id- LaTeX -> writeLaTeX defOpts . toPandoc- HTML -> writeHtmlString defOpts . toPandoc- RST -> writeRST defOpts . toPandoc- Textile -> writeTextile defOpts . toPandoc- Org -> writeOrg defOpts . toPandoc- DocBook -> writeDocbook defOpts . toPandoc- MediaWiki -> writeMediaWiki defOpts . toPandoc-#if MIN_VERSION_pandoc(1,14,0)- CommonMark -> writeCommonMark defOpts . toPandoc-#else- CommonMark -> error "CommonMark support requires pandoc >= 1.14"-#endif+ converter = handleError . runPure . case pt of+ Markdown -> return+ LaTeX -> writeLaTeX defOpts <=< toPandoc+ HTML -> writeHtml5String defOpts <=< toPandoc+ RST -> writeRST defOpts <=< toPandoc+ Textile -> writeTextile defOpts <=< toPandoc+ Org -> writeOrg defOpts <=< toPandoc+ DocBook -> writeDocbook5 defOpts <=< toPandoc+ MediaWiki -> writeMediaWiki defOpts <=< toPandoc+ CommonMark -> writeCommonMark defOpts <=< toPandoc welcomepath <- getDataFileName $ "data" </> "FrontPage" <.> "page"- welcomecontents <- liftM converter $ readFileUTF8 welcomepath+ welcomecontents <- converter =<< readFileUTF8 welcomepath helppath <- getDataFileName $ "data" </> "Help" <.> "page"- helpcontentsInitial <- liftM converter $ readFileUTF8 helppath+ helpcontentsInitial <- converter =<< readFileUTF8 helppath markuppath <- getDataFileName $ "data" </> "markup" <.> show pt- helpcontentsMarkup <- liftM converter $ readFileUTF8 markuppath- let helpcontents = helpcontentsInitial ++ "\n\n" ++ helpcontentsMarkup+ helpcontentsMarkup <- converter =<< readFileUTF8 markuppath+ let helpcontents = helpcontentsInitial <> "\n\n" <> helpcontentsMarkup usersguidepath <- getDataFileName "README.markdown"- usersguidecontents <- liftM converter $ readFileUTF8 usersguidepath+ usersguidecontents <- converter =<< readFileUTF8 usersguidepath -- include header in case user changes default format:- let header = "---\nformat: " ++- show pt ++ (if defaultLHS conf then "+lhs" else "") +++ let header = "---\nformat: " <>+ T.pack (show pt) <> (if defaultLHS conf then "+lhs" else "") <> "\n...\n\n" -- add front page, help page, and user's guide let auth = Author "Gitit" "" createIfMissing fs (frontPage conf <.> defaultExtension conf) auth "Default front page"- $ header ++ welcomecontents+ $ header <> welcomecontents createIfMissing fs ("Help" <.> defaultExtension conf) auth "Default help page"- $ header ++ helpcontents+ $ header <> helpcontents createIfMissing fs ("Gitit User’s Guide" <.> defaultExtension conf) auth "User’s guide (README)"- $ header ++ usersguidecontents+ $ header <> usersguidecontents -createIfMissing :: FileStore -> FilePath -> Author -> Description -> String -> IO ()+createIfMissing :: FileStore -> FilePath -> Author -> Description -> Text -> IO () createIfMissing fs p a comm cont = do- res <- try $ create fs p a comm cont+ res <- try $ create fs p a comm (T.unpack cont) case res of Right _ -> logM "gitit" WARNING ("Added " ++ p ++ " to repository") Left ResourceExists -> return ()
src/Network/Gitit/Page.hs view
@@ -61,11 +61,8 @@ import System.IO (withFile, Handle, IOMode(..)) import qualified Control.Exception as E import System.IO.Error (isEOFError)-#if MIN_VERSION_base(4,5,0)-#else-import Codec.Binary.UTF8.String (encodeString)-#endif + parseMetadata :: String -> ([(String, String)], String) parseMetadata raw = case parse pMetadataBlock "" raw of@@ -164,11 +161,7 @@ -- | Read categories from metadata strictly. readCategories :: FilePath -> IO [String] readCategories f =-#if MIN_VERSION_base(4,5,0) withFile f ReadMode $ \h ->-#else- withFile (encodeString f) ReadMode $ \h ->-#endif E.catch (do fl <- B.hGetLine h if dashline fl then do -- get rest of metadata
src/Network/Gitit/Plugins.hs view
@@ -53,23 +53,10 @@ else if "Network/Gitit/Plugin/" `isInfixOf` pluginName then "Network.Gitit.Plugin." ++ takeBaseName pluginName else takeBaseName pluginName-#if MIN_VERSION_ghc(7,4,0) pr <- parseImportDecl "import Prelude" i <- parseImportDecl "import Network.Gitit.Interface" m <- parseImportDecl ("import " ++ modName) setContext [IIDecl m, IIDecl i, IIDecl pr]-#else- pr <- findModule (mkModuleName "Prelude") Nothing- i <- findModule (mkModuleName "Network.Gitit.Interface") Nothing- m <- findModule (mkModuleName modName) Nothing-#if MIN_VERSION_ghc(7,2,0)- setContext [IIModule m, IIModule i, IIModule pr] []-#elif MIN_VERSION_ghc(7,0,0)- setContext [] [(m, Nothing), (i, Nothing), (pr, Nothing)]-#else- setContext [] [m, i, pr]-#endif-#endif value <- compileExpr (modName ++ ".plugin :: Plugin") let value' = (unsafeCoerce value) :: Plugin return value'
src/Network/Gitit/Types.hs view
@@ -31,10 +31,13 @@ , SessionKey -- we do not export SessionData constructors, in case we need to extend SessionData with other data in the future , SessionData+ , SessionGithubData , sessionData- , sessionDataGithubState+ , sessionGithubData+ , sessionDataGithubStateUrl , sessionUser , sessionGithubState+ , sessionGithubDestination , User(..) , Sessions(..) , Password(..)@@ -71,7 +74,7 @@ import qualified Data.Map as M import Data.Text (Text) import Data.List (intersect)-import Data.Time (parseTime)+import Data.Time (parseTimeM) #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) #else@@ -96,7 +99,7 @@ data FileStoreType = Git | Darcs | Mercurial deriving Show -data MathMethod = MathML | JsMathScript | WebTeX String | RawTeX | MathJax String+data MathMethod = MathML | WebTeX String | RawTeX | MathJax String deriving (Read, Show, Eq) data AuthenticationLevel = Never | ForModify | ForRead@@ -186,7 +189,7 @@ -- | Text of password reset email resetPasswordMessage :: String, -- | Markup syntax help for edit sidebar- markupHelp :: String,+ markupHelp :: Text, -- | Provide an atom feed? useFeed :: Bool, -- | Base URL of wiki, for use in feed@@ -228,14 +231,19 @@ data SessionData = SessionData { sessionUser :: Maybe String,- sessionGithubState :: Maybe String+ sessionGithubData :: Maybe SessionGithubData } deriving (Read,Show,Eq) +data SessionGithubData = SessionGithubData {+ sessionGithubState :: String,+ sessionGithubDestination :: String+} deriving (Read, Show, Eq)+ sessionData :: String -> SessionData sessionData user = SessionData (Just user) Nothing -sessionDataGithubState :: String -> SessionData-sessionDataGithubState githubState = SessionData Nothing (Just githubState)+sessionDataGithubStateUrl :: String -> String -> SessionData+sessionDataGithubStateUrl githubState destination = SessionData Nothing (Just $ SessionGithubData githubState destination) data Sessions a = Sessions {unsession::M.Map SessionKey a} deriving (Read,Show,Eq)@@ -307,7 +315,7 @@ , pgScripts :: [String] , pgShowPageTools :: Bool , pgShowSiteNav :: Bool- , pgMarkupHelp :: Maybe String+ , pgMarkupHelp :: Maybe Text , pgTabs :: [Tab] , pgSelectedTab :: Tab , pgLinkToFeed :: Bool@@ -380,7 +388,7 @@ return (if null s then Nothing else Just s)) `mplus` return Nothing fu <- liftM Just (look' "forUser") `mplus` return Nothing- si <- liftM (parseTime defaultTimeLocale "%Y-%m-%d") (look' "since")+ si <- liftM (parseTimeM True defaultTimeLocale "%Y-%m-%d") (look' "since") `mplus` return Nothing -- YYYY-mm-dd format ds <- look' "destination" `mplus` return "" ra <- look' "raw" `mplus` return ""
src/Network/Gitit/Util.hs view
@@ -26,6 +26,7 @@ , yesOrNo , parsePageType , encUrl+ , getPageTypeDefaultExtensions ) where import System.Directory@@ -34,14 +35,17 @@ import System.IO.Error (isAlreadyExistsError) import Control.Monad.Trans (liftIO) import Data.Char (toLower, isAscii)+import Data.Text (Text)+import qualified Data.Text as T import Network.Gitit.Types import qualified Control.Exception as E import qualified Text.Pandoc.UTF8 as UTF8+import Text.Pandoc (Extension(..), Extensions, getDefaultExtensions, enableExtension) import Network.URL (encString) -- | Read file as UTF-8 string. Encode filename as UTF-8.-readFileUTF8 :: FilePath -> IO String-readFileUTF8 = UTF8.readFile+readFileUTF8 :: FilePath -> IO Text+readFileUTF8 = fmap T.pack . UTF8.readFile -- | Perform a function a directory and return to working directory. inDir :: FilePath -> IO a -> IO a@@ -96,6 +100,7 @@ "markdown" -> (Markdown,False) "markdown+lhs" -> (Markdown,True) "commonmark" -> (CommonMark,False)+ "docbook" -> (DocBook,False) "rst" -> (RST,False) "rst+lhs" -> (RST,True) "html" -> (HTML,False)@@ -105,6 +110,23 @@ "org" -> (Org,False) "mediawiki" -> (MediaWiki,False) x -> error $ "Unknown page type: " ++ x++getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions+getPageTypeDefaultExtensions pt lhs =+ if lhs+ then enableExtension Ext_literate_haskell defaults+ else defaults+ where defaults = getDefaultExtensions $+ case pt of+ CommonMark -> "commonmark"+ DocBook -> "docbook"+ HTML -> "html"+ LaTeX -> "latex"+ Markdown -> "markdown"+ MediaWiki -> "mediawiki"+ Org -> "org"+ RST -> "rst"+ Textile -> "textile" encUrl :: String -> String encUrl = encString True isAscii