09301c6 · elk · git.iko.soy

elm-compiler.cabal+3−1

@@ -44,11 +44,11 @@ Library

4444 exposed-modules:

4545 Elm.Compiler,

4646 Elm.Compiler.Module,

47+ Elm.Compiler.Type,

4748 Elm.Docs,

4849 Elm.Utils

4950

5051 other-modules:

51− Elm.Compiler.Version,

5252 AST.Annotation,

5353 AST.Declaration,

5454 AST.Expression.General,

@@ -63,6 +63,8 @@ Library

6363 AST.Type,

6464 AST.Variable,

6565 Compile,

66+ Elm.Compiler.Type.Extract,

67+ Elm.Compiler.Version,

6668 Generate.JavaScript,

6769 Generate.JavaScript.Helpers,

6870 Generate.JavaScript.Ports,

src/Docs.hs+4−31

@@ -13,10 +13,8 @@ import qualified Data.Aeson.Encode.Pretty as Json

1313import qualified Data.Map as Map

1414import qualified Data.ByteString.Lazy.Char8 as BS

1515

16−import qualified AST.Type as Type

1716import qualified AST.Declaration as Decl

1817import qualified AST.Expression.Source as Source

19−import qualified AST.Variable as Var

2018

2119import Text.Parsec hiding (newline, spaces)

2220import qualified Parse.Declaration as Parse (typeDecl, infixDecl)

@@ -24,6 +22,7 @@ import qualified Parse.Expression as Parse (typeAnnotation)

2422import qualified Parse.Helpers as Parse

2523import qualified Parse.Module as Parse (header)

2624import qualified Elm.Compiler.Module as Module

25+import qualified Elm.Compiler.Type.Extract as Type

2726import qualified Elm.Docs as Docs

2827

2928

@@ -172,18 +171,18 @@ collectInfo (comment, decl) info =

172171 case def of

173172 Source.Definition _ _ -> error errorMessage

174173 Source.TypeAnnotation name tipe ->

175− let value = Docs.Value name comment (toDocType tipe) Nothing

174+ let value = Docs.Value name comment (Type.fromInternalType tipe) Nothing

176175 in

177176 info { values = Map.insert name value (values info) }

178177

179178 Decl.Datatype name args cases ->

180− let cases' = map (second (map toDocType)) cases

179+ let cases' = map (second (map Type.fromInternalType)) cases

181180 union = Docs.Union name comment args cases'

182181 in

183182 info { unions = union : unions info }

184183

185184 Decl.TypeAlias name args tipe ->

186− let alias = Docs.Alias name comment args (toDocType tipe)

185+ let alias = Docs.Alias name comment args (Type.fromInternalType tipe)

187186 in

188187 info { aliases = alias : aliases info }

189188

@@ -201,29 +200,3 @@ errorMessage =

201200 "there appears to be a bug in this tool.\n" ++

202201 "Please report it to <https://github.com/elm-lang/Elm/issues>"

203202

204−

205−-- AST TYPE TO DOC TYPE

206−

207−toDocType :: Type.Type Var.Raw -> Docs.Type

208−toDocType astType =

209− case astType of

210− Type.Lambda t1 t2 ->

211− Docs.Lambda (toDocType t1) (toDocType t2)

212−

213− Type.Var x ->

214− Docs.Var x

215−

216− Type.Type (Var.Raw name) ->

217− Docs.Type name

218−

219− Type.App t ts ->

220− Docs.App (toDocType t) (map toDocType ts)

221−

222− Type.Record fields ext ->

223− Docs.Record (map (second toDocType) fields) (fmap toDocType ext)

224−

225− Type.Aliased _ t ->

226− toDocType t

227−

228−

229−

src/Elm/Compiler/Module.hs+15−3

@@ -5,6 +5,7 @@ module Elm.Compiler.Module

55 , hyphenate, dehyphenate

66 , defaultImports

77 , interfacePorts

8+ , interfaceTypes

89 )

910 where

1011

@@ -18,8 +19,12 @@ import System.FilePath ((</>))

1819

1920import qualified AST.Module as Module

2021import qualified Transform.AddDefaultImports as Defaults

22+import qualified Elm.Compiler.Type as Type

23+import qualified Elm.Compiler.Type.Extract as Extract

2124

2225

26+-- EXPOSED TYPES

27+

2328type Interface = Module.Interface

2429

2530

@@ -32,12 +37,19 @@ defaultImports =

3237 map Name (Map.keys Defaults.defaultImports)

