content: module Development.Blog.Util.EntryPP (readPreProcess) where
  
  import "base" Prelude
  import Config.SiteData
  import Control.Applicative    ((*>))
  import Control.Arrow          ((&&&))
  import Control.Monad
  import Data.Functor
  import Data.Maybe             (fromMaybe)
  import System.FilePath        ((</>))
  import Text.Parsec
  import Text.Parsec.Text
  import Web.Blog.Render        (renderUrl')
  import Web.Blog.Types
  import qualified Data.Text    as T
  import qualified Data.Text.IO as T
  
  samplesDir :: FilePath
  samplesDir = "code-samples"
  
  readPreProcess :: FilePath -> IO String
  readPreProcess entryFile = do
      eLines <- T.lines <$> T.readFile entryFile
  
      eLinesPP <- forM eLines $ \line ->
        if "!!!" `T.isPrefixOf` line
          then insertSample . T.strip . T.dropWhile (== '!') $ line
          else return line
  
      return . T.unpack . T.unlines $ eLinesPP
  
  data SampleSpec = SampleSpec  { sSpecFile       :: FilePath
                                , _sSpecLive      :: Maybe String
                                , _sSpecKeywords  :: [(String,Maybe Int)]
                                } deriving (Show)
  
  insertSample :: T.Text -> IO T.Text
  insertSample sampline = do
      let spec' = runP sampleSpec () (T.unpack sampline) sampline
  
      case spec' of
          Left err    ->
              return $ T.pack (show err)
          Right spec  -> do
              rawSamp <- T.readFile (samplesDir </> sSpecFile spec)
              return $ processSample spec rawSamp
  
  processSample :: SampleSpec -> T.Text -> T.Text
  processSample (SampleSpec sFile sLive sKeys) rawSamp = processed
    where
      rawLines = T.lines rawSamp
      zipped = zip rawLines [1..]
      blocks =
        if null sKeys
          then
            return
              ( (snd . head &&& snd . last) zipped
              , T.unlines (map fst zipped)        )
          else
            map (uncurry (grabBlock zipped)) sKeys
      startLine = minimum . map (fst . fst) $ blocks
      endLine   = maximum . map (snd . fst) $ blocks
      sampCode  = T.unlines . map snd $ blocks
      toHeading key val = T.pack . concat $ ["-- ", key, ": ", val, "\n"]
      sourceHeading   =
        case sampleBlobs of
          Nothing -> ""
          Just blob ->
            let suffix  = concat ["#L",show startLine,"-",show endLine]
                suffix' = if null sKeys then "" else suffix
            in  toHeading
                  "source"
                  (blob </> sFile ++ suffix')
      interHeading =
        let maybeHeading = do
              inter <- interactiveUrl
              live <- sLive
              return $ toHeading "interactive" (inter </> live)
        in fromMaybe "" maybeHeading
      processed = T.concat [sourceHeading, interHeading, sampCode]
  
  
  grabBlock :: [(T.Text,Int)] -> String -> Maybe Int -> ((Int,Int), T.Text)
  grabBlock zipped key limit = grabbed
    where
      zDropped =
        dropWhile (not . (T.pack key `T.isInfixOf`) . fst) zipped
      (zHead,zRest) =
        span (\(l,_) -> not (T.null l)) zDropped
      zBlock        =
        takeWhile (\(l,_) -> T.null l || " " `T.isPrefixOf` l) zRest
      zBlock'       =
        reverse . dropWhile (T.null . fst) . reverse $ zBlock
      zAll =
        case limit of
          Just lim -> take lim zDropped
          Nothing  -> zHead ++ zBlock'
      startLine     = snd . head $ zAll
      endLine       = snd . last $ zAll
      sampCode      = T.unlines . map fst $ zAll
      grabbed = ((startLine, endLine), sampCode)
  
  sampleBlobs :: Maybe String
  sampleBlobs = do
      void $ siteDataPublicBlobs siteData
      return . T.unpack . renderUrl' . T.pack $ "/source" </> samplesDir
  
  interactiveUrl :: Maybe String
  interactiveUrl = T.unpack <$> siteDataInteractiveUrl siteData
  
  sampleSpec :: Parser SampleSpec
  sampleSpec = do
      filePath <- noSpaces <?> "sample filePath"
      spaces
      keywords <- many $ do
        keyword <- char '"' *> manyTill anyChar (char '"') <?> "keyword"
        keylimit <- optionMaybe (read <$> many1 digit <?> "keyword limit")
        spaces
        return (keyword,keylimit)
  
      live <- optionMaybe noSpaces <?> "live url"
      let
        live' = mfilter (not . null) live
  
      return $ SampleSpec filePath live' keywords
    where
      noSpaces = manyTill anyChar (space <|> ' ' <$ eof)
  