git.iko.soy/elk
on 6285a63 help sign in
elk/src/Elm/Compiler/Module.hs
123 lines 2.6 kB history raw
1module Elm.Compiler.Module
2 ( Interface, Name(Name)
3 , nameToPath
4 , nameToString, nameFromString
5 , hyphenate, dehyphenate
6 , defaultImports
7 , interfacePorts
8 , interfaceAliasedTypes
9 )
10 where
12import Control.Monad (mzero)
13import qualified Data.Aeson as Json
14import Data.Binary
15import qualified Data.Char as Char
16import qualified Data.List as List
17import qualified Data.Map as Map
18import qualified Data.Text as Text
19import System.FilePath ((</>))
21import qualified AST.Module as Module
22import qualified Elm.Compiler.Imports as Imports
23import qualified Elm.Compiler.Type as Type
24import qualified Elm.Compiler.Type.Extract as Extract
27-- EXPOSED TYPES
29type Interface = Module.Interface
32newtype Name = Name [String]
33 deriving (Eq, Ord)
36defaultImports :: [Name]
37defaultImports =
38 map (Name . fst) Imports.defaults
41-- POKING AROUND INTERFACES
43interfacePorts :: Interface -> [String]
44interfacePorts interface =
45 Module.iPorts interface
48interfaceAliasedTypes :: Interface -> Map.Map String Type.Type
49interfaceAliasedTypes interface =
50 Map.map Extract.toAliasedType (Module.iTypes interface)
53-- STRING CONVERSIONS for NAMES
55nameToPath :: Name -> FilePath
56nameToPath (Name names) =
57 List.foldl1 (</>) names
60nameToString :: Name -> String
61nameToString (Name names) =
62 List.intercalate "." names
65nameFromString :: String -> Maybe Name
66nameFromString =
67 fromString '.'
70hyphenate :: Name -> String
71hyphenate (Name names) =
72 List.intercalate "-" names
75dehyphenate :: String -> Maybe Name
76dehyphenate =
77 fromString '-'
80fromString :: Char -> String -> Maybe Name
81fromString sep raw =
82 Name `fmap` mapM isLegit names
83 where
84 names =
85 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
87 isLegit name =
88 case name of
89 [] -> Nothing
90 char:rest ->
91 if Char.isUpper char && all legitChar rest
92 then Just name
93 else Nothing
95 legitChar char =
96 Char.isAlphaNum char || char `elem` "_'"
99-- JSON for NAME
101instance Json.ToJSON Name where
102 toJSON name =
103 Json.toJSON (nameToString name)
106instance Json.FromJSON Name where
107 parseJSON (Json.String text) =
108 let rawName = Text.unpack text in
109 case nameFromString rawName of
110 Nothing -> fail (rawName ++ " is not a valid module name")
111 Just name -> return name
113 parseJSON _ = mzero
116-- BINARY for NAME
118instance Binary Name where
119 get =
120 fmap Name get
122 put (Name names) =
123 put names