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 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 FileNum = Int -- current file number
type TotNum  = Int -- total file number


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

issueFinder :: [Alias] -> [FlagWord] -> TotNum ->
               Pipe (FilePath, FileNum) [Issue] IO ()
issueFinder as fws tn = fpExist tn >->
                        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 fws

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

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

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

          -- 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ù
           (await >>= \r ->         --       elegante e breve. Ah! quando
                                    --       mettono le tuples section!
             yield (fp, r)))        --       [refactor] [duct]

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


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

-- generic parsing --

runParPipe :: (Stream i I.Identity t) => Parsec i s o ->
                                         FilePath -> s -> i ->
                                         Pipe ip o IO ()
runParPipe p fp s i = case runParser p s 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 ""