3338

3439

40+-- POKING AROUND INTERFACES

41+

3542interfacePorts :: Interface -> [String]

3643interfacePorts interface =

3744 Module.iPorts interface

3845

3946

40−-- STRING CONVERSIONS

47+interfaceTypes :: Interface -> Map.Map String Type.Type

48+interfaceTypes interface =

49+ Map.map Extract.fromInternalType (Module.iTypes interface)

50+

51+

52+-- STRING CONVERSIONS for NAMES

4153

4254nameToPath :: Name -> FilePath

4355nameToPath (Name names) =

@@ -83,7 +95,7 @@ fromString sep raw =

8395 Char.isAlphaNum char || char `elem` "_'"

8496

8597

86−-- JSON CONVERSIONS

98+-- JSON for NAME

8799

88100instance Json.ToJSON Name where

89101 toJSON name =

@@ -97,4 +109,4 @@ instance Json.FromJSON Name where

97109 Nothing -> fail (rawName ++ " is not a valid module name")

98110 Just name -> return name

99111

100− parseJSON _ = mzero

112+ parseJSON _ = mzero

src/Elm/Compiler/Type.hsnew file+99

@@ -0,0 +1,99 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Elm.Compiler.Type

3+ ( Type(..)

4+ , toString

5+ ) where

6+

7+import Control.Applicative ((<$>), (<*>))

8+import Control.Arrow (second)

9+import Data.Aeson ((.:), (.:?), (.=))

10+import qualified Data.Aeson as Json

11+import qualified Data.ByteString.Lazy.Char8 as BS

12+import qualified Data.Text as Text

13+

14+import qualified AST.Type as Type

15+import qualified AST.Variable as Var

16+

17+

18+data Type

19+ = Lambda Type Type

20+ | Var String

21+ | Type String

22+ | App Type [Type]

23+ | Record [(String, Type)] (Maybe Type)

24+

25+

26+-- TO STRING

27+

28+toString :: Type -> String

29+toString tipe =

30+ case tipe of

31+ Lambda t t' -> undefined

32+ Var x -> undefined

33+ Type name -> undefined

34+ App t ts -> undefined

35+ Record fields maybeExtension -> undefined

36+

37+

38+-- JSON for TYPE

39+

40+instance Json.ToJSON Type where

41+ toJSON tipe =

42+ Json.object (getFields tipe)

43+ where

44+ getFields tipe =

45+ case tipe of

46+ Lambda t1 t2 ->

47+ [ "tag" .= ("lambda" :: Text.Text)

48+ , "in" .= Json.toJSON t1

49+ , "out" .= Json.toJSON t2

50+ ]

51+

52+ Var x ->

53+ [ "tag" .= ("var" :: Text.Text)

54+ , "name" .= Json.toJSON x

55+ ]

56+

57+ Type name ->

58+ [ "tag" .= ("type" :: Text.Text)

59+ , "name" .= Json.toJSON name

60+ ]

61+

62+ App t ts ->

63+ [ "tag" .= ("app" :: Text.Text)

64+ , "func" .= Json.toJSON t

65+ , "args" .= Json.toJSON ts

66+ ]

67+

68+ Record fields ext ->

69+ [ "tag" .= ("record" :: Text.Text)

70+ , "fields" .= Json.toJSON (map (Json.toJSON . second Json.toJSON) fields)

71+ , "extension" .= Json.toJSON ext

72+ ]

73+

74+

75+instance Json.FromJSON Type where

76+ parseJSON (Json.Object obj) =

77+ do tag <- obj .: "tag"

78+ case (tag :: String) of

79+ "lambda" ->

80+ Lambda <$> obj .: "in" <*> obj .: "out"

81+

82+ "var" ->

83+ Var <$> obj .: "name"

84+

85+ "type" ->

86+ Type <$> obj .: "name"

87+

88+ "app" ->

89+ App <$> obj .: "func" <*> obj .: "args"

90+

91+ "record" ->

92+ Record <$> obj .: "fields" <*> obj .: "extension"

93+

94+ _ ->

95+ fail $ "Error when decoding type with tag: " ++ tag

96+

97+

98+ parseJSON value =

99+ fail $ "Cannot decode Value from: " ++ BS.unpack (Json.encode value)

src/Elm/Compiler/Type/Extract.hsnew file+30

@@ -0,0 +1,30 @@

1+module Elm.Compiler.Type.Extract where

2+

3+import Control.Arrow (second)

