{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}

module Snipcheck where

import Control.Monad
import Data.Maybe
import qualified Data.Map as Map
import Data.Monoid
import System.Process(readCreateProcess, shell)
import Text.Pandoc (Block(..))

import qualified Text.Pandoc as Pandoc

data Sloppy a = Skip | Must a deriving (Show, Functor)

sloppyString :: String -> Sloppy String
sloppyString "..." = Skip
sloppyString str = Must str

checkSloppy :: Eq a => [a] -> [Sloppy a] -> Bool
checkSloppy (a:as) (Must a':as')
  | a == a' = checkSloppy as as'
  | otherwise = False
checkSloppy (a:as) as'@(Skip:Must a':as'')
  | a == a' = checkSloppy as as''
  | otherwise = checkSloppy as as'
checkSloppy as (Skip:Skip:as') = checkSloppy as (Skip:as')
checkSloppy [] (Must{}:_) = False
checkSloppy [] (Skip:as') = checkSloppy [] as'
checkSloppy [] [] = True
checkSloppy (_:_) [] = False
checkSloppy _ [Skip] = True

checkMarkdownFile :: FilePath -> IO ()
checkMarkdownFile fp = do
    content <- readFile fp
    let Right (Pandoc.Pandoc meta blocks) = Pandoc.readMarkdown Pandoc.def content
        sections = findSections meta
        blocks' =
          if null sections
          then blocks
          else filterBlocksBySectionName sections blocks
    forM_ blocks' check

data AcceptSection
  = GoodSection
  | BadSection
  | Dunno

filterBlocksBySectionName :: [String] -> [Pandoc.Block] -> [Pandoc.Block]
filterBlocksBySectionName secs = skipThese
  where
    skipThese, keepThese :: [Pandoc.Block] -> [Pandoc.Block]
    skipThese (b:bs) =
      case acceptSection b of
        GoodSection -> keepThese bs
        _ -> skipThese bs
    skipThese [] = []
    keepThese (b:bs) = b : case acceptSection b of
      BadSection -> skipThese bs
      _ -> keepThese bs
    keepThese [] = []
    acceptSection :: Pandoc.Block -> AcceptSection
    acceptSection (Pandoc.Header _ (hName,_,_) _)
      | hName `elem` secs = GoodSection
      | otherwise = BadSection
    acceptSection _ = Dunno

findSections :: Pandoc.Meta -> [String]
findSections (Pandoc.unMeta -> meta) =
  case Map.lookup "sc_check-sections" meta of
    Just (Pandoc.MetaList ss) -> join $ unMetaString <$> ss
    _ -> []
  where
    unMetaString :: Pandoc.MetaValue -> [String]
    unMetaString (Pandoc.MetaString s) =[s]
    unMetaString (Pandoc.MetaInlines is) = mapMaybe unMetaStr is
    unMetaString _ = []
    unMetaStr :: Pandoc.Inline -> Maybe String
    unMetaStr (Pandoc.Str s) = Just s
    unMetaStr _ = Nothing

check :: Pandoc.Block -> IO ()
check (CodeBlock (typ, classes, kvs) content)
  | "shell" `elem` classes = do
      let Right cmds = extractCommands content
      forM_ cmds $ \(cmd, expected) -> do
        actual <- lines <$> readCreateProcess (shell cmd) ""
        let expected' = sloppyString <$> expected
        unless (checkSloppy actual expected') $ error $ mconcat
          [ "Couldnt match expected ", show expected'
          , " with " <> show actual
          ]
  | otherwise = print (typ, classes, kvs)
check _ = return ()

extractCommands :: String -> Either String [(String, [String])]
extractCommands str = go (lines str)
  where
    go :: [String] -> Either String [(String, [String])]
    go (l:ls) | Just cmd <- toCommand l =
      let (output, rest) = break isCommand ls
      in ((cmd,output):) <$> go rest
              | otherwise = Left $ "Expected a command, got " <> l
    go [] = Right []
    toCommand :: String -> Maybe String
    toCommand ('$':cmd) = Just cmd
    toCommand _ = Nothing
    isCommand :: String -> Bool
    isCommand = isJust . toCommand


someFunc :: IO ()
someFunc = putStrLn "someFunc"