b359fd0 · elk · git.iko.soy

Elm.cabal+1−3

compare with master

unifiedsplit

@@ -145,9 +145,7 @@ Executable elm-doc

145 Context,

146 Parse.Library,

147 Parse.Modules,

148− Parse.Types,

149− Rename,

148+ Rename

150− Types.Types

151

149

152 Build-depends: base >=4.2 && <5,

150 Build-depends: base >=4.2 && <5,

153 containers >= 0.3,

151 containers >= 0.3,

Setup.hs+2−5

@@ -141,9 +141,9 @@ runElm lbi file = do

141 out_c <- canonicalizePath js -- dist/js (root folder)

142 elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm

143 rtd_c <- canonicalizePath (rtsDir lbi) -- dist/data (for docs.json)

144− handle <- runProcess elm_c ["--only-js", "--no-prelude", "--runtime="++rts_c, "--output-directory="++out_c, file]

144+ handle <- runProcess elm_c ["--only-js", "--no-prelude", "--output-directory="++out_c, file]

145 Nothing (Just [("Elm_datadir", rtd_c)]) Nothing Nothing Nothing

146− waitForProcess handle

146+ exitCode <- waitForProcess handle

147 return $ j </> replaceExtension (takeFileName file) ".js"

148

149

@@ -154,6 +154,3 @@ buildRuntime lbi = do

154 mapM_ (appendJS lbi) =<< getFiles ".js" "libraries"

155 mapM_ (appendElm lbi) =<< getFiles ".elm" "libraries"

156 mapM_ (appendJS lbi) =<< getFiles ".js" "runtime"

157− putStrLn "\n+------------------------------------------+\

158− \\n| Success building runtime and libraries! |\

159− \\n+------------------------------------------+\n"

compiler/Docs.hs+25−24

@@ -4,13 +4,12 @@ module Main where

4import Ast

5import Control.Applicative ((<$>), (<*>))

6import Data.List (intercalate)

7+import Data.Maybe (catMaybes)

7import Parse.Library

8import Parse.Library

8import Parse.Modules (moduleDef)

9import Parse.Modules (moduleDef)

9−import Parse.Types (typeAnnotation)

10import Text.Parsec hiding (newline,spaces)

11import System.Environment

12import System.Exit

13−import Types.Types

14

13

15

14

16main = do

15main = do

@@ -29,32 +28,34 @@ toModule (name, values) =

29

28

30toValue (name, tipe, desc) =

29toValue (name, tipe, desc) =

31 "{ \"name\" : " ++ show name ++

30 "{ \"name\" : " ++ show name ++

32− ",\n \"type\" : \"" ++ show tipe ++

31+ ",\n \"type\" : " ++ show tipe ++

33− "\",\n \"desc\" : " ++ show desc ++ "\n }"

32+ ",\n \"desc\" : " ++ show desc ++ "\n }"

34

33

35−docParse :: String -> Either String (String, [(String, Type, String)])

34+docParse :: String -> Either String (String, [(String, String, String)])

36docParse = setupParser $ do

35docParse = setupParser $ do

37− optional freshLine

36+ optional freshLine

38− (,) <$> option "Main" moduleName <*> types

37+ (names, exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)

38+ info <- many (docs exports <|> try skip <|> end)

39+ return (intercalate "." names, catMaybes info)

39 where

40 where

40− skip = manyTill anyChar simpleNewline >> return []

41+ skip = manyTill anyChar simpleNewline >> return Nothing

41− end = many1 anyChar >> return []

42+ end = many1 anyChar >> return Nothing

42− types = concat <$> many (docs <|> try skip <|> end)

43+

43− getName = intercalate "." . fst

44− moduleName = do optional freshLine

45− getName <$> moduleDef `followedBy` freshLine

46−

47−docs :: IParser [(String, Type, String)]

44+docs :: [String] -> IParser (Maybe (String, String, String))

48−docs = (tipe <$> try typeAnnotation) <|> commentTipe

45+docs exports = export <$> try annotation

49 where

46 where

50− clip str = case str of { ' ':rest -> rest ; _ -> str }

47+ tipe comment = tuple <$> name <*> tipe

