Run.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Lentil.Parse.Run
-- Copyright   :  © 2015 Francesco Ariis
-- License     :  GPLv3 (see the LICENSE file)
--
-- Parsing functions interface
-----------------------------------------------------------------------------


module Lentil.Parse.Run where

import Lentil.Types
import Lentil.Parse.Issue
import Lentil.Parse.Source
import Lentil.Parse.Syntaxes

import Text.Parsec

import Control.Applicative hiding (many, (<|>))
import qualified System.IO as I
import qualified System.Directory as D

import Prelude -- 7.8 hack



-- main function with wich to parse issues; errors on stderr
issueFinder :: [FilePath] -> IO [Issue]
issueFinder fps = fmap concat (mapM fileParser fps)

-- todo a function String -> [Issue] (w/o IO) [debug] [refactor]

-----------------
-- ANCILLARIES --
-----------------

-- errors to stderr
fileParser :: FilePath -> IO [Issue]
fileParser fp = D.doesFileExist fp >>= \fb ->

                -- file exists
                if fb == False
                  then perr (fp ++ " : no such file") >> return []
                  else

                -- parser exists
                case langParser fp of
                  Nothing -> return [] -- no error just empy list
                  Just p  -> readFile fp                >>=
                             runParIO p fp              >>=
                             parIssues fp . comms2Tuple


-- generic parsing --

runParIO :: Parsec String () [a] -> FilePath -> String -> IO [a]
runParIO p fp t = case runParser p () fp t of
                    Left l  -> perr (fp ++ " : parse error " ++
                                     show l) >> return []
                    Right r -> return r

-- output errors
perr :: String -> IO ()
perr cs  = I.hPutStrLn I.stderr cs


-- issue parsing --

parIssues :: FilePath -> [Comment] -> IO [Issue]
parIssues fp cs = concat <$> mapM (parIssue fp) cs

-- todo change '\n' trick [refactor] [duct]
-- why '\n'? see setRow comment
parIssue :: FilePath -> Comment -> IO [Issue]
parIssue fp (r, t) = runParIO (setRow r >> issues) fp ('\n':t)

-- why (r-1)? Every TODO must start on a newline, so we have to add a top
-- '\n' in case there immediately  is one
setRow :: Row -> ParIssue ()
setRow r = getPosition >>= setPosition . flip setSourceLine (r-1)