on 6aa43d7 help sign in
elk/src/Elm/Compiler/Module.hs
128 lines 2.7 kB history raw
1module Elm.Compiler.Module
2 ( Interface, Interfaces, Name(Name)
3 , nameToPath
4 , nameToString, nameFromString
5 , hyphenate, dehyphenate
6 , defaultImports
7 , interfacePorts
8 , interfaceAliasedTypes
9 , ModuleName.Canonical(..)
10 )
11 where
13import Control.Monad (mzero)
14import qualified Data.Aeson as Json
15import Data.Binary
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 System.FilePath ((</>))
22import qualified AST.Module as Module
23import qualified AST.Module.Name as ModuleName
24import qualified Elm.Compiler.Imports as Imports
25import qualified Elm.Compiler.Type as Type
26import qualified Elm.Compiler.Type.Extract as Extract
29-- EXPOSED TYPES
31type Interface = Module.Interface
34type Interfaces = Module.Interfaces
37newtype Name = Name ModuleName.Raw
38 deriving (Eq, Ord)
41defaultImports :: [Name]
42defaultImports =
43 map (Name . fst) Imports.defaults
46-- POKING AROUND INTERFACES
48interfacePorts :: Interface -> [String]
49interfacePorts interface =
50 Module.iPorts interface
53interfaceAliasedTypes :: Interface -> Map.Map String Type.Type
54interfaceAliasedTypes interface =
55 Map.map Extract.toAliasedType (Module.iTypes interface)
58-- STRING CONVERSIONS for NAMES
60nameToPath :: Name -> FilePath
61nameToPath (Name names) =
62 List.foldl1 (</>) names
65nameToString :: Name -> String
66nameToString (Name names) =
67 List.intercalate "." names
70nameFromString :: String -> Maybe Name
71nameFromString =
72 fromString '.'
75hyphenate :: Name -> String
76hyphenate (Name names) =
77 List.intercalate "-" names
80dehyphenate :: String -> Maybe Name
81dehyphenate =
82 fromString '-'
85fromString :: Char -> String -> Maybe Name
86fromString sep raw =
87 Name `fmap` mapM isLegit names
88 where
89 names =
90 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
92 isLegit name =
93 case name of
94 [] -> Nothing
95 char:rest ->
96 if Char.isUpper char && all legitChar rest
97 then Just name
98 else Nothing
100 legitChar char =
101 Char.isAlphaNum char || char `elem` "_'"
104-- JSON for NAME
106instance Json.ToJSON Name where
107 toJSON name =
108 Json.toJSON (nameToString name)
111instance Json.FromJSON Name where
112 parseJSON (Json.String text) =
113 let rawName = Text.unpack text in
114 case nameFromString rawName of
115 Nothing -> fail (rawName ++ " is not a valid module name")
116 Just name -> return name
118 parseJSON _ = mzero
121-- BINARY for NAME
123instance Binary Name where
124 get =
125 fmap Name get
127 put (Name names) =
128 put names