Run.hs

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

{-# LANGUAGE FlexibleContexts #-}

module Lentil.Parse.Run where

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

import Text.Parsec
import Pipes

import Control.Applicative hiding (many, (<|>))

import qualified System.Directory as D
import qualified Data.Functor.Identity as I
import qualified System.ProgressBar as PB
import qualified Control.Monad as CM
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import qualified Control.Exception as E

import Prelude -- 7.8 hack

-----------
-- TYPES --
-----------

type Cur = Int
type Tot = Int
type FilePathC = (FilePath, Cur, Tot)




issueFinder :: [Alias] -> Pipe FilePathC [Issue] IO ()
issueFinder as = fpExist   >->
                 fp2par as >->
                 fp2comm   >->
                 cms2iss
    where
          -- comm2Issues accepts Comment, we need [Comment]
          cms2iss = await >>= \(fp, cs) ->
                    let tra = zip (repeat fp) cs in
                    each tra                        >->
                    comm2Issues

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

-----------
-- PIPES --
-----------

-- file exist check
fpExist :: Pipe FilePathC FilePath IO ()
fpExist = await                       >>= \(fp, k, t) ->
          pbe k t                     >>
          liftIO (D.doesFileExist fp) >>= \fb ->
          if fb == False
            then liftIO (perr $ fp ++ " : no such file")
            else yield fp
    where
          fi i    = fromIntegral i
          lbl   t = show t ++ " source files"
          pb  k t = PB.mkProgressBar (PB.msg $ lbl t)
                                      PB.percentage 40 (fi k) (fi t)
          pbe k t = CM.when (mod k 30 == 0 && t > 100)
                            (liftIO (perrEph $ pb k t))

          -- todo: <qptain> personally i don't like when the leading
          --       character of the progress bar is different [feeback]
          --       [request]

-- pick appropriate parser (if exists)
fp2par :: [Alias] -> Pipe FilePath
                          (FilePath, ParSource [Comment]) IO ()
fp2par as = await >>= \fp ->
            case langParserAlias as fp of
              Nothing -> return ()
              Just p  -> yield (fp, fmap comms2Tuple p)

-- Parse raw comments
fp2comm :: Pipe (FilePath, ParSource [Comment]) (FilePath, [Comment]) IO ()
fp2comm = await                >>= \(fp, p) ->
          liftIO (safeRead fp) >>= \t ->

          (runParPipe p fp t >-> -- todo: sicuramente c'è un modo più elegante
           (await >>= \r ->      --       e breve. Ah! quando mettono le
                                 --       tuples section! [refactor] [duct]
             yield (fp, r)))

comm2Issues :: Pipe (FilePath, Comment) [Issue] IO ()
comm2Issues = await                           >>= \(fp, (r, i)) ->
              runParPipe (setRow r >> issues)
                         fp ('\n':i)          >>
              comm2Issues -- needed or will pick just head issue


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

-- generic parsing --

runParPipe :: (Stream i I.Identity t) => Parsec i () o ->
                                         FilePath -> i ->
                                         Pipe ip o IO ()
runParPipe p fp i = case runParser p () fp i of
                      Left l  -> liftIO (perr $ fp ++ " : parse error " ++
                                         show l)
                      Right r -> yield r

-- issue parsing --

-- 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)

safeRead :: FilePath -> IO String
safeRead fp = E.try (TI.readFile fp) >>= \e ->
              case e of
                Right t -> return (T.unpack t)
                Left x  -> perr (fp ++ " : " ++ show (x :: E.IOException) ++
                                 " -- ignoring file") >>
                           return ""