4+import qualified AST.Type as Type

5+import qualified AST.Variable as Var

6+import qualified Elm.Compiler.Type as T

7+

8+

9+-- INTERNAL TYPE to PUBLIC TYPE

10+

11+fromInternalType :: Var.ToString a => Type.Type a -> T.Type

12+fromInternalType astType =

13+ case astType of

14+ Type.Lambda t1 t2 ->

15+ T.Lambda (fromInternalType t1) (fromInternalType t2)

16+

17+ Type.Var x ->

18+ T.Var x

19+

20+ Type.Type var ->

21+ T.Type (Var.toString var)

22+

23+ Type.App t ts ->

24+ T.App (fromInternalType t) (map fromInternalType ts)

25+

26+ Type.Record fields ext ->

27+ T.Record (map (second fromInternalType) fields) (fmap fromInternalType ext)

28+

29+ Type.Aliased _ t ->

30+ fromInternalType t

src/Elm/Docs.hs+4−73

@@ -10,6 +10,7 @@ import qualified Data.ByteString.Lazy.Char8 as BS

1010import qualified Data.Text as Text

1111

1212import qualified Elm.Compiler.Module as Module

13+import qualified Elm.Compiler.Type as Type

1314

1415

1516data Documentation = Documentation

@@ -25,7 +26,7 @@ data Alias = Alias

2526 { aliasName :: String

2627 , aliasComment :: String

2728 , aliasArgs :: [String]

28− , aliasType :: Type

29+ , aliasType :: Type.Type

2930 }

3031

3132

@@ -33,26 +34,18 @@ data Union = Union

3334 { unionName :: String

3435 , unionComment :: String

3536 , unionArgs :: [String]

36− , unionCases :: [(String, [Type])]

37+ , unionCases :: [(String, [Type.Type])]

3738 }

3839

3940

4041data Value = Value

4142 { valueName :: String

4243 , valueComment :: String

43− , valueType :: Type

44+ , valueType :: Type.Type

4445 , valueAssocPrec :: Maybe (String,Int)

4546 }

4647

4748

48−data Type

49− = Lambda Type Type

50− | Var String

51− | Type String

52− | App Type [Type]

53− | Record [(String, Type)] (Maybe Type)

54−

55−

5649-- JSON for DOCUMENTATION

5750

5851instance Json.ToJSON Documentation where

@@ -156,65 +149,3 @@ instance Json.FromJSON Value where

156149 parseJSON value =

157150 fail $ "Cannot decode Value from: " ++ BS.unpack (Json.encode value)

158151

159−

160−-- JSON for TYPE

161−

162−instance Json.ToJSON Type where

163− toJSON tipe =

164− Json.object (getFields tipe)

165− where

166− getFields tipe =

167− case tipe of

168− Lambda t1 t2 ->

169− [ "tag" .= ("lambda" :: Text.Text)

170− , "in" .= Json.toJSON t1

171− , "out" .= Json.toJSON t2

172− ]

173−

174− Var x ->

175− [ "tag" .= ("var" :: Text.Text)

176− , "name" .= Json.toJSON x

177− ]

178−

179− Type name ->

180− [ "tag" .= ("type" :: Text.Text)

181− , "name" .= Json.toJSON name

182− ]

183−

184− App t ts ->

185− [ "tag" .= ("app" :: Text.Text)

186− , "func" .= Json.toJSON t

187− , "args" .= Json.toJSON ts

188− ]

189−

190− Record fields ext ->

191− [ "tag" .= ("record" :: Text.Text)

192− , "fields" .= Json.toJSON (map (Json.toJSON . second Json.toJSON) fields)

193− , "extension" .= Json.toJSON ext

194− ]

195−

196−instance Json.FromJSON Type where

197− parseJSON (Json.Object obj) =

198− do tag <- obj .: "tag"

199− case (tag :: String) of

200− "lambda" ->

201− Lambda <$> obj .: "in" <*> obj .: "out"

202−

203− "var" ->

204− Var <$> obj .: "name"

205−

206− "type" ->

207− Type <$> obj .: "name"

208−

209− "app" ->

210− App <$> obj .: "func" <*> obj .: "args"

211−

212− "record" ->

213− Record <$> obj .: "fields" <*> obj .: "extension"

214−

215− _ ->

216− fail $ "Error when decoding type with tag: " ++ tag

217−

218−

219− parseJSON value =

220− fail $ "Cannot decode Value from: " ++ BS.unpack (Json.encode value)