content: {-# LANGUAGE DataKinds         #-}
  {-# LANGUAGE PolyKinds         #-}
  {-# LANGUAGE TypeFamilies      #-}
  {-# LANGUAGE TypeOperators     #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ConstraintKinds   #-}
  {-# LANGUAGE RecordWildCards   #-}
  {-# LANGUAGE CPP               #-}
  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
  