{-# LANGUAGE QuasiQuotes #-}

module Update.Nix.FetchGit
  ( processFile
  , processText
  , updatesFromText
  ) where

import           Control.Monad                  ( when )
import           Data.Fix
import           Data.Foldable
import           Data.Maybe
import           Data.Text                      ( Text
                                                , pack
                                                )
import qualified Data.Text                     as T
import qualified Data.Text.IO
import           Data.Time                      ( Day )
import qualified Data.Vector                   as V
import           Nix.Comments
import           Nix.Expr
import           Nix.Match.Typed
import           System.Exit
import           Update.Nix.FetchGit.Types
import           Update.Nix.FetchGit.Utils
import           Update.Nix.Updater
import           Update.Span
import           Control.Monad.Validate         ( MonadValidate(tolerate) )
import           Data.Functor
import           Control.Monad.Reader           ( MonadReader(ask) )

--------------------------------------------------------------------------------
-- Tying it all together
--------------------------------------------------------------------------------

-- | Provided FilePath, update Nix file in-place
processFile :: Env -> FilePath -> IO ()
processFile env filename = do
  t  <- Data.Text.IO.readFile filename
  t' <- processText env t
  -- If updates are needed, write to the file.
  when (t /= t') $ Data.Text.IO.writeFile filename t'

processText :: Env -> Text -> IO Text
processText env t = do
  (es, t') <- runM env (updatesFromText t <&> (`updateSpans` t))
  traverse_ (sayLog env Normal . formatWarning) es
  maybe exitFailure pure t'

-- | Given the path to a Nix file, returns the SpanUpdates
-- all the parts of the file we want to update.
updatesFromText :: Text -> M [SpanUpdate]
updatesFromText t = do
  let nixLines = V.fromList (T.lines t)
      getComment sourceLines =
        annotation . getCompose . unFix . annotateWithComments sourceLines
  tree <- do
    expr <- fromEither $ ourParseNixText t
    findUpdates (getComment nixLines) expr
  us <- evalUpdates tree
  case us of
    []  -> logVerbose "Made no updates"
    [_] -> logVerbose "Made 1 update"
    _   -> logVerbose ("Made " <> T.pack (show (length us)) <> " updates")
  pure us

----------------------------------------------------------------
-- Finding updates
----------------------------------------------------------------

findUpdates :: (NExprLoc -> Maybe Comment) -> NExprLoc -> M FetchTree
findUpdates getComment e = do
  Env {..} <- ask
  if not (null updateLocations || any (containsPosition e) updateLocations)
    then pure $ Node Nothing []
    else
      let updaters = ($ e) <$> fetchers getComment
      in
        case asum updaters of
          Just u  -> UpdaterNode <$> u
          Nothing -> case e of
            [matchNixLoc|{ _version = ^version; }|] ->
              Node version
                <$> traverse (findUpdates getComment) (toList (unFix e))
            _ -> Node Nothing
              <$> traverse (findUpdates getComment) (toList (unFix e))

evalUpdates :: FetchTree -> M [SpanUpdate]
evalUpdates = fmap snd . go
 where
  go :: FetchTree -> M (Maybe Day, [SpanUpdate])
  go = \case
    UpdaterNode (Updater u) -> u
    Node versionExpr cs     -> do
      (ds, ss) <- unzip . catMaybes <$> traverse (tolerate . go) cs
      -- Update version string with the maximum of versions in the children
      let latestDate = maximumMay (catMaybes ds)
      pure
        ( latestDate
        , [ SpanUpdate (exprSpan v) (quoteString . pack . show $ d)
          | Just d <- pure latestDate
          , Just v <- pure versionExpr
          ]
        <> concat ss
        )

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

maximumMay :: Ord a => [a] -> Maybe a
maximumMay = \case
  [] -> Nothing
  xs -> Just (maximum xs)