Support elm-0.19

This implements elm-0.19 depedency generation.

The algorithm is simple: look in elm.json and convert all direct and indirect
dependencies to nix.

Signed-off-by: William Casarin <jb55@jb55.com>

elm2nix.cabal

@@ -30,16 +30,17 @@ library
       src
   build-depends:
       base >= 4.7 && < 5
+    , aeson
     , async
-    , elm-package
-    , elm-compiler
-    , directory
-    , mtl
-    , process
     , bytestring
     , containers
+    , directory
     , here
+    , mtl
+    , process
     , text
+    , transformers
+    , unordered-containers
   exposed-modules:
       Lib
       Prefetch

src/Lib.hs

@@ -1,90 +1,138 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Lib
     ( convert
     , init'
     ) where
 
 import Control.Concurrent.Async
-import Control.Monad.Except (liftIO, throwError)
+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
+import Control.Monad (liftM2)
+import Control.Monad.Except (liftIO, MonadIO)
+import Data.Aeson (Value(..))
 import Data.List (intercalate)
-import qualified Data.Text as Text
-import System.Directory (createDirectoryIfMissing, doesFileExist)
-import System.Exit (exitFailure)
-import System.IO ( hPutStrLn, stdout, stderr)
-import qualified Data.Map as Map
+import Data.HashMap.Strict (HashMap)
 import Data.String.Here
+import Data.Text (Text)
+import System.Exit (exitFailure)
+import System.IO ( hPutStrLn, stderr)
 
-import qualified Install.Solver as Solver
-import qualified Install.Plan as Plan
-import qualified Reporting.Error as Error
-import qualified Manager
-import qualified Install
-import qualified Elm.Package as Package
-import qualified Elm.Package.Description as Desc
-import qualified Elm.Package.Paths as Path
-import qualified Elm.Package.Solution as Solution
+import qualified Data.HashMap.Strict as HM
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Aeson as Json
+import qualified Data.Text as Text
 
 import Prefetch
 
+newtype Elm2Nix a = Elm2Nix { runElm2Nix_ :: ExceptT Elm2NixError IO a }
+  deriving (Functor, Applicative, Monad, MonadIO)
+
+type Dep = (String, String)
+
+data Elm2NixError =
+    ElmJsonReadError String
+  | UnexpectedValue Value
+  | KeyNotFound Text
+  deriving Show
+
+runElm2Nix = runExceptT . runElm2Nix_
+
+throwErr :: Elm2NixError -> Elm2Nix a
+throwErr e = Elm2Nix (throwE e)
+
+parseDep :: Text -> Value -> Either Elm2NixError Dep
+parseDep name (String ver) = Right (Text.unpack name, Text.unpack ver)
+parseDep _ v               = Left (UnexpectedValue v)
+
+parseDeps :: Value -> Either Elm2NixError [Dep]
+parseDeps (Object hm) = mapM (uncurry parseDep) (HM.toList hm)
+parseDeps v           = Left (UnexpectedValue v)
+
+maybeToRight :: b -> Maybe a -> Either b a
+maybeToRight _ (Just x) = Right x
+maybeToRight y Nothing  = Left y
+
+tryLookup :: HashMap Text Value -> Text -> Either Elm2NixError Value
+tryLookup hm key =
+  maybeToRight (KeyNotFound key) (HM.lookup key hm)
+
+parseElmJsonDeps :: Value -> Either Elm2NixError [Dep]
+parseElmJsonDeps obj =
+  case obj of
+    Object hm ->
+      do deps     <- tryLookup hm "dependencies"
+         case deps of
+           Object dhm -> do
+             direct   <- tryLookup dhm "direct"
+             indirect <- tryLookup dhm "indirect"
+             liftM2 (++) (parseDeps direct) (parseDeps indirect)
+
+           v -> Left (UnexpectedValue v)
+    v ->
+      Left (UnexpectedValue v)
+
+
 -- CMDs
 
 convert :: IO ()
 convert = runCLI solveDependencies
 
 
 init' :: IO ()
-init' = runCLI generateDefault
+init' = runCLI (generateDefault "elm-app" "0.1.0")
 
 -- Utils
 
-runCLI f = do
-  result <- Manager.run f
+depErrToStderr :: Elm2NixError -> IO ()
+depErrToStderr err =
+  let
+    humanErr =
+      case err of
+        UnexpectedValue v -> "Unexpected Value: \n" ++ show v
+        ElmJsonReadError s -> "Error reading json: " ++ s
+        KeyNotFound key -> "Key not found in json: " ++ Text.unpack key
+  in
+    hPutStrLn stderr humanErr
+
+runCLI :: Elm2Nix a -> IO a
+runCLI m = do
+  result <- runElm2Nix m
   case result of
-        Right () ->
-          return ()
+        Right a ->
+          return a
 
         Left err -> do
-          Error.toStderr err
+          depErrToStderr err
           exitFailure
 
-generateDefault :: Manager.Manager ()
-generateDefault = do
-  desc <- readDescription
-  let name = toNixName (Desc.name desc) ++ "-" ++ show (Desc.version desc)
-  let srcdir = case Desc.sourceDirs desc of
-                    []    -> "."
-                    (a:_) -> a
-  liftIO $ putStrLn [template|data/default.nix|]
+generateDefault :: Text -> Text -> Elm2Nix ()
+generateDefault baseName version = do
+  let name = Text.unpack (toNixName baseName <> "-" <> version)
+  let srcdir = "." :: String
+  liftIO (putStrLn [template|data/default.nix|])
 