51− tipe stmt = case stmt of { TypeAnnotation n t -> [(n,t,"")] ; _ -> [] }

48+ where name = do v <- lowVar <|> parens symOp

52− commentTipe = do

49+ whitespace ; hasType ; whitespace ; return v

50+ tipe = manyTill anyChar (try (freshLine >> notFollowedBy (string " ")))

51+ tuple n t = (n,t,comment)

52+

53− cs <- map clip <$> many1 lineComment

53+ annotation = tipe =<< option "" (concatMap clip <$> many1 lineComment)

54− typ <- optionMaybe (try typeAnnotation)

54+ where clip str = case str of { ' ':rest -> rest ; _ -> str } ++ "\n"

55− return $ case typ of

55+

56− Just (TypeAnnotation n t) -> [(n, t, intercalate "\n" cs)]

56+ export info@(name,_,_) =

57− _ -> []

57+ if null exports || name `elem` exports then Just info else Nothing

58+

58

59

60

60setupParser p source =

61setupParser p source =

compiler/Model/LoadLibraries.hs+8−10

@@ -15,22 +15,20 @@ import System.IO.Unsafe (unsafePerformIO)

15

16{-# NOINLINE docs #-}

17docs :: String

18−docs = force . unsafePerformIO . safeReadDocs . getDataFileName $ "docs.json"

18+docs = force $ unsafePerformIO (safeReadDocs =<< getDataFileName "docs.json")

19

20−safeReadDocs :: IO FilePath -> IO String

20+safeReadDocs :: FilePath -> IO String

21−safeReadDocs path = E.catch (readDocs path) (emitError path)

21+safeReadDocs name = E.catch (readDocs name) (emitError name)

22

23−readDocs :: IO FilePath -> IO String

23+readDocs :: FilePath -> IO String

24−readDocs path = do

24+readDocs name = do

25− name <- path

26 exists <- doesFileExist name

25 exists <- doesFileExist name

27 if exists then readFile name

26 if exists then readFile name

28 else ioError . userError $ "File Not Found"

27 else ioError . userError $ "File Not Found"

29

28

30

29

31−emitError :: IO FilePath -> IOError -> IO String

30+emitError :: FilePath -> IOError -> IO String

32−emitError path err = do

31+emitError name err = do

33− name <- path

34− putStrLn $ "Error! Types for standard library not loaded properly!\n File should be here:" ++ name ++ "\n The file is created and copied by command: cabal install"

32+ putStrLn $ "Error! Types for standard library not loaded properly!\n File should be here:" ++ name ++ "\n The file is created and copied by command: cabal install"

35 putStrLn (show err)

33 putStrLn (show err)

36 return "{\"modules\":[]}"

34 return "{\"modules\":[]}"

compiler/Types/Hints.hs+5−4

@@ -20,7 +20,8 @@ hints = mapM toScheme values

20

21 toScheme :: (String, String) -> GuidCounter (String, Scheme)

22 toScheme (name, tipeString) =

23+ let err = "in docs.json parsing type: " ++ tipeString in

23− case iParse (fmap toType typeExpr) "parsing types in docs.json" tipeString of

24+ case iParse (fmap toType typeExpr) err tipeString of

24− Left err -> error (show err)

25+ Left err -> error (show err)

25− Right tipe -> do scheme <- Subs.generalize [] =<< Subs.superize name tipe

26+ Right tipe -> do scheme <- Subs.generalize [] =<< Subs.superize name tipe

26− return (name, scheme)

27+ return (name, scheme)

libraries/Dict.elm+1−2

@@ -375,8 +375,7 @@ union t1 t2 = foldl insert t2 t1

375

376-- Keep a key-value pair when its key appears in the second dictionary.

377-- Preference is given to values in the first dictionary.

378−intersect : Dict (Comparable k) v

379− -> Dict (Comparable k) v -> Dict (Comparable k) v

378+intersect : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v

380intersect t1 t2 =

379intersect t1 t2 =

381 let combine k v t = if k `member` t2 then insert k v t else t

380 let combine k v t = if k `member` t2 then insert k v t else t

382 in foldl combine empty t1

381 in foldl combine empty t1