module Update.Nix.FetchGit.Utils
( RepoLocation (..),
ourParseNixText,
ourParseNixFile,
extractUrlString,
prettyRepoLocation,
quoteString,
extractFuncName,
pathText,
exprText,
exprBool,
exprSpan,
containsPosition,
parseISO8601DateToDay,
formatWarning,
fromEither,
note,
refute1,
logVerbose,
logNormal,
)
where
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (MonadReader (ask))
import Control.Monad.Validate
import Data.Fix
import Data.List.NonEmpty as NE
import Data.Monoid
import Data.Text
( Text,
splitOn,
unpack,
)
import qualified Data.Text as T
import Data.Time
( Day,
defaultTimeLocale,
parseTimeM,
)
import Nix.Atoms (NAtom (NBool))
import Nix.Expr hiding (SourcePos)
import Nix.Parser
( parseNixFileLoc,
parseNixTextLoc,
)
import Nix.Utils (Path (..))
import Update.Nix.FetchGit.Types
import Update.Nix.FetchGit.Warning
import Update.Span
ourParseNixText :: Text -> Either Warning NExprLoc
ourParseNixText :: Text -> Either Warning NExprLoc
ourParseNixText Text
t = case Text -> Result NExprLoc
parseNixTextLoc Text
t of
Left Doc Void
parseError -> forall a b. a -> Either a b
Left (Text -> Warning
CouldNotParseInput (forall a. Show a => a -> Text
tShow Doc Void
parseError))
Right NExprLoc
expr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NExprLoc
expr
ourParseNixFile :: FilePath -> M NExprLoc
ourParseNixFile :: FilePath -> M NExprLoc
ourParseNixFile FilePath
f =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *). MonadFile m => Path -> m (Result NExprLoc)
parseNixFileLoc (FilePath -> Path
Path FilePath
f)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Doc Void
parseError -> forall a. Warning -> M a
refute1 (Text -> Warning
CouldNotParseInput (forall a. Show a => a -> Text
tShow Doc Void
parseError))
Right NExprLoc
expr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NExprLoc
expr
extractUrlString :: RepoLocation -> Text
= \case
URL Text
u -> Text
u
GitHub Text
o Text
r -> Text
"https://github.com/" forall a. Semigroup a => a -> a -> a
<> Text
o forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
r forall a. Semigroup a => a -> a -> a
<> Text
".git"
GitLab Text
o Text
r -> Text
"https://gitlab.com/" forall a. Semigroup a => a -> a -> a
<> Text
o forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
r forall a. Semigroup a => a -> a -> a
<> Text
".git"
prettyRepoLocation :: RepoLocation -> Text
prettyRepoLocation :: RepoLocation -> Text
prettyRepoLocation = \case
URL Text
u -> Text
u
GitHub Text
o Text
r -> Text
o forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
r
GitLab Text
o Text
r -> Text
o forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
r
quoteString :: Text -> Text
quoteString :: Text -> Text
quoteString Text
t = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\""
exprText :: NExprLoc -> Either Warning Text
exprText :: NExprLoc -> Either Warning Text
exprText = \case
(Ann SrcSpan
_ (NStr (DoubleQuoted [Plain Text
t]))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
NExprLoc
e -> forall a b. a -> Either a b
Left (NExprLoc -> Warning
NotAString NExprLoc
e)
exprBool :: NExprLoc -> Either Warning Bool
exprBool :: NExprLoc -> Either Warning Bool
exprBool = \case
(Ann SrcSpan
_ (NConstant (NBool Bool
b))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
NExprLoc
e -> forall a b. a -> Either a b
Left (NExprLoc -> Warning
NotABool NExprLoc
e)
exprSpan :: NExprLoc -> SrcSpan
exprSpan :: NExprLoc -> SrcSpan
exprSpan (Ann SrcSpan
s NExprF NExprLoc
_) = SrcSpan
s
extractFuncName :: NExprLoc -> Maybe VarName
(Ann SrcSpan
_ (NSym VarName
name)) = forall a. a -> Maybe a
Just VarName
name
extractFuncName (Ann SrcSpan
_ (NSelect Maybe NExprLoc
_ NExprLoc
_ (forall a. NonEmpty a -> a
NE.last -> StaticKey VarName
name))) = forall a. a -> Maybe a
Just VarName
name
extractFuncName NExprLoc
_ = forall a. Maybe a
Nothing
pathText :: NAttrPath r -> Maybe Text
pathText :: forall r. NAttrPath r -> Maybe Text
pathText = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall r. NKeyName r -> Maybe Text
e
where
e :: NKeyName r -> Maybe Text
e :: forall r. NKeyName r -> Maybe Text
e = \case
StaticKey (VarName Text
s) -> forall a. a -> Maybe a
Just Text
s
DynamicKey (Plain NString r
s) -> forall r. NString r -> Maybe Text
t NString r
s
DynamicKey Antiquoted (NString r) r
EscapedNewline -> forall a. a -> Maybe a
Just Text
"\n"
DynamicKey (Antiquoted r
_) -> forall a. Maybe a
Nothing
t :: NString r -> Maybe Text
t :: forall r. NString r -> Maybe Text
t =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall r. Antiquoted Text r -> Maybe Text
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \case
DoubleQuoted [Antiquoted Text r]
as -> [Antiquoted Text r]
as
Indented Int
_ [Antiquoted Text r]
as -> [Antiquoted Text r]
as
)
a :: Antiquoted Text r -> Maybe Text
a :: forall r. Antiquoted Text r -> Maybe Text
a = \case
Plain Text
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
Antiquoted Text r
EscapedNewline -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"\n"
Antiquoted r
_ -> forall a. Maybe a
Nothing
parseISO8601DateToDay :: Text -> Either Warning Day
parseISO8601DateToDay :: Text -> Either Warning Day
parseISO8601DateToDay Text
t =
let justDate :: FilePath
justDate = (Text -> FilePath
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
Prelude.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
splitOn Text
"T") Text
t
in forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Warning
InvalidDateString Text
t)
forall a b. b -> Either a b
Right
(forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale FilePath
"%Y-%m-%d" FilePath
justDate)
formatWarning :: Warning -> Text
formatWarning :: Warning -> Text
formatWarning (CouldNotParseInput Text
doc) = Text
doc
formatWarning (MissingAttr Text
attrName) =
Text
"Error: The \"" forall a. Semigroup a => a -> a -> a
<> Text
attrName forall a. Semigroup a => a -> a -> a
<> Text
"\" attribute is missing."
formatWarning (DuplicateAttrs Text
attrName) =
Text
"Error: The \"" forall a. Semigroup a => a -> a -> a
<> Text
attrName forall a. Semigroup a => a -> a -> a
<> Text
"\" attribute appears twice in a set."
formatWarning (NotAString NExprLoc
expr) =
Text
"Error: The expression at "
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> FilePath
prettyPrintSourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SourcePos
spanBegin forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLoc -> SrcSpan
exprSpan) NExprLoc
expr
forall a. Semigroup a => a -> a -> a
<> Text
" is not a string literal."
formatWarning (NotABool NExprLoc
expr) =
Text
"Error: The expression at "
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> FilePath
prettyPrintSourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SourcePos
spanBegin forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLoc -> SrcSpan
exprSpan) NExprLoc
expr
forall a. Semigroup a => a -> a -> a
<> Text
" is not a boolean literal."
formatWarning (NixPrefetchGitFailed Int
exitCode Text
errorOutput) =
Text
"Error: nix-prefetch-git failed with exit code "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Int
exitCode
forall a. Semigroup a => a -> a -> a
<> Text
" and error output:\n"
forall a. Semigroup a => a -> a -> a
<> Text
errorOutput
formatWarning (InvalidPrefetchGitOutput Text
output) =
Text
"Error: Output from nix-prefetch-git is invalid:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Text
output
formatWarning (NixPrefetchUrlFailed Int
exitCode Text
errorOutput) =
Text
"Error: nix-prefetch-url failed with exit code "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Int
exitCode
forall a. Semigroup a => a -> a -> a
<> Text
" and error output:\n"
forall a. Semigroup a => a -> a -> a
<> Text
errorOutput
formatWarning (InvalidPrefetchUrlOutput Text
output) =
Text
"Error: Output from nix-prefetch-url is invalid:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Text
output
formatWarning (InvalidDateString Text
text) =
Text
"Error: Date string is invalid: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Text
text
formatWarning (GitLsRemoteFailed Int
exitCode Text
errorOutput) =
Text
"Error: git ls-remote failed with exit code "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Int
exitCode
forall a. Semigroup a => a -> a -> a
<> Text
" and error output:\n"
forall a. Semigroup a => a -> a -> a
<> Text
errorOutput
formatWarning (NoSuchRef Text
text) = Text
"Error: No such ref: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Text
text
formatWarning (InvalidGitLsRemoteOutput Text
output) =
Text
"Error: Output from git ls-remote is invalid:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Text
output
tShow :: Show a => a -> Text
tShow :: forall a. Show a => a -> Text
tShow = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show
containsPosition :: NExprLoc -> (Int, Int) -> Bool
containsPosition :: NExprLoc -> (Int, Int) -> Bool
containsPosition (Fix (Compose (AnnUnit (SrcSpan SourcePos
begin SourcePos
end) NExprF NExprLoc
_))) (Int, Int)
p =
let unSourcePos :: SourcePos -> (Int, Int)
unSourcePos (SourcePos FilePath
_ Pos
l Pos
c) = (Pos -> Int
unPos Pos
l, Pos -> Int
unPos Pos
c)
in (Int, Int)
p forall a. Ord a => a -> a -> Bool
>= SourcePos -> (Int, Int)
unSourcePos SourcePos
begin Bool -> Bool -> Bool
&& (Int, Int)
p forall a. Ord a => a -> a -> Bool
< SourcePos -> (Int, Int)
unSourcePos SourcePos
end
fromEither :: Either Warning a -> M a
fromEither :: forall a. Either Warning a -> M a
fromEither = \case
Left Warning
e -> forall a. Warning -> M a
refute1 Warning
e
Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
note :: Warning -> Maybe a -> M a
note :: forall a. Warning -> Maybe a -> M a
note Warning
e = \case
Maybe a
Nothing -> forall a. Warning -> M a
refute1 Warning
e
Just a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
refute1 :: Warning -> M a
refute1 :: forall a. Warning -> M a
refute1 = forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
logVerbose :: Text -> M ()
logVerbose :: Text -> M ()
logVerbose Text
t = do
Env {Bool
[(Int, Int)]
[Regex]
Dryness
Verbosity -> Text -> IO ()
onlyCommented :: Env -> Bool
dryness :: Env -> Dryness
attrPatterns :: Env -> [Regex]
updateLocations :: Env -> [(Int, Int)]
sayLog :: Env -> Verbosity -> Text -> IO ()
onlyCommented :: Bool
dryness :: Dryness
attrPatterns :: [Regex]
updateLocations :: [(Int, Int)]
sayLog :: Verbosity -> Text -> IO ()
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> Text -> IO ()
sayLog Verbosity
Verbose Text
t
logNormal :: Text -> M ()
logNormal :: Text -> M ()
logNormal Text
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
dryness :: Env -> Dryness
attrPatterns :: Env -> [Regex]
updateLocations :: Env -> [(Int, Int)]
sayLog :: Env -> Verbosity -> Text -> IO ()
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> Text -> IO ()
sayLog Verbosity
Normal Text
t