{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module Yesod.GitRev
  ( GitRev (..)
  , gitRev
  , tGitRev
  ) where

import Data.Aeson
import Yesod.Core
import Yesod.Core.Types
import Yesod.GitRev.Data

getGitRevR :: Yesod site => SubHandlerFor GitRev site TypedContent
getGitRevR :: SubHandlerFor GitRev site TypedContent
getGitRevR = SubHandlerFor GitRev site GitRev
forall (m :: * -> *). MonadHandler m => m (SubHandlerSite m)
getSubYesod SubHandlerFor GitRev site GitRev
-> (GitRev -> SubHandlerFor GitRev site TypedContent)
-> SubHandlerFor GitRev site TypedContent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GitRev{Bool
Int
String
gitRevCommitMessage :: GitRev -> String
gitRevCommitCount :: GitRev -> Int
gitRevCommitDate :: GitRev -> String
gitRevDirty :: GitRev -> Bool
gitRevBranch :: GitRev -> String
gitRevHash :: GitRev -> String
gitRevCommitMessage :: String
gitRevCommitCount :: Int
gitRevCommitDate :: String
gitRevDirty :: Bool
gitRevBranch :: String
gitRevHash :: String
..} -> HandlerFor (HandlerSite (SubHandlerFor GitRev site)) TypedContent
-> SubHandlerFor GitRev site TypedContent
forall (m :: * -> *) a.
MonadHandler m =>
HandlerFor (HandlerSite m) a -> m a
liftHandler (HandlerFor (HandlerSite (SubHandlerFor GitRev site)) TypedContent
 -> SubHandlerFor GitRev site TypedContent)
-> HandlerFor
     (HandlerSite (SubHandlerFor GitRev site)) TypedContent
-> SubHandlerFor GitRev site TypedContent
forall a b. (a -> b) -> a -> b
$ Writer (Endo [ProvidedRep (HandlerFor site)]) ()
-> HandlerFor site TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
 -> HandlerFor site TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
-> HandlerFor site TypedContent
forall a b. (a -> b) -> a -> b
$ do
  HandlerFor site Html
-> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep (HandlerFor site Html
 -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
-> HandlerFor site Html
-> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
forall a b. (a -> b) -> a -> b
$ WidgetFor site () -> HandlerFor site Html
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout (WidgetFor site () -> HandlerFor site Html)
-> WidgetFor site () -> HandlerFor site Html
forall a b. (a -> b) -> a -> b
$ do
    [whamlet|
      <dl>
        <dt>Hash
        <dd>#{gitRevHash}
        <dt>Branch
        <dd>#{gitRevBranch}
        <dt>Dirty
        <dd>#{gitRevDirty}
        <dt>Commit Date
        <dd>#{gitRevCommitDate}
        <dt>Commit Count
        <dd>#{gitRevCommitCount}
        <dt>Commit Message
        <dd>#{gitRevCommitMessage}
    |]
  -- TODO: derive & use toJSON
  HandlerFor site Value
-> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep (HandlerFor site Value
 -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
-> HandlerFor site Value
-> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
forall a b. (a -> b) -> a -> b
$ Value -> HandlerFor site Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> HandlerFor site Value) -> Value -> HandlerFor site Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
    [ Text
"hash"   Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
gitRevHash
    , Text
"branch" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
gitRevBranch
    , Text
"dirty"  Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
gitRevDirty
    , Text
"commitDate" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
gitRevCommitDate
    , Text
"commitCount" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
gitRevCommitCount
    , Text
"commitMessage" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
gitRevCommitMessage
    ]

instance Yesod site => YesodSubDispatch GitRev site where
  yesodSubDispatch :: YesodSubRunnerEnv GitRev site -> Application
yesodSubDispatch = $(mkYesodSubDispatch resourcesGitRev)