module Dixi.API where
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson.Types
import Data.Foldable
import Data.Text (Text)
import Data.Patch (Hunks, HunkStatus (..))
import Data.Proxy
import Data.Vector (Vector)
import Servant.API
import Servant.HTML.Blaze
import Text.Blaze.Html.Renderer.Text
import Text.Hamlet (Html)
#ifdef OLDBASE
import Control.Applicative
#endif
import Dixi.Config
import Dixi.Common
import Dixi.Page
import Dixi.PatchUtils
type a :| b = a :<|> b
infixr 8 :|
infixr 8 |:
(|:) :: a -> b -> a :| b
(|:) = (:<|>)
data PrettyPage = PP Renders Key Version (Page Html)
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, JSON] History
:| Capture "version" Version :> VersionAPI
:| "diff" :> QueryParam "from" Version :> QueryParam "to" Version :> Get '[HTML, JSON] DiffPage
:| "revert" :> ReqBody '[FormUrlEncoded, JSON] RevReq :> Post '[HTML, JSON] PrettyPage
type VersionAPI = PageViewAPI
:| ReqBody '[FormUrlEncoded, JSON] NewBody :> Post '[HTML, JSON] PrettyPage
type PageAPI = PageViewAPI
:| "history" :> HistoryAPI
type PageViewAPI = Get '[HTML, JSON] PrettyPage
:| "raw" :> Get '[HTML, JSON] RawPage
type Dixi = Capture "page" Key :> PageAPI
:| PageAPI
instance FromJSON RevReq where
parseJSON (Object o) = DR <$> o .: "from" <*> o .: "to" <*> o .:? "comment"
parseJSON wat = typeMismatch "Revert" wat
instance ToJSON RevReq where
toJSON (DR v1 v2 Nothing) = object ["from" .= v1, "to" .= v2]
toJSON (DR v1 v2 (Just c)) = object ["from" .= v1, "to" .= v2, "comment" .= c]
instance FromJSON NewBody where
parseJSON (Object o) = NB <$> o .: "content" <*> o .:? "comment"
parseJSON wat = typeMismatch "NewBody" wat
instance ToJSON NewBody where
toJSON (NB cn Nothing) = object ["content" .= cn ]
toJSON (NB cn (Just c)) = object ["content" .= cn, "comment" .= c ]
instance ToJSON DiffPage where
toJSON (DP (Renders {..}) k v1 v2 p)
= object [ "title" .= k
, "versions" .= object [ "from" .= v1 , "to" .= v2 ]
, "diff" .= map (uncurry hunkToJSON) (p ^. body)
]
where
hunkToJSON :: Vector Char -> HunkStatus -> Value
hunkToJSON v s = object [ "text" .= toList v
, "status" .= case s of Inserted -> '+'
Deleted -> '-'
Replaced -> '~'
Unchanged -> ' '
]
instance ToJSON RawPage where
toJSON (RP (Renders {..}) k v p)
= let tim = renderTime $ p ^. time
com = p ^. comment . traverse
in object [ "title" .= k
, "version" .= v
, "time" .= tim
, "comment" .= com
, "content" .= (p ^. body)
]
instance ToJSON PrettyPage where
toJSON (PP (Renders {..}) k v p)
= let tim = renderTime $ p ^. time
com = p ^. comment . traverse
in object [ "title" .= k
, "version" .= v
, "time" .= tim
, "comment" .= com
, "content" .= renderHtml (p ^. body)
]
instance ToJSON History where
toJSON (H (Renders {..}) k cs) = object [ "title" .= k , "history" .= zipWith versionToJSON [1 :: Version ..] cs]
where
versionToJSON v p = let
tim = renderTime $ p ^. time
com = p ^. comment . traverse
(a,b,c) = p ^. body
in object [ "version" .= v
, "time" .= tim
, "comment" .= com
, "changes" .= object [ "insertions" .= a , "deletions" .= b, "modifications" .= c]
]
dixi :: Proxy Dixi
dixi = Proxy