| 6 | 6 |
import qualified Data.ByteString.Lazy.Char8 as LBS
|
| 7 | 7 |
import Data.Default (def)
|
| 8 | 8 |
import Data.Monoid ((<>))
|
| 9 |
import qualified Data.Time.Clock as Time
|
| 10 |
import qualified Data.Time.Format as Time
|
| 9 | 11 |
import qualified Network.Gitit.Config as Gitit
|
| 10 | 12 |
import qualified Network.Gitit.Page as Gitit
|
| 11 | 13 |
import qualified Network.Gitit.Types as Gitit
|
|
| 18 | 20 |
import qualified System.Exit as Exit
|
| 19 | 21 |
import System.FilePath ((</>), makeRelative)
|
| 20 | 22 |
import qualified Text.Pandoc as Pandoc
|
| 23 |
import Text.Printf (printf)
|
| 21 | 24 |
|
| 22 | 25 |
data FrontitOpts = FrontitOpts
|
| 23 | 26 |
{ optPort :: Int
|
|
| 90 | 93 |
Just "yes" -> return (Found pg)
|
| 91 | 94 |
_ -> return Private
|
| 92 | 95 |
|
| 96 |
convertLinks :: Pandoc.Inline -> Pandoc.Inline
|
| 97 |
convertLinks link@(Pandoc.Link as name ("",title)) =
|
| 98 |
case flatten name of
|
| 99 |
Nothing -> link
|
| 100 |
Just text -> Pandoc.Link as name (text, title)
|
| 101 |
convertLinks rs = rs
|
| 102 |
|
| 103 |
flatten :: [Pandoc.Inline] -> Maybe String
|
| 104 |
flatten = fmap mconcat . sequence . fmap go
|
| 105 |
where go (Pandoc.Str s) = Just s
|
| 106 |
go Pandoc.Space = Just " "
|
| 107 |
go _ = Nothing
|
| 108 |
|
| 93 | 109 |
renderPage :: FrontitConf -> Gitit.Page -> String
|
| 94 | 110 |
renderPage conf pg@Gitit.Page { .. } = Pandoc.writeHtmlString writerOpts pandoc
|
| 95 | 111 |
where
|
|
| 97 | 113 |
, Pandoc.writerStandalone = True
|
| 98 | 114 |
}
|
| 99 | 115 |
rawPage = Gitit.pageToString (fcGititConfig conf) pg
|
| 100 | |
pandoc = Pandoc.handleError (reader def rawPage)
|
| 101 | |
reader =
|
| 116 |
pandoc = Pandoc.bottomUp convertLinks (Pandoc.handleError parsed)
|
| 117 |
parsed =
|
| 102 | 118 |
case pageFormat of
|
| 103 | |
Gitit.Markdown -> Pandoc.readMarkdown
|
| 104 | |
Gitit.CommonMark -> Pandoc.readCommonMark
|
| 105 | |
Gitit.RST -> Pandoc.readRST
|
| 106 | |
Gitit.LaTeX -> Pandoc.readLaTeX
|
| 107 | |
Gitit.HTML -> Pandoc.readHtml
|
| 108 | |
Gitit.Textile -> Pandoc.readTextile
|
| 109 | |
Gitit.Org -> Pandoc.readOrg
|
| 110 | |
Gitit.DocBook -> Pandoc.readDocBook
|
| 111 | |
Gitit.MediaWiki -> Pandoc.readMediaWiki
|
| 119 |
Gitit.Markdown -> Pandoc.readMarkdown def rawPage
|
| 120 |
Gitit.CommonMark -> Pandoc.readCommonMark def rawPage
|
| 121 |
Gitit.RST -> Pandoc.readRST def pageText
|
| 122 |
Gitit.LaTeX -> Pandoc.readLaTeX def pageText
|
| 123 |
Gitit.HTML -> Pandoc.readHtml def pageText
|
| 124 |
Gitit.Textile -> Pandoc.readTextile def pageText
|
| 125 |
Gitit.Org -> Pandoc.readOrg def pageText
|
| 126 |
Gitit.DocBook -> Pandoc.readDocBook def pageText
|
| 127 |
Gitit.MediaWiki -> Pandoc.readMediaWiki def pageText
|
| 112 | 128 |
|
| 113 | 129 |
getLocalPath :: FrontitConf -> BS.ByteString -> Maybe FilePath
|
| 114 | 130 |
getLocalPath conf req
|
|
| 119 | 135 |
app :: FrontitConf -> Wai.Application
|
| 120 | 136 |
app conf = \ req respond -> do
|
| 121 | 137 |
let respond' st pg = respond (Wai.responseLBS st [] (LBS.pack pg))
|
| 122 | |
case getLocalPath conf (Wai.rawPathInfo req) of
|
| 123 | |
Nothing -> respond' Http.status403 "invalid URL"
|
| 124 | |
Just path -> do
|
| 125 | |
putStrLn ("fetching: " <> path)
|
| 126 | |
result <- fetchPage conf path
|
| 127 | |
case result of
|
| 128 | |
Found pg -> respond' Http.status200 (renderPage conf pg)
|
| 129 | |
Private -> respond' Http.status403 "private page"
|
| 130 | |
NotFound -> respond' Http.status404 "not found"
|
| 138 |
if Wai.requestMethod req == "GET"
|
| 139 |
then do
|
| 140 |
case getLocalPath conf (Wai.rawPathInfo req) of
|
| 141 |
Nothing -> respond' Http.status403 "invalid URL"
|
| 142 |
Just path -> do
|
| 143 |
result <- fetchPage conf path
|
| 144 |
case result of
|
| 145 |
Found pg -> respond' Http.status200 (renderPage conf pg)
|
| 146 |
Private -> respond' Http.status403 "private page"
|
| 147 |
NotFound -> respond' Http.status404 "not found"
|
| 148 |
else respond' Http.status403 "forbidden"
|
| 149 |
|
| 150 |
-- Something like this exists in wai-extra, but I don't want to have
|
| 151 |
-- to depend on an even bigger set of deps after gitit+pandoc, so
|
| 152 |
-- this is a quick reimplementation.
|
| 153 |
mkLogger :: Wai.Application -> Wai.Application
|
| 154 |
mkLogger app' = \ req respond -> app' req $ \ resp -> do
|
| 155 |
currentTime <- Time.getCurrentTime
|
| 156 |
let time = Time.formatTime
|
| 157 |
Time.defaultTimeLocale
|
| 158 |
"[%d/%b/%Y:%H:%M:%S %z]"
|
| 159 |
currentTime
|
| 160 |
printf "%v - - %v \"%v %v %v\" %v -\n"
|
| 161 |
(show (Wai.remoteHost req))
|
| 162 |
time
|
| 163 |
(BS.unpack (Wai.requestMethod req))
|
| 164 |
(BS.unpack (Wai.rawPathInfo req))
|
| 165 |
(show (Wai.httpVersion req))
|
| 166 |
(Http.statusCode (Wai.responseStatus resp))
|
| 167 |
respond resp
|
| 131 | 168 |
|
| 132 | 169 |
main :: IO ()
|
| 133 | 170 |
main = do
|
|
| 138 | 175 |
putStrLn (Opt.usageInfo "frontit" frontitOptDescr)
|
| 139 | 176 |
Exit.exitFailure
|
| 140 | 177 |
conf <- optsToConfiguration opts
|
| 141 | |
Warp.run (optPort opts) (app conf)
|
| 178 |
printf "running frontit on port %d\n" (optPort opts)
|
| 179 |
Warp.run (optPort opts) (mkLogger (app conf))
|