module CabalGild.Unstable.Action.ExtractComments where

import qualified CabalGild.Unstable.Type.Comment as Comment
import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Latin1
import qualified Data.ByteString.Internal as ByteStringInternal
import qualified Data.Maybe as Maybe
import qualified Data.Word as Word
import qualified Distribution.Parsec.Position as Position

-- | Extracts comments from the given byte string. This is a wrapper around
-- 'fromLine', where lines are split using 'Latin1.lines'.
fromByteString :: ByteString.ByteString -> [Comment.Comment Position.Position]
fromByteString :: ByteString -> [Comment Position]
fromByteString =
  ((Int, ByteString) -> Maybe (Comment Position))
-> [(Int, ByteString)] -> [Comment Position]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ((Int -> ByteString -> Maybe (Comment Position))
-> (Int, ByteString) -> Maybe (Comment Position)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ByteString -> Maybe (Comment Position)
forall (m :: * -> *).
(Alternative m, Monad m) =>
Int -> ByteString -> m (Comment Position)
fromLine)
    ([(Int, ByteString)] -> [Comment Position])
-> (ByteString -> [(Int, ByteString)])
-> ByteString
-> [Comment Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..]
    ([ByteString] -> [(Int, ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(Int, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
Latin1.lines

-- | Extracts a comment from the given line. If the line does not contain a
-- comment, the result will be 'Alternative.empty'.
fromLine ::
  (Applicative.Alternative m, Monad m) =>
  Int ->
  ByteString.ByteString ->
  m (Comment.Comment Position.Position)
fromLine :: forall (m :: * -> *).
(Alternative m, Monad m) =>
Int -> ByteString -> m (Comment Position)
fromLine Int
row ByteString
line = do
  let (ByteString
before, ByteString
after) = ByteString -> (ByteString, ByteString)
breakComment ByteString
line
  ByteString
rest <-
    m ByteString
-> (ByteString -> m ByteString) -> Maybe ByteString -> m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ByteString
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m ByteString)
-> Maybe ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$
      ByteString -> ByteString -> Maybe ByteString
ByteString.stripPrefix ByteString
Comment.delimiter ByteString
after
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> Bool
ByteString.all Word8 -> Bool
isBlank ByteString
before
  Comment Position -> m (Comment Position)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Comment.Comment
      { annotation :: Position
Comment.annotation = Int -> Int -> Position
Position.Position Int
row (Int -> Position) -> Int -> Position
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
ByteString.length ByteString
before,
        value :: ByteString
Comment.value = (Word8 -> Bool) -> ByteString -> ByteString
ByteString.dropWhileEnd Word8 -> Bool
isBlank ByteString
rest
      }

-- | Breaks a byte string into two parts: the part before the comment delimiter
-- and the part after. If there is no comment, the part after will be empty.
breakComment :: ByteString.ByteString -> (ByteString.ByteString, ByteString.ByteString)
breakComment :: ByteString -> (ByteString, ByteString)
breakComment = ByteString -> ByteString -> (ByteString, ByteString)
ByteString.breakSubstring ByteString
Comment.delimiter

-- | Returns true if the given byte is a blank character. Currently this is a
-- wrapper around 'ByteStringInternal.isSpaceWord8'. Perhaps it should only
-- check for spaces and tabs though.
isBlank :: Word.Word8 -> Bool
isBlank :: Word8 -> Bool
isBlank = Word8 -> Bool
ByteStringInternal.isSpaceWord8