content: -- |
  -- License: GPL-3.0-or-later
  -- Copyright: Oleg Grenrus
  {-# LANGUAGE BangPatterns               #-}
  {-# LANGUAGE DerivingStrategies         #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE ScopedTypeVariables        #-}
  module CabalFmt.Comments where
  
  import qualified Data.ByteString           as BS
  import qualified Data.ByteString.Char8     as BS8
  import qualified Data.Map.Strict           as Map
  import qualified Distribution.Fields       as C
  import qualified Distribution.Fields.Field as C
  import qualified Distribution.Parsec       as C
  
  import CabalFmt.Prelude
  
  -------------------------------------------------------------------------------
  -- Comments wrapper
  -------------------------------------------------------------------------------
  
  newtype Comments = Comments [BS.ByteString]
    deriving stock Show
    deriving newtype (Semigroup, Monoid)
  
  unComments :: Comments -> [BS.ByteString]
  unComments (Comments cs) = cs
  
  nullComments :: Comments -> Bool
  nullComments (Comments cs) = null cs
  
  -------------------------------------------------------------------------------
  -- Attach comments
  -------------------------------------------------------------------------------
  
  -- | Returns a 'C.Field' forest with comments attached.
  --
  -- * Comments are attached to the field after it.
  -- * A glitch: comments "inside" the field are attached to the field after it.
  -- * End-of-file comments are returned separately.
  --
  attachComments
      :: BS.ByteString        -- ^ source with comments
      -> [C.Field C.Position] -- ^ parsed source fields
      -> ([C.Field (C.Position, Comments)], Comments)
  attachComments input inputFields =
      (overAnn attach attach' inputFields, endComments)
    where
      inputFieldsU :: [(FieldPath, C.Field C.Position)]
      inputFieldsU = fieldUniverseN inputFields
  
      comments :: [(Int, Comments)]
      comments = extractComments input
  
      comments' :: Map.Map FieldPath Comments
      comments' = Map.fromListWith (flip (<>))
          [ (path, cs)
          | (l, cs) <- comments
          , path <- toList (findPath C.fieldAnn l inputFieldsU)
          ]
  
      endComments :: Comments
      endComments = mconcat
          [ cs
          | (l, cs) <- comments
          , isNothing (findPath C.fieldAnn l inputFieldsU)
          ]
  
      attach :: FieldPath -> C.Position -> (C.Position, Comments)
      attach fp pos = (pos, fromMaybe mempty (Map.lookup fp comments'))
  
      attach' :: C.Position -> (C.Position, Comments)
      attach' pos = (pos, mempty)
  
  overAnn :: forall a b. (FieldPath -> a -> b) -> (a -> b) -> [C.Field a] -> [C.Field b]
  overAnn f h = go' id where
      go :: (FieldPath -> FieldPath) -> Int -> C.Field a -> C.Field b
      go g i (C.Field (C.Name a name) fls) =
          C.Field (C.Name b name) (h <$$> fls)
        where
          b = f (g (Nth i End)) a
  
      go g i (C.Section (C.Name a name) args fls) =
          C.Section (C.Name b name) (h <$$> args) (go' (g . Nth i) fls)
        where
          b = f (g (Nth i End)) a
  
      go' :: (FieldPath -> FieldPath) -> [C.Field a] -> [C.Field b]
      go' g xs = zipWith (go g) [0..] xs
  
      (<$$>) :: (Functor f, Functor g) => (x -> y) -> f (g x) -> f (g y)
      x <$$> y = (x <$>) <$> y
  
  -------------------------------------------------------------------------------
  -- Find comments in the input
  -------------------------------------------------------------------------------
  
  extractComments :: BS.ByteString -> [(Int, Comments)]
  extractComments = go . zip [1..] . map (BS.dropWhile isSpace8) . BS8.lines where
      go :: [(Int, BS.ByteString)] -> [(Int, Comments)]
      go [] = []
      go ((n, bs) : rest)
          | isComment bs = case span ((isComment .|| BS.null) . snd) rest of
              (h,t) -> (n, Comments $ bs : map snd h) : go t
          | otherwise = go rest
  
      (f .|| g) x = f x || g x
  
      isSpace8 w = w == 9 || w == 32
  
      isComment :: BS.ByteString -> Bool
      isComment = BS.isPrefixOf "--"
  
  -------------------------------------------------------------------------------
  -- FieldPath
  -------------------------------------------------------------------------------
  
  -- | Paths input paths. Essentially a list of offsets. Own type ofr safety.
  data FieldPath
      = End
      | Nth Int FieldPath -- nth field
    deriving (Eq, Ord, Show)
  
  fieldPathSize :: FieldPath -> Int
  fieldPathSize = go 0 where
      go !acc End = acc
      go !acc (Nth _ fp) = go (succ acc) fp
  
  fieldUniverseN :: [C.Field ann] -> [(FieldPath, C.Field ann)]
  fieldUniverseN = concat . zipWith g [0..] where
      g n f' = [ (Nth n p, f'') | (p, f'') <- fieldUniverse f' ]
  
  fieldUniverse :: C.Field ann -> [(FieldPath, C.Field ann)]
  fieldUniverse f@(C.Section _ _ fs) = (End,f) : concat (zipWith g [0..] fs) where
      g n f' = [ (Nth n p, f'') | (p, f'') <- fieldUniverse f' ]
  fieldUniverse f@(C.Field _ _)      = [(End, f)]
  
  -- note: fieldUniverse* should produce 'FieldPath's in increasing order
  -- that helps
  findPath :: (a -> C.Position) -> Int -> [(FieldPath, a)] -> Maybe FieldPath
  findPath _ _ [] = Nothing
  findPath f l [(p, x)]
      | C.Position k _ <- f x =
          if l < k then Just p else Nothing
  findPath f l ((_, x) : rest@((p, x') : _))
      | C.Position k  _ <- f x
      , C.Position k' _ <- f x' =
          if k < l && l < k'
          then Just p
          else findPath f l rest
  