gdritter repos frontit / master
Split config to separate module + carry title through Getty Ritter 7 years ago
3 changed file(s) with 117 addition(s) and 82 deletion(s). Collapse all Expand all
+2
-1
frontit.cabal less more
1818 ScopedTypeVariables
1919 ghc-options: -Wall
2020 build-depends: base >=4.7 && <4.10
21 , bytestring
21 , bytestring ==0.10.8.1
22 , containers
2223 , data-default
2324 , directory
2425 , filepath
+87
-0
src/Config.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2
3 module Config where
4
5 import qualified Network.Gitit.Config as Gitit
6 import qualified Network.Gitit.Types as Gitit
7 import qualified System.Console.GetOpt as Opt
8 import qualified System.Directory as Dir
9 import qualified System.Environment as Env
10 import qualified System.Exit as Exit
11
12 data Protection
13 = PrivateByDefault
14 | PublicByDefault
15 deriving (Eq, Show)
16
17 data FrontitOpts = FrontitOpts
18 { optPort :: Int
19 , optData :: Maybe FilePath
20 , optGititConfig :: Maybe FilePath
21 , optTemplate :: Maybe FilePath
22 , optProtection :: Protection
23 } deriving (Eq, Show)
24
25 defaultOpts :: FrontitOpts
26 defaultOpts = FrontitOpts
27 { optPort = 5000
28 , optData = Nothing
29 , optGititConfig = Nothing
30 , optTemplate = Nothing
31 , optProtection = PrivateByDefault
32 }
33
34 frontitOptDescr :: [Opt.OptDescr (FrontitOpts -> FrontitOpts)]
35 frontitOptDescr =
36 [ Opt.Option ['p'] ["port"]
37 (Opt.ReqArg (\ s opts -> opts { optPort = read s }) "port")
38 "The port to serve on"
39 , Opt.Option ['d'] ["data"]
40 (Opt.ReqArg (\ s opts -> opts { optData = Just s }) "path")
41 "The location of the data directory"
42 , Opt.Option ['c'] ["config"]
43 (Opt.ReqArg (\ s opts -> opts { optGititConfig = Just s }) "path")
44 "The location of the gitit configuration"
45 , Opt.Option ['t'] ["template"]
46 (Opt.ReqArg (\ s opts -> opts { optTemplate = Just s }) "path")
47 "The location of the desired HTML template"
48 , Opt.Option ['o'] ["public-by-default"]
49 (Opt.NoArg (\ opts -> opts { optProtection = PublicByDefault}))
50 "Allow all pages to be browsed by default"
51 ]
52
53 data FrontitConf = FrontitConf
54 { fcData :: FilePath
55 , fcGititConfig :: Gitit.Config
56 , fcTemplate :: String
57 , fcProtection :: Protection
58 , fcPort :: Int
59 }
60
61 optsToConfiguration :: FrontitOpts -> IO FrontitConf
62 optsToConfiguration FrontitOpts { .. } = do
63 fcData <- case optData of
64 Just path -> return path
65 Nothing -> Dir.getCurrentDirectory
66 fcTemplate <- case optTemplate of
67 Just path -> readFile path
68 Nothing -> return defaultTemplate
69 fcGititConfig <- case optGititConfig of
70 Just path -> Gitit.getConfigFromFile path
71 Nothing -> Gitit.getDefaultConfig
72 let fcPort = optPort
73 fcProtection = optProtection
74 return FrontitConf { .. }
75
76 defaultTemplate :: String
77 defaultTemplate = "<html><body>$body$</body></html>"
78
79 getConfig :: IO FrontitConf
80 getConfig = do
81 args <- Env.getArgs
82 opts <- case Opt.getOpt Opt.Permute frontitOptDescr args of
83 (fs, [], []) -> return (foldr (.) id fs defaultOpts)
84 _ -> do
85 putStrLn (Opt.usageInfo "frontit" frontitOptDescr)
86 Exit.exitFailure
87 optsToConfiguration opts
+28
-81
src/Main.hs less more
55 import qualified Data.ByteString.Char8 as BS
66 import qualified Data.ByteString.Lazy.Char8 as LBS
77 import Data.Default (def)
8 import qualified Data.Map.Strict as Map
89 import Data.Monoid ((<>))
910 import qualified Data.Time.Clock as Time
1011 import qualified Data.Time.Format as Time
1112 import qualified Data.Text as T
1213 import qualified Data.Text.Encoding as T
13 import qualified Network.Gitit.Config as Gitit
1414 import qualified Network.Gitit.Page as Gitit
1515 import qualified Network.Gitit.Types as Gitit
1616 import qualified Network.HTTP.Types.Status as Http
1717 import qualified Network.Wai as Wai
1818 import qualified Network.Wai.Handler.Warp as Warp
19 import qualified System.Console.GetOpt as Opt
2019 import qualified System.Directory as Dir
21 import qualified System.Environment as Env
22 import qualified System.Exit as Exit
2320 import System.FilePath ((</>), makeRelative)
2421 import qualified Text.Pandoc as Pandoc
2522 import Text.Printf (printf)
2623
27 data Protection
28 = PrivateByDefault
29 | PublicByDefault
30 deriving (Eq, Show)
31
32 data FrontitOpts = FrontitOpts
33 { optPort :: Int
34 , optData :: Maybe FilePath
35 , optGititConfig :: Maybe FilePath
36 , optTemplate :: Maybe FilePath
37 , optProtection :: Protection
38 } deriving (Eq, Show)
39
40 defaultOpts :: FrontitOpts
41 defaultOpts = FrontitOpts
42 { optPort = 5000
43 , optData = Nothing
44 , optGititConfig = Nothing
45 , optTemplate = Nothing
46 , optProtection = PrivateByDefault
47 }
48
49 frontitOptDescr :: [Opt.OptDescr (FrontitOpts -> FrontitOpts)]
50 frontitOptDescr =
51 [ Opt.Option ['p'] ["port"]
52 (Opt.ReqArg (\ s opts -> opts { optPort = read s }) "port")
53 "The port to serve on"
54 , Opt.Option ['d'] ["data"]
55 (Opt.ReqArg (\ s opts -> opts { optData = Just s }) "path")
56 "The location of the data directory"
57 , Opt.Option ['c'] ["config"]
58 (Opt.ReqArg (\ s opts -> opts { optGititConfig = Just s }) "path")
59 "The location of the gitit configuration"
60 , Opt.Option ['t'] ["template"]
61 (Opt.ReqArg (\ s opts -> opts { optTemplate = Just s }) "path")
62 "The location of the desired HTML template"
63 , Opt.Option ['o'] ["public-by-default"]
64 (Opt.NoArg (\ opts -> opts { optProtection = PublicByDefault}))
65 "Allow all pages to be browsed by default"
66 ]
67
68 optsToConfiguration :: FrontitOpts -> IO FrontitConf
69 optsToConfiguration FrontitOpts { .. } = do
70 fcData <- case optData of
71 Just path -> return path
72 Nothing -> Dir.getCurrentDirectory
73 fcTemplate <- case optTemplate of
74 Just path -> readFile path
75 Nothing -> return defaultTemplate
76 fcGititConfig <- case optGititConfig of
77 Just path -> Gitit.getConfigFromFile path
78 Nothing -> Gitit.getDefaultConfig
79 let fcProtection = optProtection
80 return FrontitConf { .. }
81
82 defaultTemplate :: String
83 defaultTemplate = "<html><body>$body$</body></html>"
84
85 data FrontitConf = FrontitConf
86 { fcData :: FilePath
87 , fcGititConfig :: Gitit.Config
88 , fcTemplate :: String
89 , fcProtection :: Protection
90 }
24 import Config
9125
9226 data Result
9327 = Found Gitit.Page
12256 go Pandoc.Space = Just " "
12357 go _ = Nothing
12458
125 renderPage :: FrontitConf -> Gitit.Page -> String
126 renderPage conf pg@Gitit.Page { .. } = Pandoc.writeHtmlString writerOpts pandoc
59 addTitle :: T.Text -> Pandoc.Pandoc -> Pandoc.Pandoc
60 addTitle title p@(Pandoc.Pandoc meta@(Pandoc.Meta metaMap) bs)
61 | Just _ <- Pandoc.lookupMeta "title" meta = p
62 | otherwise = Pandoc.Pandoc newMeta bs
63 where titleVal = Pandoc.MetaString (T.unpack title)
64 newMeta = Pandoc.Meta (Map.insert "title" titleVal metaMap)
65
66 renderPage :: FrontitConf -> Gitit.Page -> T.Text -> String
67 renderPage conf pg@Gitit.Page { .. } title =
68 Pandoc.writeHtmlString writerOpts (addTitle title pandoc)
12769 where
12870 writerOpts = def { Pandoc.writerTemplate = fcTemplate conf
12971 , Pandoc.writerStandalone = True
14890 | req == "" = Just (Gitit.frontPage (fcGititConfig conf) <> ".page")
14991 | otherwise = Just (T.unpack (req <> ".page"))
15092
93 getTitle :: FrontitConf -> [T.Text] -> T.Text
94 getTitle conf [] = T.pack (Gitit.frontPage (fcGititConfig conf))
95 getTitle _ cs = T.toTitle (last cs)
96
97 strToByteString :: String -> LBS.ByteString
98 strToByteString = LBS.fromStrict . T.encodeUtf8 . T.pack
99
100 -- Our application is simple: every GET request will look up a
101 -- corresponding file in the data directory and serve it according
102 -- to roughly the same logic as Gitit.
151103 app :: FrontitConf -> Wai.Application
152104 app conf = \ req respond -> do
153 let respond' st pg = respond (Wai.responseLBS st [] (LBS.fromStrict (T.encodeUtf8 (T.pack pg))))
105 let respond' st pg = respond (Wai.responseLBS st [] (strToByteString pg))
154106 if Wai.requestMethod req == "GET"
155107 then do
156108 case getLocalPath conf (T.intercalate ("/") (Wai.pathInfo req)) of
157109 Nothing -> respond' Http.status403 "invalid URL"
158110 Just path -> do
111 let title = getTitle conf (Wai.pathInfo req)
159112 result <- fetchPage conf path
160113 case result of
161 Found pg -> respond' Http.status200 (renderPage conf pg)
114 Found pg -> respond' Http.status200 (renderPage conf pg title)
162115 Private -> respond' Http.status403 "private page"
163116 NotFound -> respond' Http.status404 "not found"
164117 else respond' Http.status403 "forbidden"
184137
185138 main :: IO ()
186139 main = do
187 args <- Env.getArgs
188 opts <- case Opt.getOpt Opt.Permute frontitOptDescr args of
189 (fs, [], []) -> return (foldr (.) id fs defaultOpts)
190 _ -> do
191 putStrLn (Opt.usageInfo "frontit" frontitOptDescr)
192 Exit.exitFailure
193 conf <- optsToConfiguration opts
194 printf "running frontit on port %d\n" (optPort opts)
195 Warp.run (optPort opts) (mkLogger (app conf))
140 conf <- getConfig
141 printf "running frontit on port %d\n" (fcPort conf)
142 Warp.run (fcPort conf) (mkLogger (app conf))