{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Development.HgRev.TH where
import Data.Aeson (ToJSON (..), encode, object, (.=))
import Data.ByteString.Lazy.Char8 (unpack)
import Data.Char (toLower)
import Data.Monoid ((<>))
import Development.HgRev (HgRev (..), HgState (..),
hgIsClean, hgRevState, hgShortRev)
import Language.Haskell.TH (ExpQ, runIO, stringE)
import System.Directory (getCurrentDirectory)
type FormatFn = (HgRev -> HgState -> String)
hgRevStateTH :: FormatFn -> ExpQ
hgRevStateTH format = do
revState <- runIO $ hgRevState =<< getCurrentDirectory
stringE $ maybe "UNKNOWN" (uncurry format) revState
defFormat :: FormatFn
defFormat rev state
= "\n long: " <> hgRevision rev
<> "\n short: " <> hgShortRev rev
<> "\n clean: " <> (map toLower . show $ hgIsClean state)
jsonFormat :: FormatFn
jsonFormat rev state = unpack . encode $ HgRevState (rev, state)
newtype HgRevState = HgRevState (HgRev, HgState)
instance ToJSON HgRevState where
toJSON (HgRevState (r, s)) =
object
[ "long" .= hgRevision r
, "short" .= hgShortRev r
, "branch" .= hgBranch r
, "tags" .= hgTags r
, "bookmarks" .= hgBookmarks r
, "clean" .= hgIsClean s
]