VersionSource.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Config.VersionSource (versionSourceCodec) where

import Data.Foldable (asum)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tuple.Extra (uncurry3)
import Lens.Micro
import Lens.Micro.Extras (view)
import NvFetcher.Types
import NvFetcher.Types.Lens
import Toml

versionSourceCodec :: TomlCodec VersionSource
versionSourceCodec =
  asum
    [ gitHubReleaseCodec,
      gitHubTagCodec,
      gitCodec,
      pypiCodec,
      archLinuxCodec,
      aurCodec,
      manualCodec,
      repologyCodec,
      webpageCodec,
      httpHeaderCodec
    ]

--------------------------------------------------------------------------------

githubICodec :: Key -> TomlCodec (Text, Text)
githubICodec =
  textBy
    (\(owner, repo) -> owner <> "/" <> repo)
    ( \t ->
        case T.split (== '/') t of
          [owner, repo] -> Right (owner, repo)
          _ -> Left "unexpected github source format: it should be something like [owner]/[repo]"
    )

listOptionsCodec :: TomlCodec ListOptions
listOptionsCodec =
  ListOptions
    <$> dioptional (text "src.include_regex") .= _includeRegex
    <*> dioptional (text "src.exclude_regex") .= _excludeRegex
    <*> dioptional
      ( textBy
          (T.pack . show)
          ( \case
              "parse_version" -> Right ParseVersion
              "vercmp" -> Right Vercmp
              _ -> Left "unexpected sort_version_key: it should be either parse_version or vercmp"
          )
          "src.sort_version_key"
      )
      .= _sortVersionKey
    <*> dioptional (text "src.ignored") .= _ignored

--------------------------------------------------------------------------------

matchGitHubRelease :: VersionSource -> Maybe (Text, Text)
matchGitHubRelease x = (,) <$> x ^? owner <*> x ^? repo

gitHubReleaseCodec :: TomlCodec VersionSource
gitHubReleaseCodec = dimatch matchGitHubRelease (uncurry GitHubRelease) $ githubICodec "src.github"

--------------------------------------------------------------------------------

matchGitHubTag :: VersionSource -> Maybe ((Text, Text), ListOptions)
matchGitHubTag x = do
  o <- x ^? owner
  r <- x ^? repo
  l <- x ^? listOptions
  pure ((o, r), l)

gitHubTagICodec :: TomlCodec ((Text, Text), ListOptions)
gitHubTagICodec =
  (,) <$> githubICodec "src.github_tag" .= view _1
    <*> listOptionsCodec .= view _2

gitHubTagCodec :: TomlCodec VersionSource
gitHubTagCodec = dimatch matchGitHubTag (\((_owner, _repo), _listOptions) -> GitHubTag {..}) gitHubTagICodec

--------------------------------------------------------------------------------

matchGit :: VersionSource -> Maybe (Text, Branch)
matchGit x = (,) <$> x ^? vurl <*> x ^? vbranch

gitICodec :: TomlCodec (Text, Branch)
gitICodec = (,) <$> text "src.git" .= view _1 <*> diwrap (dioptional (text "src.branch")) .= view _2

gitCodec :: TomlCodec VersionSource
gitCodec = dimatch matchGit (uncurry Git) gitICodec

--------------------------------------------------------------------------------

matchPypi :: VersionSource -> Maybe Text
matchPypi x = x ^? pypi

pypiCodec :: TomlCodec VersionSource
pypiCodec = dimatch matchPypi Pypi (text "src.pypi")

--------------------------------------------------------------------------------

matchArchLinux :: VersionSource -> Maybe Text
matchArchLinux x = x ^? archpkg

archLinuxCodec :: TomlCodec VersionSource
archLinuxCodec = dimatch matchArchLinux ArchLinux (text "src.archpkg")

--------------------------------------------------------------------------------

matchAur :: VersionSource -> Maybe Text
matchAur x = x ^? aur

aurCodec :: TomlCodec VersionSource
aurCodec = dimatch matchAur Aur (text "src.aur")

--------------------------------------------------------------------------------

matchManual :: VersionSource -> Maybe Text
matchManual x = x ^? manual

manualCodec :: TomlCodec VersionSource
manualCodec = dimatch matchManual Manual (text "src.manual")

--------------------------------------------------------------------------------

matchRepology :: VersionSource -> Maybe (Text, Text)
matchRepology x = (,) <$> x ^? repology <*> x ^? repo

repologyICodec :: TomlCodec (Text, Text)
repologyICodec =
  textBy
    (\(repology, repo) -> repology <> ":" <> repo)
    ( \t ->
        case T.split (== ':') t of
          [owner, repo] -> Right (owner, repo)
          _ -> Left "unexpected repology source format: it should be something like [repology]:[repo]"
    )
    "src.repology"

repologyCodec :: TomlCodec VersionSource
repologyCodec = dimatch matchRepology (uncurry Repology) repologyICodec

------------------------------------------------------------

matchWebpage :: VersionSource -> Maybe (Text, Text, ListOptions)
matchWebpage x = (,,) <$> x ^? vurl <*> x ^? regex <*> x ^? listOptions

webpageICodec :: TomlCodec (Text, Text, ListOptions)
webpageICodec =
  (,,) <$> text "src.webpage" .= view _1
    <*> text "src.regex" .= view _2
    <*> listOptionsCodec .= view _3

webpageCodec :: TomlCodec VersionSource
webpageCodec = dimatch matchWebpage (uncurry3 Webpage) webpageICodec

--------------------------------------------------------------------------------

matchHttpHeader :: VersionSource -> Maybe (Text, Text, ListOptions)
matchHttpHeader x = (,,) <$> x ^? vurl <*> x ^? regex <*> x ^? listOptions

httpHeaderICodec :: TomlCodec (Text, Text, ListOptions)
httpHeaderICodec =
  (,,) <$> text "src.httpheader" .= view _1
    <*> text "src.regex" .= view _2
    <*> listOptionsCodec .= view _3

httpHeaderCodec :: TomlCodec VersionSource
httpHeaderCodec = dimatch matchHttpHeader (uncurry3 HttpHeader) httpHeaderICodec

--------------------------------------------------------------------------------