-solveDependencies :: Manager.Manager ()
-solveDependencies = do
-  liftIO $ hPutStrLn stderr "Resolving elm-package.json dependencies into Nix ..."
-
-  desc <- readDescription
-  newSolution <- Solver.solve (Desc.elmVersion desc) (Desc.dependencies desc)
-  liftIO (createDirectoryIfMissing True Path.stuffDirectory)
-  liftIO (Solution.write Path.solvedDependencies newSolution)
-
-  liftIO $ hPutStrLn stderr "Prefetching tarballs and computing sha256 hashes ..."
+readElmJson :: Elm2Nix Value
+readElmJson = do
+  res <- liftIO (fmap Json.eitherDecode (LBS.readFile "elm.json"))
+  either (throwErr . ElmJsonReadError) return res
 
-  let solL = Map.toList newSolution
-  sources <- liftIO $ mapConcurrently Prefetch.prefetchURL solL
-
-  liftIO $ putStrLn $ generateNixSources sources
+solveDependencies :: Elm2Nix ()
+solveDependencies = do
+  liftIO (hPutStrLn stderr "Resolving elm.json dependencies into Nix ...")
+  elmJson <- readElmJson
 
-readDescription :: Manager.Manager Desc.Description
-readDescription = do
-  exists <- liftIO (doesFileExist Path.description)
+  deps <- either throwErr return (parseElmJsonDeps elmJson)
+  liftIO (hPutStrLn stderr "Prefetching tarballs and computing sha256 hashes ...")
 
-  if exists
-  then Desc.read Error.CorruptDescription Path.description
-  else Install.initialDescription
+  sources <- liftIO (mapConcurrently (uncurry Prefetch.prefetchURL) deps)
+  liftIO (putStrLn (generateNixSources sources))
 
 generateNixSource :: DerivationSource -> String
 generateNixSource ds =
   -- TODO: pass name to fetchzip
-  [i|  "${Package.toUrl (drvName ds)}" = {
+  [i|  "${drvName ds}" = {
     src = fetchzip {
       url = "${drvUrl ds}";
       sha256 = "${drvHash ds}";
@@ -101,6 +149,5 @@ ${intercalate "\n" (map generateNixSource dss)}
   |]
 
 -- | Converts Package.Name to Nix friendly name
-toNixName :: Package.Name -> String
-toNixName (Package.Name user project) =
-  Text.unpack user ++ "-" ++ Text.unpack project
+toNixName :: Text -> Text
+toNixName = Text.replace "/" "-"

src/Prefetch.hs

@@ -1,33 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Prefetch where
 
-import System.Environment
+
 import System.Exit
 import System.Process
 import qualified Data.ByteString.Lazy.Char8 as BS
 
-import qualified Elm.Package as Package
-
-
 data DerivationSource = DerivationSource
   { drvHash :: String -- ^ Computed sha256 hash
   , drvPath :: String -- ^ Nix store path of the derivation
   , drvUrl :: String
-  , drvName :: Package.Name
-  , drvVersion :: Package.Version
+  , drvName :: String
+  , drvVersion :: String
   } deriving (Show, Eq)
 
-instance Show Package.Version where
-  show = Package.versionToString
-
 -- | Use nix-prefetch-url to obtain resulting path and it's hash
 -- | Partially taken from cabal2nix/src/Distribution/Nixpkgs/Fetch.hs
-prefetchURL :: (Package.Name, Package.Version) -> IO DerivationSource
-prefetchURL (name, version) =
+prefetchURL :: String -> String -> IO DerivationSource
+prefetchURL name version =
   let url = toZipballUrl name version
       args :: [String]
       args = ["--unpack", "--print-path", url]
   in  do
-        envs <- getEnvironment
         (Nothing, Just stdoutH, _, processH) <-
           createProcess (proc "nix-prefetch-url" args) { env     = Nothing
                                                        , std_in  = Inherit
@@ -51,10 +45,10 @@ prefetchURL (name, version) =
               _ -> error "unknown nix-prefetch-url output"
 
 
-toZipballUrl :: Package.Name -> Package.Version -> String
+toZipballUrl :: String -> String -> String
 toZipballUrl name version =
   "https://github.com/"
-    ++ Package.toUrl name
+    ++ name
     ++ "/archive/"
-    ++ Package.versionToString version
+    ++ version
     ++ ".zip"

stack.yaml

@@ -2,15 +2,6 @@ resolver: lts-7.24
 # Sadly, Elm 0.18 doesn't support GHC 8
 packages:
 - .
-- location:
-    git: https://github.com/domenkozar/elm-package.git
-    commit: 2a5d2de0b55d4c9a30bec71f1cc6ff80130d7dfe
-  extra-dep: true
-- location:
-    git: https://github.com/jerith666/elm-compiler.git
-    commit: 7ee7742a16188df7ff498ec4ef9f8b49e58a35fe
-  extra-dep: true
-# needed due to https://github.com/tmhedberg/here/commit/8a616b358bcc16bd215a78a8f6192ad9df8224b6
 - location:
     git: https://github.com/tmhedberg/here.git
     commit: 8a616b358bcc16bd215a78a8f6192ad9df8224b6