on 2fbfb20 help sign in
elk/src/Elm/Compiler/Module.hs
112 lines 2.4 kB history raw
1module Elm.Compiler.Module
2 ( Interface, Name(Name)
3 , nameToPath
4 , nameToString, nameFromString
5 , hyphenate, dehyphenate
6 , defaultImports
7 , interfacePorts
8 , interfaceTypes
9 )
10 where
12import Control.Monad (mzero)
13import qualified Data.Aeson as Json
14import qualified Data.Char as Char
15import qualified Data.List as List
16import qualified Data.Map as Map
17import qualified Data.Text as Text
18import System.FilePath ((</>))
20import qualified AST.Module as Module
21import qualified Elm.Compiler.Imports as Imports
22import qualified Elm.Compiler.Type as Type
23import qualified Elm.Compiler.Type.Extract as Extract
26-- EXPOSED TYPES
28type Interface = Module.Interface
31newtype Name = Name [String]
32 deriving (Eq, Ord)
35defaultImports :: [Name]
36defaultImports =
37 map (Name . fst) Imports.defaults
40-- POKING AROUND INTERFACES
42interfacePorts :: Interface -> [String]
43interfacePorts interface =
44 Module.iPorts interface
47interfaceTypes :: Interface -> Map.Map String Type.Type
48interfaceTypes interface =
49 Map.map Extract.fromInternalType (Module.iTypes interface)
52-- STRING CONVERSIONS for NAMES
54nameToPath :: Name -> FilePath
55nameToPath (Name names) =
56 List.foldl1 (</>) names
59nameToString :: Name -> String
60nameToString (Name names) =
61 List.intercalate "." names
64nameFromString :: String -> Maybe Name
65nameFromString =
66 fromString '.'
69hyphenate :: Name -> String
70hyphenate (Name names) =
71 List.intercalate "-" names
74dehyphenate :: String -> Maybe Name
75dehyphenate =
76 fromString '-'
79fromString :: Char -> String -> Maybe Name
80fromString sep raw =
81 Name `fmap` mapM isLegit names
82 where
83 names =
84 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
86 isLegit name =
87 case name of
88 [] -> Nothing
89 char:rest ->
90 if Char.isUpper char && all legitChar rest
91 then Just name
92 else Nothing
94 legitChar char =
95 Char.isAlphaNum char || char `elem` "_'"
98-- JSON for NAME
100instance Json.ToJSON Name where
101 toJSON name =
102 Json.toJSON (nameToString name)
105instance Json.FromJSON Name where
106 parseJSON (Json.String text) =
107 let rawName = Text.unpack text in
108 case nameFromString rawName of
109 Nothing -> fail (rawName ++ " is not a valid module name")
110 Just name -> return name
112 parseJSON _ = mzero