Adopt "model" code from elm-get so that dependencies can be crawled from the compiler.

Elm.cabal

@@ -30,7 +30,12 @@ source-repository head
   location: git://github.com/evancz/Elm.git
 
 Library
-  exposed-modules:     Language.Elm
+  exposed-modules:     Elm.Internal.Dependencies,
+                       Elm.Internal.Documentation,
+                       Elm.Internal.Name,
+                       Elm.Internal.Paths,
+                       Elm.Internal.Utils,
+                       Elm.Internal.Version
   Hs-Source-Dirs:      compiler
   other-modules:       SourceSyntax.Declaration,
                        SourceSyntax.Expression,
@@ -86,7 +91,8 @@ Library
                        Build.Utils,
                        Paths_Elm
 
-  Build-depends:       base >=4.2 && <5,
+  Build-depends:       aeson,
+                       base >=4.2 && <5,
                        binary >= 0.6.4.0,
                        blaze-html == 0.5.* || == 0.6.*,
                        blaze-markup,
@@ -101,6 +107,7 @@ Library
                        pandoc >= 1.10,
                        parsec >= 3.1.1,
                        pretty,
+                       text,
                        transformers >= 0.2,
                        union-find,
                        uniplate
@@ -163,7 +170,8 @@ Executable elm
                        Build.Utils,
                        Paths_Elm
 
-  Build-depends:       base >=4.2 && <5,
+  Build-depends:       aeson,
+                       base >=4.2 && <5,
                        binary >= 0.6.4.0,
                        blaze-html == 0.5.* || == 0.6.*,
                        blaze-markup == 0.5.1.*,
@@ -178,6 +186,7 @@ Executable elm
                        pandoc >= 1.10,
                        parsec >= 3.1.1,
                        pretty,
+                       text,
                        transformers >= 0.2,
                        union-find,
                        uniplate

compiler/Build/Dependencies.hs

@@ -24,6 +24,7 @@ import qualified Transform.SortDefinitions as SD
 import qualified Type.Inference as TI
 import qualified Type.Constrain.Declaration as TcDecl
 import qualified Transform.Canonicalize as Canonical
+import qualified Elm.Internal.Version as V
 
 getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
 getSortedDependencies srcDirs builtIns root =
@@ -44,41 +45,15 @@ additionalSourceDirs =
 
       getLatest project = do
         subs <- getDirectoryContents project
-        case Maybe.mapMaybe version subs of
+        case Maybe.mapMaybe V.fromString subs of
           [] -> return Nothing
-          versions -> return $ Just $ (project </>) $ showVersion maxVersion
+          versions -> return $ Just $ (project </>) $ show maxVersion
-              where maxVersion = List.maximumBy compareVersion versions
+              where maxVersion = List.maximum versions
 
       isProject path = do
         exists <- doesDirectoryExist path
         return $ exists && path `notElem` [".","..","_internals"]
 
-showVersion (ns,tag) =
-    List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag
-
-compareVersion a b =
-    case compare (fst a) (fst b) of
-      EQ -> compare (snd b) (snd a) -- reverse comparison to favor ""
-      cmp -> cmp      
-
-version :: String -> Maybe ([Int], String)
-version version = (,) <$> splitNumbers possibleNumbers <*> tag
-    where
-      (possibleNumbers, possibleTag) = break (=='-') version
-
-      tag = case possibleTag of
-              "" -> Just ""
-              '-':rest -> Just rest
-              _ -> Nothing
-
-      splitNumbers :: String -> Maybe [Int]
-      splitNumbers ns =
-          case span Char.isDigit ns of
-            ("", _) -> Nothing
-            (number, []) -> Just [read number]
-            (number, '.':rest) -> (read number :) <$> splitNumbers rest
-            _ -> Nothing
-
 type Deps = (FilePath, String, [String])
 
 sortDeps :: [Deps] -> IO [String]

compiler/Elm/Internal/Dependencies.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Elm.Internal.Dependencies where
+
+import Control.Applicative
+import Control.Monad.Error
+import qualified Control.Exception as E
+import Data.Aeson
+import qualified Data.List as List
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.Map as Map
+import qualified Elm.Internal.Name as N
+import qualified Elm.Internal.Version as V
+
+data Deps = Deps
+    { name :: N.Name
+    , version :: V.Version
+    , summary :: String
+    , description :: String
+    , license :: String
+    , repo :: String
+    , exposed :: [String]
+    , elmVersion :: V.Version
+    } deriving Show
+
+instance FromJSON Deps where
+    parseJSON (Object obj) =
+        do version <- obj .: "version"
+
+           summary <- obj .: "summary"
+           when (length summary >= 80) $
+               fail "'summary' must be less than 80 characters"
+
+           desc    <- obj .: "description"
+           license <- obj .: "license"
+
+           repo <- obj .: "repository"
+           name <- case repoToName repo of
+                     Left err -> fail err
+                     Right nm -> return nm
+
+           exposed <- obj .: "exposed-modules"
+           when (null exposed) $
+                fail "there are no 'exposed-modules'.\n\
+                     \At least one module must be exposed for anyone to use this library!"
+
+           elmVersion <- obj .: "elm-version"
+
+           return $ Deps name version summary desc license repo exposed elmVersion
+
+    parseJSON _ = mzero
+
+repoToName :: String -> Either String N.Name
+repoToName repo
+    | not (end `List.isSuffixOf` repo) = Left msg
+    | otherwise =
+        do path <- getPath
+           let raw = take (length path - length end) path
+           case N.fromString raw of
+             Nothing   -> Left msg
+             Just name -> Right name
+    where
+      getPath | http  `List.isPrefixOf` repo = Right $ drop (length http ) repo
+              | https `List.isPrefixOf` repo = Right $ drop (length https) repo
+              | otherwise = Left msg
+      http  = "http://github.com/"
+      https = "https://github.com/"
+      end = ".git"
+      msg = "the 'repository' field must point to a GitHub project for now, something\n\
+            \like <https://github.com/USER/PROJECT.git> where USER is your GitHub name\n\
+            \and PROJECT is the repo you want to upload."
+
+withDeps :: (Deps -> a) -> FilePath -> ErrorT String IO a
+withDeps handle path =
+    do json <- readPath
+       case eitherDecode json of
+         Left err -> throwError $ "Error reading file " ++ path ++ ":\n    " ++ err
+         Right ds -> return (handle ds)
+    where
+      readPath :: ErrorT String IO BS.ByteString
+      readPath = do
+        result <- liftIO $ E.catch (Right <$> BS.readFile path)
+                                   (\err -> return $ Left (err :: IOError))
+        case result of
+          Right bytes -> return bytes
+          Left _ -> throwError $
+                    "could not find file " ++ path ++
+                    "\n    You may need to create a dependency file for your project."
+
+dependencies :: FilePath -> ErrorT String IO (Map.Map String String)
+dependencies _ = return Map.empty -- withDeps deps
+
+depsAt :: FilePath -> ErrorT String IO Deps
+depsAt = withDeps id

compiler/Elm/Internal/Documentation.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Elm.Internal.Documentation where
+
+import Control.Applicative ((<$>),(<*>))
+import Control.Monad
+import Data.Aeson
+
+data Document = Doc
+    { moduleName :: String
+    , structure :: String
+    , entries :: [Entry]
+    } deriving (Show)
+
+data Entry = Entry
+    { name :: String
+    , comment :: String
+    , raw :: String
+    , assocPrec :: Maybe (String,Int)
+    } deriving (Show)
+
+instance FromJSON Document where
+    parseJSON (Object v) =
+        Doc <$> v .: "name"
+            <*> v .: "document"
+            <*> (concat <$> sequence [ v .: "aliases", v .: "datatypes", v .: "values" ])
+
+    parseJSON _ = fail "Conversion to Document was expecting an object"
+
+instance FromJSON Entry where
+    parseJSON (Object v) =
+        Entry <$> v .: "name"
+              <*> v .: "comment"
+              <*> v .: "raw"
+              <*> (liftM2 (,) <$> v .:? "associativity"
+                              <*> v .:? "precedence")
+
+    parseJSON _ = fail "Conversion to Entry was expecting an object"
+
+data Content = Markdown String | Value String
+               deriving Show
+

compiler/Elm/Internal/Name.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Elm.Internal.Name where
+
+import Control.Applicative
+import Control.Monad.Error
+import Data.Aeson
+import Data.Binary
+import qualified Data.Text as T
+import qualified Data.Maybe as Maybe
+import Data.Typeable
+
+data Name = Name { user :: String, project :: String }
+    deriving (Typeable,Eq)
+
+instance Binary Name where
+  get = Name <$> get <*> get
+  put (Name user project) =
+      put user >> put project
+
+instance Show Name where
+  show name = user name ++ "/" ++ project name
+
+toFilePath :: Name -> FilePath
+toFilePath name = user name ++ "-" ++ project name
+
+fromString :: String -> Maybe Name
+fromString string =
+    case break (=='/') string of
+      ( user@(_:_), '/' : project@(_:_) )
+          | all (/='/') project -> Just (Name user project)
+      _ -> Nothing
+
+fromString' :: String -> ErrorT String IO Name
+fromString' string =
+    Maybe.maybe (throwError $ errorMsg string) return (fromString string)
+
+instance FromJSON Name where
+    parseJSON (String text) =
+        let string = T.unpack text in
+        Maybe.maybe (fail $ errorMsg string) return (fromString string)
+
+    parseJSON _ = fail "Project name must be a string."
+
+errorMsg string =
+    unlines
+    [ "Dependency file has an invalid name: " ++ string
+    , "Must have format user/project and match a public github project."
+    ]

