dixi 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+64/−32 lines, 5 filesdep +bytestringdep +tz
Dependencies added: bytestring, tz
Files
- Dixi/API.hs +8/−6
- Dixi/Config.hs +31/−2
- Dixi/Markup.hs +7/−10
- Main.hs +15/−13
- dixi.cabal +3/−1
Dixi/API.hs view
@@ -15,6 +15,7 @@ import Servant.API import Servant.HTML.Blaze +import Dixi.Config import Dixi.Common import Dixi.Page import Dixi.PatchUtils@@ -26,13 +27,14 @@ (|:) :: a -> b -> a :| b (|:) = (:<|>) -data PrettyPage = PP Key Version (Page Text)-data RawPage = RP Key Version (Page Text)-data DiffPage = DP Key Version Version (Page (Hunks Char))-data History = H Key [Page PatchSummary] -data NewBody = NB Text (Maybe Text)-data RevReq = DR Version Version (Maybe Text)+data PrettyPage = PP Renders Key Version (Page Text)+data RawPage = RP Renders Key Version (Page Text)+data DiffPage = DP Renders Key Version Version (Page (Hunks Char))+data History = H Renders Key [Page PatchSummary]++data NewBody = NB Text (Maybe Text)+data RevReq = DR Version Version (Maybe Text) type HistoryAPI = Get '[HTML] History :| Capture "version" Version :> VersionAPI
Dixi/Config.hs view
@@ -1,17 +1,46 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-} -module Dixi.Config where+module Dixi.Config ( Config (Config, port, storage)+ , Renders (..)+ , defaultConfig+ , configToRenders+ ) where import Data.Aeson+import Data.Maybe (fromMaybe)+import Data.Monoid (Last (..))+import Data.Time (UTCTime, formatTime)+import Data.Time.Locale.Compat+import Data.Time.Zones.All (toTZName, fromTZName, tzByLabel, TZLabel (..))+import Data.Time.Zones (utcToLocalTimeTZ) import GHC.Generics+import qualified Data.ByteString.Char8 as B +data TimeConfig = TimeConfig+ { timezone :: String+ , format :: String+ } deriving (Generic, Show) data Config = Config { port :: Int , storage :: FilePath+ , time :: TimeConfig } deriving (Generic, Show) instance FromJSON Config where instance ToJSON Config where+instance FromJSON TimeConfig where+instance ToJSON TimeConfig where +data Renders = Renders+ { renderTime :: Last UTCTime -> String }+ defaultConfig :: Config-defaultConfig = Config 8000 "state"+defaultConfig = Config 8000 "state" (TimeConfig (B.unpack $ toTZName Etc__UTC) "%T, %F")+++configToRenders :: Config -> Renders+configToRenders Config {..} = Renders {..}+ where renderTime (Last Nothing) = "(never)"+ renderTime (Last (Just t)) = let label = fromMaybe Etc__UTC (fromTZName $ B.pack $ timezone time)+ in formatTime defaultTimeLocale (format time) $ utcToLocalTimeTZ (tzByLabel label) t
Dixi/Markup.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}@@ -16,11 +17,9 @@ import Data.Monoid import Data.Patch (Hunks, HunkStatus(..)) import Data.Proxy-import Data.Time import Data.Text (Text) import Servant.API import Servant.HTML.Blaze-import Data.Time.Locale.Compat import Text.Blaze import Text.Cassius import Text.Hamlet (shamlet, Html)@@ -31,6 +30,7 @@ import Dixi.API import Dixi.Common+import Dixi.Config import Dixi.Page import Dixi.Hamlet import Dixi.PatchUtils@@ -38,9 +38,6 @@ link :: (IsElem endpoint Dixi, HasLink endpoint) => Proxy endpoint -> MkLink endpoint link = safeLink dixi -renderTime :: Last UTCTime -> String-renderTime (Last Nothing) = "(never)"-renderTime (Last (Just t)) = formatTime defaultTimeLocale "%T, %F (%Z)" t renderTitle :: Text -> Text renderTitle = T.pack . map (\c -> if c == '_' then ' ' else c) . T.unpack@@ -203,7 +200,7 @@ instance ToMarkup DiffPage where- toMarkup (DP k v1 v2 p) = outerMatter (renderTitle k) $ [shamlet| + toMarkup (DP (Renders {..}) k v1 v2 p) = outerMatter (renderTitle k) $ [shamlet| #{pageHeader k vString} <div .body> <div>@@ -233,8 +230,8 @@ vString = ("diff " <> T.pack (show v1) <> " - " <> T.pack (show v2)) instance ToMarkup History where- toMarkup (H k []) = outerMatter (renderTitle k) $ pageHeader k "history"- toMarkup (H k ps) = outerMatter (renderTitle k) $ [shamlet| + toMarkup (H (Renders {..}) k []) = outerMatter (renderTitle k) $ pageHeader k "history"+ toMarkup (H (Renders {..}) k ps) = outerMatter (renderTitle k) $ [shamlet| #{pageHeader k "history"} <div .body> <form method="GET" action="/#{link diffUrl k}">@@ -297,7 +294,7 @@ toMarkup (ParsecError _ e) = [shamlet| <b> Parse Error: </b> #{show e} |] instance ToMarkup PrettyPage where- toMarkup (PP k v p)+ toMarkup (PP (Renders {..}) k v p) = let com = p ^. comment . traverse tim = renderTime $ p ^. time@@ -313,7 +310,7 @@ |] instance ToMarkup RawPage where- toMarkup (RP k v p )+ toMarkup (RP (Renders {..}) k v p ) = let com = p ^. comment . traverse bod = p ^. body
Main.hs view
@@ -37,28 +37,28 @@ spacesToUScores :: T.Text -> T.Text spacesToUScores = T.pack . map (\x -> if x == ' ' then '_' else x) . T.unpack -page :: AcidState Database -> Key -> Server PageAPI-page db (spacesToUScores -> key)+page :: AcidState Database -> Config -> Key -> Server PageAPI+page db cfg (spacesToUScores -> key) = latest |: history where- latest = latestQ PP |: latestQ RP+ latest = latestQ (PP renders) |: latestQ (RP renders) - diffPages (Just v1) (Just v2) = do liftIO $ DP key v1 v2 <$> query db (GetDiff key (v1, v2))+ diffPages (Just v1) (Just v2) = do liftIO $ DP renders key v1 v2 <$> query db (GetDiff key (v1, v2)) diffPages _ _ = left err400 - history = do liftIO $ H key <$> query db (GetHistory key)+ history = do liftIO $ H renders key <$> query db (GetHistory key) |: version |: diffPages |: reversion reversion (DR v1 v2 com) = do _ <- liftIO (getCurrentTime >>= update db . Revert key (v1, v2) com)- latestQ PP- version v = (versionQ PP v |: versionQ RP v)+ latestQ (PP renders)+ version v = (versionQ (PP renders) v |: versionQ (RP renders) v) |: updateVersion v updateVersion v (NB t c) = do _ <- liftIO $ (getCurrentTime >>= update db . Amend key v t c)- latestQ PP+ latestQ (PP renders) latestQ :: (Key -> Version -> Page Text -> a) -> EitherT ServantErr IO a latestQ pp = do liftIO $ uncurry (pp key) <$> query db (GetLatest key)@@ -66,10 +66,12 @@ versionQ :: (Key -> Version -> Page Text -> a) -> Version -> EitherT ServantErr IO a versionQ pp v = do liftIO $ pp key v <$> query db (GetVersion key v) -server :: AcidState Database -> Server Dixi-server db = page db- |: page db "Main_Page"+ renders = configToRenders cfg +server :: AcidState Database -> Config -> Server Dixi+server db cfg = page db cfg+ |: page db cfg "Main_Page"+ main :: IO () main = getArgs >>= main' where@@ -91,8 +93,8 @@ main'' (Left e) = do hPutStrLn stderr $ Y.prettyPrintParseException e exitFailure- main'' (Right (Config {..})) = do+ main'' (Right cfg@(Config {..})) = do db <- openLocalStateFrom storage emptyDB createCheckpoint db createArchive db- run port $ serve dixi $ server db+ run port $ serve dixi $ server db cfg
dixi.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: dixi-version: 0.2.0.0+version: 0.3.0.0 synopsis: A wiki implemented with a firm theoretical foundation. description: This project is a simple wiki developed based on a firm theoretical foundation.@@ -67,6 +67,8 @@ , directory >= 1.0 && < 1.3 , time >= 1.4 && < 1.6 , time-locale-compat >= 0.1 && < 0.2+ , tz >= 0.0 && < 0.1+ , bytestring >= 0.10 && < 0.11 -- hs-source-dirs: default-language: Haskell2010