packages feed

darcsden-1.1: src/DarcsDen/Handler/Repository/Util.hs

{-# LANGUAGE TypeFamilies, CPP #-}
module DarcsDen.Handler.Repository.Util where

#ifndef DARCS28
import Darcs.Repository.Flags (UseCache(..))
#endif
import Darcs.Repository.Internal (IdentifyRepo(..))
import Darcs.Patch ( RepoPatch )
import Darcs.Patch.Apply ( ApplyState )
import Storage.Hashed.Tree ( Tree )
import qualified Darcs.Repository as R
import qualified Data.ByteString as BS

#ifdef HIGHLIGHTINGKATE
import Safe (headDef)
import Text.Highlighting.Kate
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import qualified Data.ByteString.UTF8 as BUTF8

import DarcsDen.Util
#elif defined(HIGHLIGHTER)
import Text.Highlighter
import Text.Highlighter.Formatters.Html
import Text.Blaze.Renderer.Utf8 (renderHtml)

import DarcsDen.Util
#endif



getRepo :: (RepoPatch p, ApplyState p ~ Tree) => String -> IO (Either String (R.Repository p r u t))
getRepo p = do
#ifdef DARCS28
    ir <- R.maybeIdentifyRepository [] p
#else
    ir <- R.maybeIdentifyRepository YesUseCache p
#endif
    case ir of
        GoodRepository r -> return (Right r)
        BadRepository s -> return (Left s)
        NonRepository s -> return (Left s)

highlightBlob :: FilePath -> BS.ByteString -> BS.ByteString
highlightBlob = highlight True

highlight :: Bool -> FilePath -> BS.ByteString -> BS.ByteString
#ifdef HIGHLIGHTINGKATE
highlight = highlightHighlightingKate
#elif defined(HIGHLIGHTER)
highlight = highlightHighlighter
#else
highlight _ _ s = s
#endif

#ifdef HIGHLIGHTINGKATE
highlightHighlightingKate :: Bool -> FilePath -> BS.ByteString -> BS.ByteString
highlightHighlightingKate linenums filename bs
  -- | '\xFFFD' `BS.elem` bs' = "Could not highlight, click the file name to view raw content"
  | otherwise              = bs'
  where
    s = BUTF8.toString bs -- invalid characters replaced with '\xFFFD'
    lang = headDef "" $ languagesByFilename filename
    sourcelines = highlightAs lang s
    html = formatHtmlBlock defaultFormatOpts{numberLines=linenums, lineAnchors=True} sourcelines
    bs' = strictLBS $ renderHtml html
#endif

#ifdef HIGHLIGHTER
highlightHighlighter :: Bool -> FilePath -> BS.ByteString -> BS.ByteString
highlightHighlighter lineNums fn s =
    case lexer of
        Just l ->
            case runLexer l s of
                Right ts -> render ts
                Left _ -> render [Token Text s]
        Nothing -> render [Token Text s]
  where
    lexer = lexerFromFilename fn
    render = strictLBS . renderHtml . format lineNums
#endif