Run.hs

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

{-# LANGUAGE FlexibleContexts, LambdaCase #-}

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.Megaparsec
import Pipes

import qualified Control.Monad         as CM
import qualified System.Directory      as D
import qualified Control.Exception     as E
import qualified System.ProgressBar    as PB
import qualified Data.Text             as T
import qualified Data.Text.IO          as TI
import qualified Data.Text.Lazy        as TL


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


-----------
-- 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
          pbe k = CM.when (mod k 30 == 0 && t > 100)
                          (liftIO (() <$ pb k))

          -- the bar itself
          pb  k = PB.newProgressBar
                        myBar
                        2
                        (PB.Progress (fi k) (fi t) ())
          myBar = PB.defStyle {
                    PB.styleDone = '*',
                    PB.styleCurrent = '*',
                    PB.styleTodo = ' ',
                    PB.styleWidth = PB.ConstantWidth 40,
                    PB.stylePrefix = PB.msg barMes
                    }
          barMes = TL.pack $ show t ++ " source files"


-- 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 >->
           (await >>= \r ->

             yield (fp, r)))

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


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

-- generic parsing --

runParPipe :: (Show i, Show (Token i)) =>
              StateParser i s o ->
              FilePath -> s -> i ->
              Pipe ip o IO ()
runParPipe p fp s i =
            case runStateParser p s fp i of
              Left l  -> liftIO (perr $ fp ++ " : parse error " ++
                                 show l)
              Right r -> yield r

-- issue parsing --

-- todo [refactor] Row should be carried on by issues, not be manually set!
setRow :: Row -> ParIssue ()
setRow r = updateParserState
             (\(State i o (PosState pix po (SourcePos n _ cx) tw lp)) ->
                let l' = mkPos $ r in
               (State i o (PosState pix po (SourcePos n l' cx) tw lp)))

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