module Nix.Comments
  ( annotateWithComments
  , Comment
  , NExprCommentsF
  , NExprComments
  ) where

import           Data.Text                      ( Text )
import           Data.Vector                    ( (!?)
                                                , Vector
                                                )
import           Data.Fix
import           Nix.Expr
import qualified Data.Text                     as T
import           Data.Char                      ( isSpace )

type Comment = Text

type NExprCommentsF = AnnF (Maybe Comment) NExprLocF

type NExprComments = Fix NExprCommentsF

-- | A comment will be added to an expression if it occurs immediately after
-- the expression in the source, i.e. on the same line with only space and ';'
-- in between.
--
-- >>> import Nix.Parser
-- >>> import Nix.Pretty
-- >>> import Data.Vector
-- >>> import Data.Foldable
-- >>> lines = T.pack <$> ["1 # foo", "+ {a=2; # bar","} # baz"]
-- >>> str = T.unlines $ lines
-- >>> Success nix = parseNixTextLoc str
-- >>> ann = annotateWithComments (fromList lines) nix
-- >>> fixUniverse e = e : (fixUniverse =<< Data.Foldable.toList (unFix e))
-- >>> pretty e@(Fix (Compose (Ann comment _)))= (prettyNix (stripAnnotation (stripAnnotation e)), comment)
-- >>> pretty <$> fixUniverse ann
-- [(1 + { a = 2; },Just "baz"),(1,Just "foo"),({ a = 2; },Just "baz"),(2,Just "bar")]
annotateWithComments :: Vector Text -> NExprLoc -> NExprComments
annotateWithComments :: Vector Text -> NExprLoc -> NExprComments
annotateWithComments sourceLines :: Vector Text
sourceLines = NExprLoc -> NExprComments
go
 where
  go :: NExprLoc -> NExprComments
  go :: NExprLoc -> NExprComments
go = Compose (Ann (Maybe Text)) NExprLocF NExprComments -> NExprComments
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Compose (Ann (Maybe Text)) NExprLocF NExprComments
 -> NExprComments)
-> (NExprLoc -> Compose (Ann (Maybe Text)) NExprLocF NExprComments)
-> NExprLoc
-> NExprComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLocF NExprComments
-> Compose (Ann (Maybe Text)) NExprLocF NExprComments
forall f. NExprLocF f -> NExprCommentsF f
go' (NExprLocF NExprComments
 -> Compose (Ann (Maybe Text)) NExprLocF NExprComments)
-> (NExprLoc -> NExprLocF NExprComments)
-> NExprLoc
-> Compose (Ann (Maybe Text)) NExprLocF NExprComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> NExprComments)
-> NExprLocF NExprLoc -> NExprLocF NExprComments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NExprLoc -> NExprComments
go (NExprLocF NExprLoc -> NExprLocF NExprComments)
-> (NExprLoc -> NExprLocF NExprLoc)
-> NExprLoc
-> NExprLocF NExprComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLoc -> NExprLocF NExprLoc
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

  go' :: NExprLocF f -> NExprCommentsF f
  go' :: NExprLocF f -> NExprCommentsF f
go' e :: NExprLocF f
e =
    let
      comment :: Maybe Text
comment = case SrcSpan -> SourcePos
spanEnd (SrcSpan -> SourcePos)
-> (NExprLocF f -> SrcSpan) -> NExprLocF f -> SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann SrcSpan (NExprF f) -> SrcSpan
forall ann a. Ann ann a -> ann
annotation (Ann SrcSpan (NExprF f) -> SrcSpan)
-> (NExprLocF f -> Ann SrcSpan (NExprF f))
-> NExprLocF f
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLocF f -> Ann SrcSpan (NExprF f)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (NExprLocF f -> SourcePos) -> NExprLocF f -> SourcePos
forall a b. (a -> b) -> a -> b
$ NExprLocF f
e of
        SourcePos _ line :: Pos
line col :: Pos
col -> do
          Text
theLine                <- Vector Text
sourceLines Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
!? (Pos -> Int
unPos Pos
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
          Text
theLineAfterExpression <- Int -> Text -> Maybe Text
dropMaybe (Pos -> Int
unPos Pos
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Text
theLine
          let theLineAfterCruft :: Text
theLineAfterCruft = (Char -> Bool) -> Text -> Text
T.dropWhile (\c :: Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';'))
                                              Text
theLineAfterExpression
          ('#', theComment :: Text
theComment) <- Text -> Maybe (Char, Text)
T.uncons Text
theLineAfterCruft
          Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
T.strip Text
theComment)
    in  Ann (Maybe Text) (NExprLocF f) -> NExprCommentsF f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Maybe Text -> NExprLocF f -> Ann (Maybe Text) (NExprLocF f)
forall ann a. ann -> a -> Ann ann a
Ann Maybe Text
comment NExprLocF f
e)

----------------------------------------------------------------
-- Utils
----------------------------------------------------------------

dropMaybe :: Int -> Text -> Maybe Text
dropMaybe :: Int -> Text -> Maybe Text
dropMaybe i :: Int
i t :: Text
t = if Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
i Text
t else Maybe Text
forall a. Maybe a
Nothing