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

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

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 Vector Text
sourceLines = NExprLoc -> NExprComments
go
  where
    go :: NExprLoc -> NExprComments
    go :: NExprLoc -> NExprComments
go = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. NExprLocF f -> NExprCommentsF f
go' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NExprLoc -> NExprComments
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Fix f -> f (Fix f)
unFix

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

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

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