@@ -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