diff --git a/Elm.cabal b/Elm.cabal index 73a6625..785a7ef 100644 --- a/Elm.cabal +++ b/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 diff --git a/compiler/Build/Dependencies.hs b/compiler/Build/Dependencies.hs index 39d76a5..7b40806 100644 --- a/compiler/Build/Dependencies.hs +++ b/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 - where maxVersion = List.maximumBy compareVersion versions + versions -> return $ Just $ (project ) $ show maxVersion + 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] diff --git a/compiler/Elm/Internal/Dependencies.hs b/compiler/Elm/Internal/Dependencies.hs new file mode 100644 index 0000000..75d43e9 --- /dev/null +++ b/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 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 \ No newline at end of file diff --git a/compiler/Elm/Internal/Documentation.hs b/compiler/Elm/Internal/Documentation.hs new file mode 100644 index 0000000..9fa514d --- /dev/null +++ b/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 + diff --git a/compiler/Elm/Internal/Name.hs b/compiler/Elm/Internal/Name.hs new file mode 100644 index 0000000..0ddd1f4 --- /dev/null +++ b/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." + ] \ No newline at end of file diff --git a/compiler/Elm/Internal/Paths.hs b/compiler/Elm/Internal/Paths.hs new file mode 100644 index 0000000..bfac751 --- /dev/null +++ b/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" diff --git a/compiler/Language/Elm.hs b/compiler/Elm/Internal/Utils.hs similarity index 60% rename from compiler/Language/Elm.hs rename to compiler/Elm/Internal/Utils.hs index 986516a..95fb6f3 100644 --- a/compiler/Language/Elm.hs +++ b/compiler/Elm/Internal/Utils.hs @@ -1,11 +1,6 @@ -{- | 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 - and many interactive examples are - available at +{- | This module exports functions for compiling Elm to JS. -} -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" diff --git a/compiler/Elm/Internal/Version.hs b/compiler/Elm/Internal/Version.hs new file mode 100644 index 0000000..de1e74b --- /dev/null +++ b/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."