{-# LANGUAGE QuasiQuotes #-}
module Update.Nix.FetchGit
( processFile
, processText
, updatesFromText
) where
import Control.Monad ( when )
import Control.Monad.Reader ( MonadReader(ask) )
import Control.Monad.Validate ( MonadValidate(tolerate) )
import Data.Fix
import Data.Foldable
import Data.Functor
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 Text.Regex.TDFA
import Update.Nix.FetchGit.Types
import Update.Nix.FetchGit.Utils
import Update.Nix.Updater
import Update.Span
processFile :: Env -> FilePath -> IO ()
processFile :: Env -> FilePath -> IO ()
processFile Env
env FilePath
filename = do
Text
t <- FilePath -> IO Text
Data.Text.IO.readFile FilePath
filename
Text
t' <- Env -> Text -> IO Text
processText Env
env Text
t
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
t') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
Data.Text.IO.writeFile FilePath
filename Text
t'
processText :: Env -> Text -> IO Text
processText :: Env -> Text -> IO Text
processText Env
env Text
t = do
([Warning]
es, Maybe Text
t') <- Env -> M Text -> IO ([Warning], Maybe Text)
forall a. Env -> M a -> IO ([Warning], Maybe a)
runM Env
env (Text -> M [SpanUpdate]
updatesFromText Text
t M [SpanUpdate] -> ([SpanUpdate] -> Text) -> M Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([SpanUpdate] -> Text -> Text
`updateSpans` Text
t))
(Warning -> IO ()) -> [Warning] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Env -> Verbosity -> Text -> IO ()
sayLog Env
env Verbosity
Normal (Text -> IO ()) -> (Warning -> Text) -> Warning -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warning -> Text
formatWarning) [Warning]
es
IO Text -> (Text -> IO Text) -> Maybe Text -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Text
forall a. IO a
exitFailure Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO Text) -> Maybe Text -> IO Text
forall a b. (a -> b) -> a -> b
$ case Env -> Dryness
dryness Env
env of
Dryness
Wet -> Maybe Text
t'
Dryness
Dry -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
updatesFromText :: Text -> M [SpanUpdate]
updatesFromText :: Text -> M [SpanUpdate]
updatesFromText Text
t = do
let nixLines :: Vector Text
nixLines = [Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList (Text -> [Text]
T.lines Text
t)
getComment :: Vector Text -> NExprLoc -> Maybe Text
getComment Vector Text
sourceLines =
Ann (Maybe Text) (NExprLocF (Fix NExprCommentsF)) -> Maybe Text
forall ann a. Ann ann a -> ann
annotation (Ann (Maybe Text) (NExprLocF (Fix NExprCommentsF)) -> Maybe Text)
-> (NExprLoc -> Ann (Maybe Text) (NExprLocF (Fix NExprCommentsF)))
-> NExprLoc
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Ann (Maybe Text)) NExprLocF (Fix NExprCommentsF)
-> Ann (Maybe Text) (NExprLocF (Fix NExprCommentsF))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Ann (Maybe Text)) NExprLocF (Fix NExprCommentsF)
-> Ann (Maybe Text) (NExprLocF (Fix NExprCommentsF)))
-> (NExprLoc
-> Compose (Ann (Maybe Text)) NExprLocF (Fix NExprCommentsF))
-> NExprLoc
-> Ann (Maybe Text) (NExprLocF (Fix NExprCommentsF))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix NExprCommentsF
-> Compose (Ann (Maybe Text)) NExprLocF (Fix NExprCommentsF)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (Fix NExprCommentsF
-> Compose (Ann (Maybe Text)) NExprLocF (Fix NExprCommentsF))
-> (NExprLoc -> Fix NExprCommentsF)
-> NExprLoc
-> Compose (Ann (Maybe Text)) NExprLocF (Fix NExprCommentsF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Text -> NExprLoc -> Fix NExprCommentsF
annotateWithComments Vector Text
sourceLines
FetchTree
tree <- do
NExprLoc
expr <- Either Warning NExprLoc -> M NExprLoc
forall a. Either Warning a -> M a
fromEither (Either Warning NExprLoc -> M NExprLoc)
-> Either Warning NExprLoc -> M NExprLoc
forall a b. (a -> b) -> a -> b
$ Text -> Either Warning NExprLoc
ourParseNixText Text
t
(NExprLoc -> Maybe Text)
-> NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
findUpdates (Vector Text -> NExprLoc -> Maybe Text
getComment Vector Text
nixLines) NExprLoc
expr
[SpanUpdate]
us <- FetchTree -> M [SpanUpdate]
evalUpdates (FetchTree -> M [SpanUpdate])
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
-> M [SpanUpdate]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FetchTree -> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
filterUpdates FetchTree
tree
case [SpanUpdate]
us of
[] -> Text -> ReaderT Env (ValidateT (Dual [Warning]) IO) ()
logVerbose Text
"Made no updates"
[SpanUpdate
_] -> Text -> ReaderT Env (ValidateT (Dual [Warning]) IO) ()
logVerbose Text
"Made 1 update"
[SpanUpdate]
_ -> Text -> ReaderT Env (ValidateT (Dual [Warning]) IO) ()
logVerbose (Text
"Made " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show ([SpanUpdate] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SpanUpdate]
us)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" updates")
[SpanUpdate] -> M [SpanUpdate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SpanUpdate]
us
findUpdates :: (NExprLoc -> Maybe Comment) -> NExprLoc -> M FetchTree
findUpdates :: (NExprLoc -> Maybe Text)
-> NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
findUpdates NExprLoc -> Maybe Text
getComment NExprLoc
e = do
Env {Bool
[(Int, Int)]
[Regex]
Dryness
Verbosity -> Text -> IO ()
onlyCommented :: Env -> Bool
attrPatterns :: Env -> [Regex]
updateLocations :: Env -> [(Int, Int)]
onlyCommented :: Bool
dryness :: Dryness
attrPatterns :: [Regex]
updateLocations :: [(Int, Int)]
sayLog :: Verbosity -> Text -> IO ()
dryness :: Env -> Dryness
sayLog :: Env -> Verbosity -> Text -> IO ()
..} <- ReaderT Env (ValidateT (Dual [Warning]) IO) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
if Bool -> Bool
not ([(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
updateLocations Bool -> Bool -> Bool
|| ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (NExprLoc -> (Int, Int) -> Bool
containsPosition NExprLoc
e) [(Int, Int)]
updateLocations)
then FetchTree -> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FetchTree
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree)
-> FetchTree
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc -> [(Maybe Text, FetchTree)] -> FetchTree
Node Maybe NExprLoc
forall a. Maybe a
Nothing []
else
let
updaters :: [Maybe (M Updater)]
updaters = ((NExprLoc -> Maybe (M Updater)) -> NExprLoc -> Maybe (M Updater)
forall a b. (a -> b) -> a -> b
$ NExprLoc
e) ((NExprLoc -> Maybe (M Updater)) -> Maybe (M Updater))
-> [NExprLoc -> Maybe (M Updater)] -> [Maybe (M Updater)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> (NExprLoc -> Maybe Text) -> [NExprLoc -> Maybe (M Updater)]
fetchers Bool
onlyCommented NExprLoc -> Maybe Text
getComment
bindingTrees :: Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
bindingTrees = \case
NamedVar NAttrPath NExprLoc
p NExprLoc
e' SourcePos
_ | Just Text
t <- NAttrPath NExprLoc -> Maybe Text
forall r. NAttrPath r -> Maybe Text
pathText NAttrPath NExprLoc
p ->
((Maybe Text, FetchTree)
-> [(Maybe Text, FetchTree)] -> [(Maybe Text, FetchTree)]
forall a. a -> [a] -> [a]
: []) ((Maybe Text, FetchTree) -> [(Maybe Text, FetchTree)])
-> (FetchTree -> (Maybe Text, FetchTree))
-> FetchTree
-> [(Maybe Text, FetchTree)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t, ) (FetchTree -> [(Maybe Text, FetchTree)])
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NExprLoc -> Maybe Text)
-> NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
findUpdates NExprLoc -> Maybe Text
getComment NExprLoc
e'
Binding NExprLoc
b ->
(NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree))
-> [NExprLoc]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FetchTree -> (Maybe Text, FetchTree))
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text
forall a. Maybe a
Nothing, ) (ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree))
-> (NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree)
-> NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> Maybe Text)
-> NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
findUpdates NExprLoc -> Maybe Text
getComment) ([NExprLoc]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)])
-> (Binding NExprLoc -> [NExprLoc])
-> Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding NExprLoc -> [NExprLoc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)])
-> Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
forall a b. (a -> b) -> a -> b
$ Binding NExprLoc
b
in
case [Maybe (M Updater)] -> Maybe (M Updater)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe (M Updater)]
updaters of
Just M Updater
u -> Updater -> FetchTree
UpdaterNode (Updater -> FetchTree)
-> M Updater
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M Updater
u
Maybe (M Updater)
Nothing -> case NExprLoc
e of
NExprLoc
[matchNixLoc|{ _version = ^version; }|] | NSet_ SrcSpan
_ NRecordType
_ [Binding NExprLoc]
bs <- NExprLoc -> NExprLocF NExprLoc
forall (f :: * -> *). Fix f -> f (Fix f)
unFix NExprLoc
e ->
Maybe NExprLoc -> [(Maybe Text, FetchTree)] -> FetchTree
Node Maybe NExprLoc
version ([(Maybe Text, FetchTree)] -> FetchTree)
-> ([[(Maybe Text, FetchTree)]] -> [(Maybe Text, FetchTree)])
-> [[(Maybe Text, FetchTree)]]
-> FetchTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Maybe Text, FetchTree)]] -> [(Maybe Text, FetchTree)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Maybe Text, FetchTree)]] -> FetchTree)
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [[(Maybe Text, FetchTree)]]
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)])
-> [Binding NExprLoc]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [[(Maybe Text, FetchTree)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
bindingTrees [Binding NExprLoc]
bs
NExprLoc
[matchNixLoc|let _version = ^version; in ^x|]
| NLet_ SrcSpan
_ [Binding NExprLoc]
bs NExprLoc
_ <- NExprLoc -> NExprLocF NExprLoc
forall (f :: * -> *). Fix f -> f (Fix f)
unFix NExprLoc
e -> do
[(Maybe Text, FetchTree)]
bs' <- [[(Maybe Text, FetchTree)]] -> [(Maybe Text, FetchTree)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Maybe Text, FetchTree)]] -> [(Maybe Text, FetchTree)])
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [[(Maybe Text, FetchTree)]]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)])
-> [Binding NExprLoc]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [[(Maybe Text, FetchTree)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Binding NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
bindingTrees [Binding NExprLoc]
bs
FetchTree
x' <- (NExprLoc -> Maybe Text)
-> NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
findUpdates NExprLoc -> Maybe Text
getComment NExprLoc
x
FetchTree -> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FetchTree
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree)
-> FetchTree
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc -> [(Maybe Text, FetchTree)] -> FetchTree
Node Maybe NExprLoc
version ((Maybe Text
forall a. Maybe a
Nothing, FetchTree
x') (Maybe Text, FetchTree)
-> [(Maybe Text, FetchTree)] -> [(Maybe Text, FetchTree)]
forall a. a -> [a] -> [a]
: [(Maybe Text, FetchTree)]
bs')
NExprLoc
_ -> Maybe NExprLoc -> [(Maybe Text, FetchTree)] -> FetchTree
Node Maybe NExprLoc
forall a. Maybe a
Nothing ([(Maybe Text, FetchTree)] -> FetchTree)
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree))
-> [NExprLoc]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) [(Maybe Text, FetchTree)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
((FetchTree -> (Maybe Text, FetchTree))
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text
forall a. Maybe a
Nothing, ) (ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree))
-> (NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree)
-> NExprLoc
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Text, FetchTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> Maybe Text)
-> NExprLoc
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
findUpdates NExprLoc -> Maybe Text
getComment)
(NExprLocF NExprLoc -> [NExprLoc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NExprLoc -> NExprLocF NExprLoc
forall (f :: * -> *). Fix f -> f (Fix f)
unFix NExprLoc
e))
filterUpdates :: FetchTree -> M FetchTree
filterUpdates :: FetchTree -> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
filterUpdates FetchTree
t = do
Env {Bool
[(Int, Int)]
[Regex]
Dryness
Verbosity -> Text -> IO ()
onlyCommented :: Bool
dryness :: Dryness
attrPatterns :: [Regex]
updateLocations :: [(Int, Int)]
sayLog :: Verbosity -> Text -> IO ()
onlyCommented :: Env -> Bool
attrPatterns :: Env -> [Regex]
updateLocations :: Env -> [(Int, Int)]
dryness :: Env -> Dryness
sayLog :: Env -> Verbosity -> Text -> IO ()
..} <- ReaderT Env (ValidateT (Dual [Warning]) IO) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
let matches :: Text -> Bool
matches Text
s = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Regex -> Text -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
`match` Text
s) [Regex]
attrPatterns
let go :: FetchTree -> FetchTree
go = \case
Node Maybe NExprLoc
v [(Maybe Text, FetchTree)]
cs -> Maybe NExprLoc -> [(Maybe Text, FetchTree)] -> FetchTree
Node
Maybe NExprLoc
v
[ (Maybe Text
n, FetchTree
c')
| (Maybe Text
n, FetchTree
c) <- [(Maybe Text, FetchTree)]
cs
, let c' :: FetchTree
c' = if Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
matches Maybe Text
n then FetchTree
c else FetchTree -> FetchTree
go FetchTree
c
]
UpdaterNode Updater
_ -> Maybe NExprLoc -> [(Maybe Text, FetchTree)] -> FetchTree
Node Maybe NExprLoc
forall a. Maybe a
Nothing []
FetchTree -> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FetchTree
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree)
-> FetchTree
-> ReaderT Env (ValidateT (Dual [Warning]) IO) FetchTree
forall a b. (a -> b) -> a -> b
$ if [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Regex]
attrPatterns then FetchTree
t else FetchTree -> FetchTree
go FetchTree
t
evalUpdates :: FetchTree -> M [SpanUpdate]
evalUpdates :: FetchTree -> M [SpanUpdate]
evalUpdates = ((Maybe Day, [SpanUpdate]) -> [SpanUpdate])
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
-> M [SpanUpdate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Day, [SpanUpdate]) -> [SpanUpdate]
forall a b. (a, b) -> b
snd (ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
-> M [SpanUpdate])
-> (FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate]))
-> FetchTree
-> M [SpanUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
go
where
go :: FetchTree -> M (Maybe Day, [SpanUpdate])
go :: FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
go = \case
UpdaterNode (Updater ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
u) -> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
u
Node Maybe NExprLoc
versionExpr [(Maybe Text, FetchTree)]
cs -> do
([Maybe Day]
ds, [[SpanUpdate]]
ss) <- [(Maybe Day, [SpanUpdate])] -> ([Maybe Day], [[SpanUpdate]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe Day, [SpanUpdate])] -> ([Maybe Day], [[SpanUpdate]]))
-> ([Maybe (Maybe Day, [SpanUpdate])]
-> [(Maybe Day, [SpanUpdate])])
-> [Maybe (Maybe Day, [SpanUpdate])]
-> ([Maybe Day], [[SpanUpdate]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Maybe Day, [SpanUpdate])] -> [(Maybe Day, [SpanUpdate])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Maybe Day, [SpanUpdate])]
-> ([Maybe Day], [[SpanUpdate]]))
-> ReaderT
Env
(ValidateT (Dual [Warning]) IO)
[Maybe (Maybe Day, [SpanUpdate])]
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) ([Maybe Day], [[SpanUpdate]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe Text, FetchTree)
-> ReaderT
Env
(ValidateT (Dual [Warning]) IO)
(Maybe (Maybe Day, [SpanUpdate])))
-> [(Maybe Text, FetchTree)]
-> ReaderT
Env
(ValidateT (Dual [Warning]) IO)
[Maybe (Maybe Day, [SpanUpdate])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
-> ReaderT
Env
(ValidateT (Dual [Warning]) IO)
(Maybe (Maybe Day, [SpanUpdate]))
forall e (m :: * -> *) a. MonadValidate e m => m a -> m (Maybe a)
tolerate (ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
-> ReaderT
Env
(ValidateT (Dual [Warning]) IO)
(Maybe (Maybe Day, [SpanUpdate])))
-> ((Maybe Text, FetchTree)
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate]))
-> (Maybe Text, FetchTree)
-> ReaderT
Env
(ValidateT (Dual [Warning]) IO)
(Maybe (Maybe Day, [SpanUpdate]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
go (FetchTree
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate]))
-> ((Maybe Text, FetchTree) -> FetchTree)
-> (Maybe Text, FetchTree)
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text, FetchTree) -> FetchTree
forall a b. (a, b) -> b
snd) [(Maybe Text, FetchTree)]
cs
let latestDate :: Maybe Day
latestDate = [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
maximumMay ([Maybe Day] -> [Day]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Day]
ds)
(Maybe Day, [SpanUpdate])
-> ReaderT
Env (ValidateT (Dual [Warning]) IO) (Maybe Day, [SpanUpdate])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Maybe Day
latestDate
, [ SrcSpan -> Text -> SpanUpdate
SpanUpdate (NExprLoc -> SrcSpan
exprSpan NExprLoc
v)
(Text -> Text
quoteString (Text -> Text) -> (Day -> Text) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"unstable-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Day -> Text) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack (FilePath -> Text) -> (Day -> FilePath) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> FilePath
forall a. Show a => a -> FilePath
show (Day -> Text) -> Day -> Text
forall a b. (a -> b) -> a -> b
$ Day
d)
| Just Day
d <- Maybe Day -> [Maybe Day]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Day
latestDate
, Just NExprLoc
v <- Maybe NExprLoc -> [Maybe NExprLoc]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NExprLoc
versionExpr
]
[SpanUpdate] -> [SpanUpdate] -> [SpanUpdate]
forall a. Semigroup a => a -> a -> a
<> [[SpanUpdate]] -> [SpanUpdate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[SpanUpdate]]
ss
)
maximumMay :: Ord a => [a] -> Maybe a
maximumMay :: [a] -> Maybe a
maximumMay = \case
[] -> Maybe a
forall a. Maybe a
Nothing
[a]
xs -> a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs)