git.iko.soy/elk
on master help sign in
Adopt "model" code from elm-get so that dependencies can be crawled from the compiler.
3c1b9f7Evan Czaplicki
Elm.cabal+12−3
compare with master
unifiedsplit
@@ -30,7 +30,12 @@ source-repository head
30 location: git://github.com/evancz/Elm.git
30 location: git://github.com/evancz/Elm.git
31
31
32Library
32Library
33− exposed-modules: Language.Elm
33+ exposed-modules: Elm.Internal.Dependencies,
34+ Elm.Internal.Documentation,
35+ Elm.Internal.Name,
36+ Elm.Internal.Paths,
37+ Elm.Internal.Utils,
38+ Elm.Internal.Version
34 Hs-Source-Dirs: compiler
39 Hs-Source-Dirs: compiler
35 other-modules: SourceSyntax.Declaration,
40 other-modules: SourceSyntax.Declaration,
36 SourceSyntax.Expression,
41 SourceSyntax.Expression,
@@ -86,7 +91,8 @@ Library
86 Build.Utils,
91 Build.Utils,
87 Paths_Elm
92 Paths_Elm
88
93
89− Build-depends: base >=4.2 && <5,
94+ Build-depends: aeson,
95+ base >=4.2 && <5,
90 binary >= 0.6.4.0,
96 binary >= 0.6.4.0,
91 blaze-html == 0.5.* || == 0.6.*,
97 blaze-html == 0.5.* || == 0.6.*,
92 blaze-markup,
98 blaze-markup,
@@ -101,6 +107,7 @@ Library
101 pandoc >= 1.10,
107 pandoc >= 1.10,
102 parsec >= 3.1.1,
108 parsec >= 3.1.1,
103 pretty,
109 pretty,
110+ text,
104 transformers >= 0.2,
111 transformers >= 0.2,
105 union-find,
112 union-find,
106 uniplate
113 uniplate
@@ -163,7 +170,8 @@ Executable elm
163 Build.Utils,
170 Build.Utils,
164 Paths_Elm
171 Paths_Elm
165
172
166− Build-depends: base >=4.2 && <5,
173+ Build-depends: aeson,
174+ base >=4.2 && <5,
167 binary >= 0.6.4.0,
175 binary >= 0.6.4.0,
168 blaze-html == 0.5.* || == 0.6.*,
176 blaze-html == 0.5.* || == 0.6.*,
169 blaze-markup == 0.5.1.*,
177 blaze-markup == 0.5.1.*,
@@ -178,6 +186,7 @@ Executable elm
178 pandoc >= 1.10,
186 pandoc >= 1.10,
179 parsec >= 3.1.1,
187 parsec >= 3.1.1,
180 pretty,
188 pretty,
189+ text,
181 transformers >= 0.2,
190 transformers >= 0.2,
182 union-find,
191 union-find,
183 uniplate
192 uniplate
compiler/Build/Dependencies.hs+4−29
@@ -24,6 +24,7 @@ import qualified Transform.SortDefinitions as SD
24import qualified Type.Inference as TI
24import qualified Type.Inference as TI
25import qualified Type.Constrain.Declaration as TcDecl
25import qualified Type.Constrain.Declaration as TcDecl
26import qualified Transform.Canonicalize as Canonical
26import qualified Transform.Canonicalize as Canonical
27+import qualified Elm.Internal.Version as V
27
28
28getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
29getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
29getSortedDependencies srcDirs builtIns root =
30getSortedDependencies srcDirs builtIns root =
@@ -44,41 +45,15 @@ additionalSourceDirs =
44
45
45 getLatest project = do
46 getLatest project = do
46 subs <- getDirectoryContents project
47 subs <- getDirectoryContents project
47− case Maybe.mapMaybe version subs of
48+ case Maybe.mapMaybe V.fromString subs of
48 [] -> return Nothing
49 [] -> return Nothing
49− versions -> return $ Just $ (project </>) $ showVersion maxVersion
50+ versions -> return $ Just $ (project </>) $ show maxVersion
50− where maxVersion = List.maximumBy compareVersion versions
51+ where maxVersion = List.maximum versions
51
52
52 isProject path = do
53 isProject path = do
53 exists <- doesDirectoryExist path
54 exists <- doesDirectoryExist path
54 return $ exists && path `notElem` [".","..","_internals"]
55 return $ exists && path `notElem` [".","..","_internals"]
55
56
56−showVersion (ns,tag) =
57− List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag
58−
59−compareVersion a b =
60− case compare (fst a) (fst b) of
61− EQ -> compare (snd b) (snd a) -- reverse comparison to favor ""
62− cmp -> cmp
63−
64−version :: String -> Maybe ([Int], String)
65−version version = (,) <$> splitNumbers possibleNumbers <*> tag
66− where
67− (possibleNumbers, possibleTag) = break (=='-') version
68−
69− tag = case possibleTag of
70− "" -> Just ""
71− '-':rest -> Just rest
72− _ -> Nothing
73−
74− splitNumbers :: String -> Maybe [Int]
75− splitNumbers ns =
76− case span Char.isDigit ns of
77− ("", _) -> Nothing
78− (number, []) -> Just [read number]
79− (number, '.':rest) -> (read number :) <$> splitNumbers rest
80− _ -> Nothing
81−
82type Deps = (FilePath, String, [String])
57type Deps = (FilePath, String, [String])
83
58
84sortDeps :: [Deps] -> IO [String]
59sortDeps :: [Deps] -> IO [String]
compiler/Elm/Internal/Dependencies.hsnew file+93
@@ -0,0 +1,93 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Elm.Internal.Dependencies where
3+
4+import Control.Applicative
5+import Control.Monad.Error
6+import qualified Control.Exception as E
7+import Data.Aeson
8+import qualified Data.List as List
9+import qualified Data.ByteString.Lazy as BS
10+import qualified Data.Map as Map
11+import qualified Elm.Internal.Name as N
12+import qualified Elm.Internal.Version as V
13+
14+data Deps = Deps
15+ { name :: N.Name
16+ , version :: V.Version
17+ , summary :: String
18+ , description :: String
19+ , license :: String
20+ , repo :: String
21+ , exposed :: [String]
22+ , elmVersion :: V.Version
23+ } deriving Show
24+
25+instance FromJSON Deps where
26+ parseJSON (Object obj) =
27+ do version <- obj .: "version"
28+
29+ summary <- obj .: "summary"
30+ when (length summary >= 80) $
31+ fail "'summary' must be less than 80 characters"
32+
33+ desc <- obj .: "description"
34+ license <- obj .: "license"
35+
36+ repo <- obj .: "repository"
37+ name <- case repoToName repo of
38+ Left err -> fail err
39+ Right nm -> return nm
40+
41+ exposed <- obj .: "exposed-modules"
42+ when (null exposed) $
43+ fail "there are no 'exposed-modules'.\n\
44+ \At least one module must be exposed for anyone to use this library!"
45+
46+ elmVersion <- obj .: "elm-version"
47+
48+ return $ Deps name version summary desc license repo exposed elmVersion
49+
50+ parseJSON _ = mzero
51+
52+repoToName :: String -> Either String N.Name
53+repoToName repo
54+ | not (end `List.isSuffixOf` repo) = Left msg
55+ | otherwise =
56+ do path <- getPath
57+ let raw = take (length path - length end) path
58+ case N.fromString raw of
59+ Nothing -> Left msg
60+ Just name -> Right name
61+ where
62+ getPath | http `List.isPrefixOf` repo = Right $ drop (length http ) repo
63+ | https `List.isPrefixOf` repo = Right $ drop (length https) repo
64+ | otherwise = Left msg
65+ http = "http://github.com/"
66+ https = "https://github.com/"
67+ end = ".git"
68+ msg = "the 'repository' field must point to a GitHub project for now, something\n\
69+ \like <https://github.com/USER/PROJECT.git> where USER is your GitHub name\n\
70+ \and PROJECT is the repo you want to upload."
71+
72+withDeps :: (Deps -> a) -> FilePath -> ErrorT String IO a
73+withDeps handle path =
74+ do json <- readPath
75+ case eitherDecode json of
76+ Left err -> throwError $ "Error reading file " ++ path ++ ":\n " ++ err
77+ Right ds -> return (handle ds)
78+ where
79+ readPath :: ErrorT String IO BS.ByteString
80+ readPath = do
81+ result <- liftIO $ E.catch (Right <$> BS.readFile path)
82+ (\err -> return $ Left (err :: IOError))
83+ case result of
84+ Right bytes -> return bytes
85+ Left _ -> throwError $
86+ "could not find file " ++ path ++
87+ "\n You may need to create a dependency file for your project."
88+
89+dependencies :: FilePath -> ErrorT String IO (Map.Map String String)
90+dependencies _ = return Map.empty -- withDeps deps
91+
92+depsAt :: FilePath -> ErrorT String IO Deps
93+depsAt = withDeps id
compiler/Elm/Internal/Documentation.hsnew file+41
@@ -0,0 +1,41 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Elm.Internal.Documentation where
3+
4+import Control.Applicative ((<$>),(<*>))
5+import Control.Monad
6+import Data.Aeson
7+
8+data Document = Doc
9+ { moduleName :: String
10+ , structure :: String
11+ , entries :: [Entry]
12+ } deriving (Show)
13+
14+data Entry = Entry
15+ { name :: String
16+ , comment :: String
17+ , raw :: String
18+ , assocPrec :: Maybe (String,Int)
19+ } deriving (Show)
20+
21+instance FromJSON Document where
22+ parseJSON (Object v) =
23+ Doc <$> v .: "name"
24+ <*> v .: "document"
25+ <*> (concat <$> sequence [ v .: "aliases", v .: "datatypes", v .: "values" ])
26+
27+ parseJSON _ = fail "Conversion to Document was expecting an object"
28+
29+instance FromJSON Entry where
30+ parseJSON (Object v) =
31+ Entry <$> v .: "name"
32+ <*> v .: "comment"
33+ <*> v .: "raw"
34+ <*> (liftM2 (,) <$> v .:? "associativity"
35+ <*> v .:? "precedence")
36+
37+ parseJSON _ = fail "Conversion to Entry was expecting an object"
38+
39+data Content = Markdown String | Value String
40+ deriving Show
41+
compiler/Elm/Internal/Name.hsnew file+48
@@ -0,0 +1,48 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module Elm.Internal.Name where
3+
4+import Control.Applicative
5+import Control.Monad.Error
6+import Data.Aeson
7+import Data.Binary
8+import qualified Data.Text as T
9+import qualified Data.Maybe as Maybe
10+import Data.Typeable
11+
12+data Name = Name { user :: String, project :: String }
13+ deriving (Typeable,Eq)
14+
15+instance Binary Name where
16+ get = Name <$> get <*> get
17+ put (Name user project) =
18+ put user >> put project
19+
20+instance Show Name where
21+ show name = user name ++ "/" ++ project name
22+
23+toFilePath :: Name -> FilePath
24+toFilePath name = user name ++ "-" ++ project name
25+
26+fromString :: String -> Maybe Name
27+fromString string =
28+ case break (=='/') string of
29+ ( user@(_:_), '/' : project@(_:_) )
30+ | all (/='/') project -> Just (Name user project)
31+ _ -> Nothing
32+
33+fromString' :: String -> ErrorT String IO Name
34+fromString' string =
35+ Maybe.maybe (throwError $ errorMsg string) return (fromString string)
36+
37+instance FromJSON Name where
38+ parseJSON (String text) =
39+ let string = T.unpack text in
40+ Maybe.maybe (fail $ errorMsg string) return (fromString string)
41+
42+ parseJSON _ = fail "Project name must be a string."
43+
44+errorMsg string =
45+ unlines
46+ [ "Dependency file has an invalid name: " ++ string
47+ , "Must have format user/project and match a public github project."
48+ ]
compiler/Elm/Internal/Paths.hsnew file+23
@@ -0,0 +1,23 @@
1+module Elm.Internal.Paths where
2+
3+import System.IO.Unsafe
4+import qualified Paths_Elm as This
5+
6+-- |Name of directory for all of a project's dependencies.
7+dependencyDirectory :: FilePath
8+dependencyDirectory = "elm_dependencies"
9+
10+-- |Name of the dependency file, specifying dependencies and
11+-- other metadata for building and sharing projects.
12+dependencyFile :: FilePath
13+dependencyFile = "elm_dependencies.json"
14+
15+{-# NOINLINE runtime #-}
16+-- |The absolute path to Elm's runtime system.
17+runtime :: FilePath
18+runtime = unsafePerformIO $ This.getDataFileName "elm-runtime.js"
19+
20+{-# NOINLINE docs #-}
21+-- |The absolute path to Elm's core library documentation.
22+docs :: FilePath
23+docs = unsafePerformIO $ This.getDataFileName "docs.json"
compiler/Language/Elm.hs → compiler/Elm/Internal/Utils.hsrenamed+2−16
@@ -1,11 +1,6 @@
1−{- | This module exports functions for compiling Elm to JS
1+{- | This module exports functions for compiling Elm to JS.
2− and some utilities for making it easier to find some Elm-related files.
3−
4− Learning resources for Elm are available at
5− <http://elm-lang.org.elm/Learn.elm> and many interactive examples are
6− available at <http://elm-lang.org/Examples.elm>
7-}
2-}
8−module Language.Elm (compile, moduleName, runtime, docs) where
3+module Elm.Internal.Utils (compile, moduleName) where
9
4
10import qualified Data.List as List
5import qualified Data.List as List
11import qualified Generate.JavaScript as JS
6import qualified Generate.JavaScript as JS
@@ -14,7 +9,6 @@ import qualified Parse.Module as Parser
14import qualified SourceSyntax.Module as M
9import qualified SourceSyntax.Module as M
15import qualified Text.PrettyPrint as P
10import qualified Text.PrettyPrint as P
16import qualified Metadata.Prelude as Prelude
11import qualified Metadata.Prelude as Prelude
17−import qualified Paths_Elm as This
18import System.IO.Unsafe
12import System.IO.Unsafe
19
13
20-- |This function compiles Elm code to JavaScript. It will return either
14-- |This function compiles Elm code to JavaScript. It will return either
@@ -32,11 +26,3 @@ interfaces = unsafePerformIO $ Prelude.interfaces
32-- |This function extracts the module name of a given source program.
26-- |This function extracts the module name of a given source program.
33moduleName :: String -> Maybe String
27moduleName :: String -> Maybe String
34moduleName = Parser.getModuleName
28moduleName = Parser.getModuleName
35−
36−-- |The absolute path to Elm's runtime system.
37−runtime :: IO FilePath
38−runtime = This.getDataFileName "elm-runtime.js"
39−
40−-- |The absolute path to Elm's core library documentation.
41−docs :: IO FilePath
42−docs = This.getDataFileName "docs.json"
compiler/Elm/Internal/Version.hsnew file+63
@@ -0,0 +1,63 @@
1+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
2+module Elm.Internal.Version where
3+
4+import Control.Applicative
5+import Data.Aeson
6+import Data.Binary
7+import Data.Char (isDigit)
8+import qualified Data.List as List
9+import Data.Typeable
10+import qualified Data.Text as T
11+
12+-- Data representation
13+
14+data Version = V [Int] String
15+ deriving (Typeable,Eq)
16+
17+instance Ord Version where
18+ compare (V ns tag) (V ns' tag') =
19+ case compare ns ns' of
20+ EQ -> compare tag' tag -- reverse comparison to favor ""
21+ cmp -> cmp
22+
23+instance Show Version where
24+ show (V ns tag) =
25+ List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag
26+
27+instance Binary Version where
28+ get = V <$> get <*> get
29+ put (V ns tag) = do put ns
30+ put tag
31+
32+tagless :: Version -> Bool
33+tagless (V _ tag) = null tag
34+
35+fromString :: String -> Maybe Version
36+fromString version = V <$> splitNumbers possibleNumbers <*> tag
37+ where
38+ (possibleNumbers, possibleTag) = break (=='-') version
39+
40+ tag = case possibleTag of
41+ "" -> Just ""
42+ '-':rest -> Just rest
43+ _ -> Nothing
44+
45+ splitNumbers :: String -> Maybe [Int]
46+ splitNumbers ns =
47+ case span isDigit ns of
48+ ("", _) -> Nothing
49+ (number, []) -> Just [read number]
50+ (number, '.':rest) -> (read number :) <$> splitNumbers rest
51+ _ -> Nothing
52+
53+instance FromJSON Version where
54+ parseJSON (String text) =
55+ let string = T.unpack text in
56+ case fromString string of
57+ Just v -> return v
58+ Nothing -> fail $ unlines
59+ [ "Dependency file has an invalid version number: " ++ string
60+ , "Must have format 0.1.2 or 0.1.2-tag"
61+ ]
62+
63+ parseJSON _ = fail "Version number must be stored as a string."