module Update.Nix.FetchGit.Utils
( RepoLocation(..)
, ourParseNixFile
, extractUrlString
, quoteString
, extractFuncName
, extractAttr
, findAttr
, exprText
, exprSpan
, parseISO8601DateToDay
, formatWarning
) where
import Control.Error (lastMay)
import Data.Generics.Uniplate.Data (transform)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Data.Text (Text, unpack, splitOn)
import Data.Time (parseTimeM, defaultTimeLocale)
import Nix.Parser (parseNixFileLoc, Result(..))
import Text.Trifecta.Result (_errDoc)
import Nix.Expr
import Update.Nix.FetchGit.Types
import Update.Nix.FetchGit.Warning
import Update.Span
ourParseNixFile :: FilePath -> IO (Either Warning NExprLoc)
ourParseNixFile f =
parseNixFileLoc f >>= \case
Failure parseError -> pure $ Left (CouldNotParseInput (_errDoc parseError))
Success expr -> pure $ pure $ fixNixSets expr
fixNixSets :: NExprLoc -> NExprLoc
fixNixSets = transform fix
where fix (AnnE s (NRecSet bindings)) = AnnE s (NSet bindings)
fix n = n
extractUrlString :: RepoLocation -> Text
extractUrlString = \case
URL u -> u
GitHub o r -> "https://github.com/" <> o <> "/" <> r <> ".git"
quoteString :: Text -> Text
quoteString t = "\"" <> t <> "\""
exprText :: NExprLoc -> Either Warning Text
exprText = \case
(AnnE _ (NStr (DoubleQuoted [Plain t]))) -> pure t
e -> Left (NotAString e)
exprSpan :: NExprLoc -> SourceSpan
exprSpan expr = SourceSpan (deltaToSourcePos begin) (deltaToSourcePos end)
where (AnnE (SrcSpan begin end) _) = expr
deltaToSourcePos :: Delta -> SourcePos
deltaToSourcePos delta = SourcePos line column
where (Directed _ line column _ _) = delta
extractFuncName :: NExprLoc -> Maybe Text
extractFuncName (AnnE _ (NSym name)) = Just name
extractFuncName (AnnE _ (NSelect _ (lastMay -> Just (StaticKey name)) _)) = Just name
extractFuncName _ = Nothing
extractAttr :: Text -> [Binding a] -> Either Warning a
extractAttr name bs = case catMaybes (matchAttr name <$> bs) of
[x] -> pure x
[] -> Left (MissingAttr name)
_ -> Left (DuplicateAttrs name)
findAttr :: Text -> [Binding a] -> Either Warning (Maybe a)
findAttr name bs = case catMaybes (matchAttr name <$> bs) of
[x] -> pure (Just x)
[] -> pure Nothing
_ -> Left (DuplicateAttrs name)
matchAttr :: Text -> Binding a -> Maybe a
matchAttr t = \case
NamedVar [StaticKey t'] x | t == t' -> Just x
NamedVar _ _ -> Nothing
Inherit _ _ -> Nothing
parseISO8601DateToDay :: Text -> Either Warning Day
parseISO8601DateToDay t =
let justDate = (unpack . Prelude.head . splitOn "T") t in
case parseTimeM False defaultTimeLocale "%Y-%m-%d" justDate of
Nothing -> Left $ InvalidDateString t
Just day -> pure day
formatWarning :: Warning -> String
formatWarning (CouldNotParseInput doc) = show doc
formatWarning (MissingAttr attrName) =
"Error: The \"" <> unpack attrName <> "\" attribute is missing."
formatWarning (DuplicateAttrs attrName) =
"Error: The \"" <> unpack attrName <> "\" attribute appears twice in a set."
formatWarning (NotAString expr) =
"Error: The expression at "
<> (prettyPrintSourcePos . sourceSpanBegin . exprSpan) expr
<> " is not a string literal."
formatWarning (NixPrefetchGitFailed exitCode errorOutput) =
"Error: nix-prefetch-git failed with exit code " <> show exitCode
<> " and error output:\n" <> unpack errorOutput
formatWarning (InvalidPrefetchGitOutput output) =
"Error: Output from nix-prefetch-git is invalid:\n" <> show output
formatWarning (InvalidDateString text) =
"Error: Date string is invalid: " <> show text