compiler/Elm/Internal/Paths.hs

@@ -0,0 +1,23 @@
+module Elm.Internal.Paths where
+
+import System.IO.Unsafe
+import qualified Paths_Elm as This
+
+-- |Name of directory for all of a project's dependencies.
+dependencyDirectory :: FilePath
+dependencyDirectory = "elm_dependencies"
+
+-- |Name of the dependency file, specifying dependencies and
+--  other metadata for building and sharing projects.
+dependencyFile :: FilePath
+dependencyFile = "elm_dependencies.json"
+
+{-# NOINLINE runtime #-}
+-- |The absolute path to Elm's runtime system.
+runtime :: FilePath
+runtime = unsafePerformIO $ This.getDataFileName "elm-runtime.js"
+
+{-# NOINLINE docs #-}
+-- |The absolute path to Elm's core library documentation.
+docs :: FilePath
+docs = unsafePerformIO $ This.getDataFileName "docs.json"

compiler/Elm/Internal/Utils.hs

@@ -1,11 +1,6 @@
-{- | This module exports functions for compiling Elm to JS
+{- | This module exports functions for compiling Elm to JS.
-     and some utilities for making it easier to find some Elm-related files.
-
-     Learning resources for Elm are available at
-     <http://elm-lang.org.elm/Learn.elm> and many interactive examples are
-     available at <http://elm-lang.org/Examples.elm>
 -}
-module Language.Elm (compile, moduleName, runtime, docs) where
+module Elm.Internal.Utils (compile, moduleName) where
 
 import qualified Data.List as List
 import qualified Generate.JavaScript as JS
@@ -14,7 +9,6 @@ import qualified Parse.Module as Parser
 import qualified SourceSyntax.Module as M
 import qualified Text.PrettyPrint as P
 import qualified Metadata.Prelude as Prelude
-import qualified Paths_Elm as This
 import System.IO.Unsafe
 
 -- |This function compiles Elm code to JavaScript. It will return either
@@ -32,11 +26,3 @@ interfaces = unsafePerformIO $ Prelude.interfaces
 -- |This function extracts the module name of a given source program.
 moduleName :: String -> Maybe String
 moduleName = Parser.getModuleName
-
--- |The absolute path to Elm's runtime system.
-runtime :: IO FilePath
-runtime = This.getDataFileName "elm-runtime.js"
-
--- |The absolute path to Elm's core library documentation.
-docs :: IO FilePath
-docs = This.getDataFileName "docs.json"

compiler/Elm/Internal/Version.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
+module Elm.Internal.Version where
+
+import           Control.Applicative
+import           Data.Aeson
+import           Data.Binary
+import           Data.Char              (isDigit)
+import qualified Data.List              as List
+import           Data.Typeable
+import qualified Data.Text              as T
+
+-- Data representation
+
+data Version = V [Int] String
+    deriving (Typeable,Eq)
+
+instance Ord Version where
+  compare (V ns tag) (V ns' tag') =
+      case compare ns ns' of
+        EQ -> compare tag' tag -- reverse comparison to favor ""
+        cmp -> cmp
+
+instance Show Version where
+  show (V ns tag) =
+      List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag
+
+instance Binary Version where
+  get = V <$> get <*> get
+  put (V ns tag) = do put ns
+                      put tag
+
+tagless :: Version -> Bool
+tagless (V _ tag) = null tag
+
+fromString :: String -> Maybe Version
+fromString version = V <$> splitNumbers possibleNumbers <*> tag
+    where
+      (possibleNumbers, possibleTag) = break (=='-') version
+
+      tag = case possibleTag of
+              "" -> Just ""
+              '-':rest -> Just rest
+              _ -> Nothing
+
+      splitNumbers :: String -> Maybe [Int]
+      splitNumbers ns =
+          case span isDigit ns of
+            ("", _) -> Nothing
+            (number, []) -> Just [read number]
+            (number, '.':rest) -> (read number :) <$> splitNumbers rest
+            _ -> Nothing
+
+instance FromJSON Version where
+    parseJSON (String text) =
+        let string = T.unpack text in
+        case fromString string of
+          Just v -> return v
+          Nothing -> fail $ unlines
+                     [ "Dependency file has an invalid version number: " ++ string
+                     , "Must have format 0.1.2 or 0.1.2-tag"
+                     ]
+
+    parseJSON _ = fail "Version number must be stored as a string."