on abd5880 help sign in
elk/src/Elm/Compiler/Module.hs
134 lines 2.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Compiler.Module
4 ( Module.Interface, Module.Interfaces, Module.privatize
5 , ModuleName.Raw
6 , nameToPath
7 , nameToString, nameFromText
8 , hyphenate, dehyphenate
9 , RawForJson(RawForJson), fromJson
10 , interfaceAliasedTypes, programTypes
11 , ModuleName.Canonical(..), qualifiedVar
12 )
13 where
15import qualified Data.Aeson as Json
16import qualified Data.Char as Char
17import qualified Data.List as List
18import qualified Data.Map as Map
19import qualified Data.Text as Text
20import Data.Text (Text)
21import System.FilePath ((</>))
23import qualified AST.Module as Module
24import qualified AST.Module.Name as ModuleName
25import qualified Elm.Compiler.Type as PublicType
26import qualified Elm.Compiler.Type.Extract as Extract
27import qualified Generate.JavaScript.Variable as Gen
31-- INTERFACES
34interfaceAliasedTypes :: Module.Interface -> Map.Map Text PublicType.Type
35interfaceAliasedTypes interface =
36 Map.map Extract.extract (Module.iTypes interface)
39programTypes :: Module.Interfaces -> ModuleName.Canonical -> Maybe PublicType.Program
40programTypes =
41 Extract.extractProgram
45-- NAMES
48newtype RawForJson = RawForJson ModuleName.Raw
51fromJson :: RawForJson -> ModuleName.Raw
52fromJson (RawForJson raw) =
53 raw
56qualifiedVar :: ModuleName.Canonical -> Text -> Text
57qualifiedVar =
58 Gen.qualified
62-- STRING CONVERSIONS for RAW NAMES
65nameToPath :: ModuleName.Raw -> FilePath
66nameToPath name =
67 List.foldl1 (</>) (map Text.unpack (Text.splitOn "." name))
70nameToString :: ModuleName.Raw -> String
71nameToString name =
72 Text.unpack name
75nameFromText :: Text -> Maybe ModuleName.Raw
76nameFromText =
77 fromText '.'
80hyphenate :: ModuleName.Raw -> Text
81hyphenate name =
82 Text.replace "." "-" name
85dehyphenate :: Text -> Maybe ModuleName.Raw
86dehyphenate =
87 fromText '-'
90fromText :: Char -> Text -> Maybe ModuleName.Raw
91fromText sep name =
92 let
93 chunks =
94 Text.splitOn (Text.singleton sep) name
95 in
96 if all isGoodChunk chunks then Just name else Nothing
99isGoodChunk :: Text -> Bool
100isGoodChunk chunk =
101 case Text.uncons chunk of
102 Nothing ->
103 False
105 Just (first, rest) ->
106 Char.isUpper first && Text.all isGoodChar rest
109isGoodChar :: Char -> Bool
110isGoodChar char =
111 Char.isAlphaNum char || char == '_'
115-- JSON for NAME
118instance Json.ToJSON RawForJson where
119 toJSON (RawForJson name) =
120 Json.toJSON (nameToString name)
123instance Json.FromJSON RawForJson where
124 parseJSON (Json.String text) =
125 case nameFromText text of
126 Nothing ->
127 fail (Text.unpack text ++ " is not a valid module name")
129 Just name ->
130 return (RawForJson name)
132 parseJSON _ =
133 fail "expecting the module name to be a string"