{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

-- | Parse and combine a stream of tags.
--
module GhcTags.Stream
    ( tagParser
    , combineTagsPipe
    , runCombineTagsPipe
    ) where

import           Control.Monad.State.Strict
import           Data.ByteString (ByteString)
import           Data.Attoparsec.ByteString (Parser)
import qualified Data.ByteString as BS
import           Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BS
import           Data.Functor (($>))
import qualified Data.Text.Encoding as Text
import           System.IO
import           System.FilePath.ByteString (RawFilePath)

import           Pipes ((>->), (~>))
import qualified Pipes as Pipes
import qualified Pipes.Lift as Pipes
import qualified Pipes.Attoparsec as Pipes.AP
import qualified Pipes.ByteString as Pipes.BS

import           GhcTags.Tag


-- | Parse a stream of tags, coming from a 'Text' producer.
--
tagParser :: MonadIO m
          => Parser (Maybe (Tag tk))
          -- ^ Parse a single tag.  For Vim this returns should parse a single
          -- line and return the tag, e.g  'parseTagLine'.
          -> Pipes.Producer ByteString m ()
          -> Pipes.Producer (Tag tk) m ()
tagParser :: forall (m :: * -> *) (tk :: TAG_KIND).
MonadIO m =>
Parser (Maybe (Tag tk))
-> Producer ByteString m () -> Producer (Tag tk) m ()
tagParser Parser (Maybe (Tag tk))
parser Producer ByteString m ()
producer = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
Pipes.for
    (forall (m :: * -> *) a b r.
(Monad m, ParserInput a) =>
Parser a b
-> Producer a m r
-> Producer b m (Either (ParsingError, Producer a m r) r)
Pipes.AP.parsed Parser (Maybe (Tag tk))
parser Producer ByteString m ()
producer)
    forall a b. (a -> b) -> a -> b
$ \case
      -- ignore header lines
      Just Tag tk
tag -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield Tag tk
tag
      Maybe (Tag tk)
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Streaming version of 'GhcTags.Tag.combineTags'.
--
combineTagsPipe
    :: forall m (tk :: TAG_KIND).  Applicative m
    => (Tag tk -> Tag tk -> Ordering)
    -> RawFilePath -- ^ file path from which the new tags were obtained, it should be normalised
    -> Tag tk      -- ^ tag read from disc
    -> [Tag tk]    -- ^ new tags
    -> Pipes.Producer (Tag tk) m [Tag tk]
combineTagsPipe :: forall (m :: * -> *) (tk :: TAG_KIND).
Applicative m =>
(Tag tk -> Tag tk -> Ordering)
-> ByteString -> Tag tk -> [Tag tk] -> Producer (Tag tk) m [Tag tk]
combineTagsPipe Tag tk -> Tag tk -> Ordering
compareFn ByteString
modPath = Tag tk -> [Tag tk] -> Producer (Tag tk) m [Tag tk]
go
  where
    go :: Tag tk -> [Tag tk]
       -> Pipes.Producer (Tag tk) m [Tag tk]

    -- omitt all the tags which point to 'modPath'
    --
    -- note: we check that 'tagFilePath' ends with 'modPath', which is
    -- a relative path from the corresponding cabal file.
    go :: Tag tk -> [Tag tk] -> Producer (Tag tk) m [Tag tk]
go Tag tk
tag [Tag tk]
as
      | ByteString
modPath ByteString -> ByteString -> Bool
`BS.isSuffixOf` Text -> ByteString
Text.encodeUtf8 (TagFilePath -> Text
getRawFilePath (forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath Tag tk
tag))
      = forall (f :: * -> *) a. Applicative f => a -> f a
pure [Tag tk]
as

    go Tag tk
tag as :: [Tag tk]
as@(Tag tk
a : [Tag tk]
as')
      | Bool
otherwise = case Tag tk
a Tag tk -> Tag tk -> Ordering
`compareFn` Tag tk
tag of
          Ordering
LT -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield Tag tk
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tag tk -> [Tag tk] -> Producer (Tag tk) m [Tag tk]
go Tag tk
tag [Tag tk]
as'
          Ordering
EQ -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield Tag tk
a forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Tag tk]
as'
          Ordering
GT -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield Tag tk
tag forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Tag tk]
as

    go Tag tk
tag [] = forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield Tag tk
tag forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []


-- | run 'combineTagsPipe' taking care of the state.
--
runCombineTagsPipe
    :: MonadIO m
    => Handle
    -> (Tag tk -> Tag tk -> Ordering)
    -> (Tag tk -> Builder)
    -> RawFilePath
    -> Tag tk
    -> Pipes.Effect (StateT [Tag tk] m) ()
runCombineTagsPipe :: forall (m :: * -> *) (tk :: TAG_KIND).
MonadIO m =>
Handle
-> (Tag tk -> Tag tk -> Ordering)
-> (Tag tk -> Builder)
-> ByteString
-> Tag tk
-> Effect (StateT [Tag tk] m) ()
runCombineTagsPipe Handle
writeHandle Tag tk -> Tag tk -> Ordering
compareFn Tag tk -> Builder
formatTag ByteString
modPath =
       (\Tag tk
tag -> forall (m :: * -> *) s a' a b' b r.
Monad m =>
(s -> Proxy a' a b' b m (r, s)) -> Proxy a' a b' b (StateT s m) r
Pipes.stateP forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((),) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (tk :: TAG_KIND).
Applicative m =>
(Tag tk -> Tag tk -> Ordering)
-> ByteString -> Tag tk -> [Tag tk] -> Producer (Tag tk) m [Tag tk]
combineTagsPipe Tag tk -> Tag tk -> Ordering
compareFn ByteString
modPath Tag tk
tag)
    forall (m :: * -> *) a x' x b' b a' c' c.
Functor m =>
(a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b') -> a -> Proxy x' x c' c m a'
~> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag tk -> Builder
formatTag
    forall (m :: * -> *) a x' x b' b a' c' c.
Functor m =>
(a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b') -> a -> Proxy x' x c' c m a'
~> (\ByteString
bs -> forall (m :: * -> *).
Monad m =>
ByteString -> Producer' ByteString m ()
Pipes.BS.fromLazy ByteString
bs)
    forall (m :: * -> *) a x' x b' b a' c' c.
Functor m =>
(a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b') -> a -> Proxy x' x c' c m a'
~> (\ByteString
bs -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield ByteString
bs forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> forall (m :: * -> *) r.
MonadIO m =>
Handle -> Consumer' ByteString m r
Pipes.BS.toHandle Handle
writeHandle)