|
| 1 | +module Main where |
| 2 | + |
| 3 | +import Prelude |
| 4 | +import Control.Monad.Eff (Eff) |
| 5 | +import Control.Monad.Eff.Console (CONSOLE, error, log) |
| 6 | +import Control.Monad.Eff.Exception (EXCEPTION, throw) |
| 7 | +import Data.Argonaut (class DecodeJson, decodeJson, (.?), jsonParser) |
| 8 | +import Data.Argonaut.Decode.Combinators ((.??)) |
| 9 | +import Data.Array (concat, filter, fromFoldable, groupBy, mapMaybe, sortWith) |
| 10 | +import Data.Either (Either(..), either) |
| 11 | +import Data.Foldable (any, find, maximum, traverse_) |
| 12 | +import Data.Function (on) |
| 13 | +import Data.Maybe (Maybe(..), fromMaybe) |
| 14 | +import Data.NonEmpty (NonEmpty(..)) |
| 15 | +import Data.StrMap (StrMap, lookup, unions) |
| 16 | +import Data.String (Pattern(Pattern), joinWith, split, stripPrefix) |
| 17 | +import Data.Traversable (traverse) |
| 18 | +import Data.Tuple (Tuple(..), fst, snd) |
| 19 | +import Node.Encoding (Encoding(..)) |
| 20 | +import Node.FS (FS) |
| 21 | +import Node.FS.Sync (readTextFile) |
| 22 | +import Node.Yargs.Applicative (class Arg, arg, runY, yarg) |
| 23 | +import Node.Yargs.Setup (usage) |
| 24 | + |
| 25 | +data Format = SBT | Gradle |
| 26 | +instance formatArg :: Arg Format where |
| 27 | + arg n = fromStr <$> arg n |
| 28 | + where |
| 29 | + fromStr "gradle" = Gradle |
| 30 | + fromStr _ = SBT |
| 31 | + |
| 32 | +newtype DepKey = DepKey {groupId :: String, artifactId :: String} |
| 33 | + |
| 34 | +data BaseDep = BaseDep DepKey { |
| 35 | + version :: String |
| 36 | + , classifier :: Maybe String |
| 37 | + , excludes :: Array String |
| 38 | +} |
| 39 | + |
| 40 | +derive instance depKeyEq :: Eq DepKey |
| 41 | +instance depKeyOrd :: Ord DepKey where |
| 42 | + compare (DepKey d1) (DepKey d2) = compare d1.groupId d2.groupId <> compare d1.artifactId d2.artifactId |
| 43 | + |
| 44 | +instance showKey :: Show DepKey where |
| 45 | + show (DepKey {groupId,artifactId}) = groupId <> ":" <> artifactId |
| 46 | + |
| 47 | +derive instance baseDepEq :: Eq BaseDep |
| 48 | + |
| 49 | +type FullDep = { |
| 50 | + groupId:: String |
| 51 | + , artifactId:: String |
| 52 | + , version :: String |
| 53 | + , classifier :: Maybe String |
| 54 | + , jpfIncludes :: Array String |
| 55 | + , jpfExports :: Array String |
| 56 | + , excludes :: Array String |
| 57 | +} |
| 58 | + |
| 59 | +data Error = NoVersion String |
| 60 | + |
| 61 | +instance showError :: Show Error where |
| 62 | + show (NoVersion err) = "No version for '" <> err <> "'" |
| 63 | + |
| 64 | +newtype Dep = Dep FullDep |
| 65 | +newtype DepsFile = DepsFile {exclusions::Array String, versions::StrMap String, dependencies::Array Dep} |
| 66 | + |
| 67 | +instance depDecode :: DecodeJson Dep where |
| 68 | + decodeJson j = do |
| 69 | + o <- decodeJson j |
| 70 | + groupId <- o .? "groupId" |
| 71 | + artifactId <- o .? "artifactId" |
| 72 | + version <- o .? "version" |
| 73 | + jpfIncludes <- fromMaybe [] <$> o .?? "jpfIncludes" |
| 74 | + jpfExports <- fromMaybe [] <$> o .?? "jpfExports" |
| 75 | + excludes <- fromMaybe [] <$> o .?? "excludes" |
| 76 | + classifier <- o .?? "classifier" |
| 77 | + pure $ Dep {groupId,artifactId,version,jpfIncludes,jpfExports,excludes,classifier} |
| 78 | + |
| 79 | +instance depsDecode :: DecodeJson DepsFile where |
| 80 | + decodeJson json = do |
| 81 | + o <- decodeJson json |
| 82 | + exclusions <- o .? "exclusions" |
| 83 | + versions <- o .? "versions" |
| 84 | + dependencies <- o .? "dependencies" |
| 85 | + pure $ DepsFile {exclusions,versions,dependencies} |
| 86 | + |
| 87 | +keyOnly :: BaseDep -> DepKey |
| 88 | +keyOnly (BaseDep k _) = k |
| 89 | + |
| 90 | +versionOnly :: BaseDep -> String |
| 91 | +versionOnly (BaseDep k {version}) = version |
| 92 | + |
| 93 | +-- | Sort the dependencies and make sure we only use the highest version mentioned |
| 94 | +-- | and warn about the others |
| 95 | +mergeVersions :: Array BaseDep -> {warnings::Array String, merged::Array BaseDep} |
| 96 | +mergeVersions deps = |
| 97 | + let grouped = groupBy (on eq keyOnly) $ sortWith keyOnly deps |
| 98 | + allSelections = pickDep <$> grouped |
| 99 | + in {warnings: mapMaybe snd allSelections, merged: fst <$> allSelections } |
| 100 | + where |
| 101 | + pickDep (NonEmpty d others) | not $ any (notEq d) others = Tuple d Nothing |
| 102 | + pickDep ne@(NonEmpty df@(BaseDep k _) _) = fromMaybe (Tuple df Nothing) do |
| 103 | + let versions = fromFoldable $ versionOnly <$> ne |
| 104 | + maxVersion <- maximum versions |
| 105 | + maxDep <- find (versionOnly >>> eq maxVersion) ne |
| 106 | + let warning = "Ignoring versions '" <> joinWith ", " (filter (notEq maxVersion) versions) |
| 107 | + <> "' for dependency '" <> show k |
| 108 | + pure $ Tuple maxDep $ Just warning |
| 109 | + |
| 110 | +toGradle :: StrMap String -> Array BaseDep -> Either Error String |
| 111 | +toGradle versions deps = pure $ joinWith "\n" $ toGDep <$> deps |
| 112 | + where |
| 113 | + toGStr s = "'" <> s <> "'" |
| 114 | + resolveVersion s | (Just v) <- stripPrefix (Pattern "$") s = fromMaybe "" $ lookup v versions |
| 115 | + resolveVersion s = s |
| 116 | + classifierStr (Just c) = ":" <> c |
| 117 | + classifierStr _ = "" |
| 118 | + excludesStr [] = "" |
| 119 | + excludesStr allEx = " {\n " <> joinWith "\n " (exclude <$> allEx) <> "\n}" |
| 120 | + where exclude e = "exclude group: " <> toGStr e |
| 121 | + toGDep (BaseDep (DepKey k) d) = "compile(" <> toGStr (k.groupId <> ":" |
| 122 | + <> k.artifactId <> ":" |
| 123 | + <> resolveVersion d.version |
| 124 | + <> classifierStr d.classifier) <> ")" |
| 125 | + <> excludesStr d.excludes |
| 126 | + |
| 127 | +toSBT :: StrMap String -> Array BaseDep -> Either Error String |
| 128 | +toSBT versions deps = pure $ "libraryDependencies ++= Seq(" <> (joinWith ",\n" $ toGDep <$> deps) <> "\n)" |
| 129 | + where |
| 130 | + toStr s = "\"" <> s <> "\"" |
| 131 | + resolveVersion s | (Just v) <- stripPrefix (Pattern "$") s = toStr $ fromMaybe "" $ lookup v versions |
| 132 | + resolveVersion s = toStr s |
| 133 | + classifierStr (Just c) = " classifier " <> toStr c |
| 134 | + classifierStr _ = "" |
| 135 | + excludesStr [] = "" |
| 136 | + excludesStr allEx = " excludeAll(\n " <> joinWith ",\n" (exclude <$> allEx) <> "\n)" |
| 137 | + where |
| 138 | + exclude e = "ExclusionRule(" <> case split (Pattern ":") e of |
| 139 | + [o] -> "organization=" <> toStr o |
| 140 | + [o,m] -> "organization=" <> toStr o <> ", name=" <> toStr m |
| 141 | + _ -> toStr e |
| 142 | + <> ")" |
| 143 | + toGDep (BaseDep (DepKey k) d) = toStr k.groupId <> " % " |
| 144 | + <> toStr k.artifactId <> " % " |
| 145 | + <> resolveVersion d.version |
| 146 | + <> classifierStr d.classifier <> "" |
| 147 | + <> excludesStr d.excludes |
| 148 | + |
| 149 | + |
| 150 | +collectDeps :: Array DepsFile -> {versions:: StrMap String, deps:: Array BaseDep} |
| 151 | +collectDeps files = {versions,deps} |
| 152 | + where |
| 153 | + versions = unions $ map (\(DepsFile {versions:v}) -> v) files |
| 154 | + deps = concat $ map (\(DepsFile {dependencies:d}) -> map doDep d) files |
| 155 | + doDep (Dep {groupId,artifactId,version,classifier,excludes}) = BaseDep (DepKey {groupId,artifactId}) {version,classifier,excludes} |
| 156 | + |
| 157 | +outDeps :: forall e. Format -> Array String -> Eff (fs::FS, exception::EXCEPTION, console::CONSOLE|e) Unit |
| 158 | +outDeps format files = do |
| 159 | + depFiles <- traverse outDep files |
| 160 | + let {versions,deps} = collectDeps depFiles |
| 161 | + {warnings, merged} = mergeVersions deps |
| 162 | + traverse_ error warnings |
| 163 | + either (show >>> throw) log $ (writeOut format) versions merged |
| 164 | + where |
| 165 | + writeOut SBT = toSBT |
| 166 | + writeOut Gradle = toGradle |
| 167 | + outDep :: String -> Eff (fs::FS, exception::EXCEPTION, console::CONSOLE|e) DepsFile |
| 168 | + outDep fn = do |
| 169 | + depStr <- readTextFile UTF8 fn |
| 170 | + either throw pure do |
| 171 | + decodeJson =<< jsonParser depStr |
| 172 | + |
| 173 | + |
| 174 | +main :: forall e. Eff (fs::FS, console :: CONSOLE, exception::EXCEPTION | e) Unit |
| 175 | +main = do |
| 176 | + runY (usage "Convert deps.txt") (outDeps <$> yarg "format" [] Nothing (Left SBT) true <*> arg "_" ) |
0 commit comments