{-# LANGUAGE ViewPatterns #-}
module RlangQQ.ParseKnitted
  (parseKnitted,
   KnitInteraction(..),
   KnitOutput(..)) where
import Data.List.Split hiding (chunk)
import Data.List
import Data.Maybe
import Data.Char

-- | splits up the contents of the .md file generated by @knitr::knit@
parseKnitted file = grp . chunk . lines $ file

data KnitInteraction = KnitInteraction String [KnitOutput]
  deriving (Show)

data KnitOutput
    = KnitAsIs String -- ^ has markup to be interpreted
    | KnitPrint String
    | KnitWarning String
    | KnitError String
    | KnitImage String FilePath -- ^ @![caption](pathToImage)@
  deriving (Show)


chunk ( (stripPrefix "```" -> Just x) : xs) = 
    let (a,b) = break (isPrefixOf "```") xs
    in (x,a) : chunk b
chunk ("" : xs) = chunk xs
chunk [] = []

-- | depends on knitr's default opts_chunk$get(comment) = "##"
classify :: [String] -> [KnitOutput]
classify (x:xs) | Just r <- stripPrefix "## Warning: " x =
    [KnitWarning (unlines $ r : map (tryStripPrefix "## ") xs)]
classify (x:xs) | Just r <- stripPrefix "## Error: " x =
    [KnitError (unlines $ r : map (tryStripPrefix "## ") xs)]
classify xs = splitImg xs

splitImg (x:xs) | Just r <- stripPrefix "![" x =
  let end s = case splitOn "](" s of
              [a,b] -> Just (KnitImage a b)
              _ -> Nothing
      -- plot(lm(y ~ x)) comes out as ![caption1](a) ![caption2](b)
      getCaps [] = []
      getCaps s = mapMaybe end $ splitOn ") ![" (r ++ "![")
  in getCaps r ++ splitImg xs
splitImg [] = []
splitImg xs @ (x : _) | "## " `isPrefixOf` x =
  let (a,b) = span (isPrefixOf "## ") xs
  in KnitPrint (unlines $ map (tryStripPrefix "## ") a) : splitImg b
splitImg xs =
  let (a,b) = break (\x -> any (`isPrefixOf` x) ["![","## "]) xs
  in KnitAsIs (unlines a) : splitImg b

tryStripPrefix p x = fromMaybe x $ stripPrefix p x 

grp (((/= "") -> True, a) : xs) =
    let (b,c) = span ((== "") . fst) xs
    in KnitInteraction (unlines a) (filter notBlank $ concatMap (classify . snd) b) : grp c
grp [] = []

notBlank (KnitPrint x) = not (all isSpace x)
notBlank _ = True