{-# OPTIONS_GHC -F -pgmFtrhsx #-}
module Clckwrks.Darcs.PreProcess where
import Control.Monad.Trans
import Control.Applicative
import Clckwrks (ClckT, ClckState)
import Clckwrks.Darcs.URL
import Clckwrks.Darcs.Types (RepoId(..))
import Data.Attoparsec.Text
import           Data.Text (Text, pack)
import           Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as B
import HSP
import HSP.HTML (renderAsHTML)
import Web.Routes (showURL)

parseAttr :: Text -> Parser ()
parseAttr name =
    do skipMany space
       stringCI name
       skipMany space
       char '='
       skipMany space

parseCmd :: Parser DarcsCmd
parseCmd =
    choice [ parseAttr (pack "id") *> (ShowRepo . RepoId <$> decimal)
           ]

data DarcsCmd
    = ShowRepo RepoId

darcsCmd :: (Functor m, Monad m) => (DarcsURL -> [(Text, Maybe Text)] -> Text) -> Text -> ClckT url m Builder
darcsCmd
 showURLFn txt =
    do let mi = parseOnly parseCmd txt
       case mi of
         (Left e) ->
               return $ B.fromString e -- FIXME: format the error more nicely or something?
         (Right (ShowRepo rid)) ->
             do html <- unXMLGenT $ <a href=(showURLFn (ViewRepo rid) [])>#<% show $ unRepoId rid  %></a>
                return $ B.fromString $ concat $ lines $ renderAsHTML html
{-
         -- types are not setup to allow us to do this yet :(
         (Right ShowTimeline) ->
             do html <- unXMLGenT $ timelineWidget
                return $ B.fromString $ concat $ lines $ renderAsHTML html
-}