{-# OPTIONS_GHC -fno-warn-orphans #-}

module Update.Nix.FetchGit.Types where

import           Control.Monad.Reader
import           Control.Monad.Validate
import           Control.Monad.Validate.Internal
import           Data.Bifunctor                 ( Bifunctor(first) )
import           Data.Functor
import           Data.Monoid
import           Data.Text                      ( Text )
import           Data.Time                      ( Day )
import           Nix.Expr                       ( NExprLoc )
import           Text.Regex.TDFA                ( Regex )
import           Update.Nix.FetchGit.Warning
import           Update.Span

type M = ReaderT Env (ValidateT (Dual [Warning]) IO)

runM :: Env -> M a -> IO ([Warning], Maybe a)
runM :: Env -> M a -> IO ([Warning], Maybe a)
runM Env
env = ((Dual [Warning], Maybe a) -> ([Warning], Maybe a))
-> IO (Dual [Warning], Maybe a) -> IO ([Warning], Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Dual [Warning] -> [Warning])
-> (Dual [Warning], Maybe a) -> ([Warning], Maybe a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Warning] -> [Warning]
forall a. [a] -> [a]
reverse ([Warning] -> [Warning])
-> (Dual [Warning] -> [Warning]) -> Dual [Warning] -> [Warning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual [Warning] -> [Warning]
forall a. Dual a -> a
getDual)) (IO (Dual [Warning], Maybe a) -> IO ([Warning], Maybe a))
-> (M a -> IO (Dual [Warning], Maybe a))
-> M a
-> IO ([Warning], Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateT (Dual [Warning]) IO a -> IO (Dual [Warning], Maybe a)
forall (m :: * -> *) e a.
(Functor m, Monoid e) =>
ValidateT e m a -> m (e, Maybe a)
asWarnings (ValidateT (Dual [Warning]) IO a -> IO (Dual [Warning], Maybe a))
-> (M a -> ValidateT (Dual [Warning]) IO a)
-> M a
-> IO (Dual [Warning], Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (M a -> Env -> ValidateT (Dual [Warning]) IO a)
-> Env -> M a -> ValidateT (Dual [Warning]) IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip M a -> Env -> ValidateT (Dual [Warning]) IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Env
env

-- | Runs a 'ValidateT' computation returning the errors raised by 'refute' or
-- 'dispute' if any, as well as returning the computation’s result if possible.
asWarnings :: (Functor m, Monoid e) => ValidateT e m a -> m (e, Maybe a)
asWarnings :: ValidateT e m a -> m (e, Maybe a)
asWarnings ValidateT e m a
m = MonoMaybe 'SMaybe e
-> ValidateT e m a -> m (Either e (MonoMaybe 'SMaybe e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe 'SMaybe e
forall a. MonoMaybe 'SMaybe a
MNothing ValidateT e m a
m m (Either e (MonoMaybe 'SMaybe e, a))
-> (Either e (MonoMaybe 'SMaybe e, a) -> (e, Maybe a))
-> m (e, Maybe a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Left  e
e             -> (e
e, Maybe a
forall a. Maybe a
Nothing)
  Right (MJust e
e , a
a) -> (e
e, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
  Right (MonoMaybe 'SMaybe e
MNothing, a
a) -> (e
forall a. Monoid a => a
mempty, a -> Maybe a
forall a. a -> Maybe a
Just a
a)

data Env = Env
  { Env -> Verbosity -> Text -> IO ()
sayLog          :: Verbosity -> Text -> IO ()
  , Env -> [(Int, Int)]
updateLocations :: [(Int, Int)]
  , Env -> [Regex]
attrPatterns    :: [Regex]
  , Env -> Dryness
dryness         :: Dryness
  , Env -> Bool
onlyCommented   :: Bool
  }

-- | Is this a dry run or not
data Dryness = Dry | Wet

data Verbosity
  = Verbose
  | Normal
  | Quiet

newtype Updater = Updater
  { Updater -> M (Maybe Day, [SpanUpdate])
unUpdater :: M (Maybe Day, [SpanUpdate])
  }

-- | A tree with a structure similar to the AST of the Nix file we are
-- parsing, but which only contains the information we care about.
data FetchTree
  = Node { FetchTree -> Maybe NExprLoc
nodeVersionExpr :: Maybe NExprLoc
         , FetchTree -> [(Maybe Text, FetchTree)]
nodeChildren    :: [(Maybe Text, FetchTree)]
         }
  | UpdaterNode Updater

-- | A repo is either specified by URL or by Github owner/repo.
data RepoLocation = URL Text
                  | GitHub { RepoLocation -> Text
repoOwner :: Text
                           , RepoLocation -> Text
repoRepo  :: Text
                           }
                  | GitLab { repoOwner :: Text
                           , repoRepo  :: Text
                           }
  deriving Int -> RepoLocation -> ShowS
[RepoLocation] -> ShowS
RepoLocation -> String
(Int -> RepoLocation -> ShowS)
-> (RepoLocation -> String)
-> ([RepoLocation] -> ShowS)
-> Show RepoLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoLocation] -> ShowS
$cshowList :: [RepoLocation] -> ShowS
show :: RepoLocation -> String
$cshow :: RepoLocation -> String
showsPrec :: Int -> RepoLocation -> ShowS
$cshowsPrec :: Int -> RepoLocation -> ShowS
Show