git.iko.soy/elk
on 85ebd9c help sign in
elk/src/Elm/Compiler/Module.hs
151 lines 3.3 kB history raw
1module Elm.Compiler.Module
2 ( Interface, Name(Name), name
3 , CanonicalName(CanonicalName), canonicalName, canonPkg, canonModul
4 , fromCanonicalName, canonFromPackage
5 , nameToPath
6 , nameToString, nameFromString
7 , hyphenate, dehyphenate
8 , defaultImports
9 , interfacePorts
10 , interfaceAliasedTypes
11 )
12 where
14import Control.Monad (mzero)
15import qualified Data.Aeson as Json
16import Data.Binary
17import qualified Data.Char as Char
18import qualified Data.List as List
19import qualified Data.Map as Map
20import qualified Data.Text as Text
21import System.FilePath ((</>))
23import qualified AST.Module as Module
24import qualified Elm.Compiler.Imports as Imports
25import qualified Elm.Compiler.Type as Type
26import qualified Elm.Compiler.Type.Extract as Extract
27import qualified Elm.Package as Package
30-- EXPOSED TYPES
32type Interface = Module.Interface
35newtype Name = Name [String]
36 deriving (Eq, Ord)
38data CanonicalName =
39 CanonicalName
40 { canonPkg :: Package.Name
41 , canonVersion :: Package.Version
42 , canonModul :: Name
43 } deriving (Eq, Ord)
46canonFromPackage :: Package.Package -> Name -> CanonicalName
47canonFromPackage (pk, vr) nm =
48 CanonicalName pk vr nm
51fromCanonicalName :: CanonicalName -> Module.CanonicalName
52fromCanonicalName (CanonicalName p _ (Name n)) =
53 Module.CanonicalName p n
56canonicalName :: Package.Name -> Package.Version -> Name -> CanonicalName
57canonicalName = CanonicalName
60name :: [String] -> Name
61name = Name
64defaultImports :: [Name]
65defaultImports =
66 map (Name . fst) Imports.defaults
69-- POKING AROUND INTERFACES
71interfacePorts :: Interface -> [String]
72interfacePorts interface =
73 Module.iPorts interface
76interfaceAliasedTypes :: Interface -> Map.Map String Type.Type
77interfaceAliasedTypes interface =
78 Map.map Extract.toAliasedType (Module.iTypes interface)
81-- STRING CONVERSIONS for NAMES
83nameToPath :: Name -> FilePath
84nameToPath (Name names) =
85 List.foldl1 (</>) names
88nameToString :: Name -> String
89nameToString (Name names) =
90 List.intercalate "." names
93nameFromString :: String -> Maybe Name
94nameFromString =
95 fromString '.'
98hyphenate :: Name -> String
99hyphenate (Name names) =
100 List.intercalate "-" names
103dehyphenate :: String -> Maybe Name
104dehyphenate =
105 fromString '-'
108fromString :: Char -> String -> Maybe Name
109fromString sep raw =
110 Name `fmap` mapM isLegit names
111 where
112 names =
113 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
115 isLegit name =
116 case name of
117 [] -> Nothing
118 char:rest ->
119 if Char.isUpper char && all legitChar rest
120 then Just name
121 else Nothing
123 legitChar char =
124 Char.isAlphaNum char || char `elem` "_'"
127-- JSON for NAME
129instance Json.ToJSON Name where
130 toJSON name =
131 Json.toJSON (nameToString name)
134instance Json.FromJSON Name where
135 parseJSON (Json.String text) =
136 let rawName = Text.unpack text in
137 case nameFromString rawName of
138 Nothing -> fail (rawName ++ " is not a valid module name")
139 Just name -> return name
141 parseJSON _ = mzero
144-- BINARY for NAME
146instance Binary Name where
147 get =
148 fmap Name get
150 put (Name names) =
151 put names