git.iko.soy/elk
on 396fd33 help sign in
elk/src/Elm/Compiler/Module.hs
100 lines 2.1 kB history raw
1module Elm.Compiler.Module
2 ( Interface, Name(Name)
3 , nameToPath
4 , nameToString, nameFromString
5 , hyphenate, dehyphenate
6 , defaultImports
7 , interfacePorts
8 )
9 where
11import Control.Monad (mzero)
12import qualified Data.Aeson as Json
13import qualified Data.Char as Char
14import qualified Data.List as List
15import qualified Data.Map as Map
16import qualified Data.Text as Text
17import System.FilePath ((</>))
19import qualified AST.Module as Module
20import qualified Transform.AddDefaultImports as Defaults
23type Interface = Module.Interface
26newtype Name = Name [String]
27 deriving (Eq, Ord)
30defaultImports :: [Name]
31defaultImports =
32 map Name (Map.keys Defaults.defaultImports)
35interfacePorts :: Interface -> [String]
36interfacePorts interface =
37 Module.iPorts interface
40-- STRING CONVERSIONS
42nameToPath :: Name -> FilePath
43nameToPath (Name names) =
44 List.foldl1 (</>) names
47nameToString :: Name -> String
48nameToString (Name names) =
49 List.intercalate "." names
52nameFromString :: String -> Maybe Name
53nameFromString =
54 fromString '.'
57hyphenate :: Name -> String
58hyphenate (Name names) =
59 List.intercalate "-" names
62dehyphenate :: String -> Maybe Name
63dehyphenate =
64 fromString '-'
67fromString :: Char -> String -> Maybe Name
68fromString sep raw =
69 Name `fmap` mapM isLegit names
70 where
71 names =
72 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
74 isLegit name =
75 case name of
76 [] -> Nothing
77 char:rest ->
78 if Char.isUpper char && all legitChar rest
79 then Just name
80 else Nothing
82 legitChar char =
83 Char.isAlphaNum char || char `elem` "_'"
86-- JSON CONVERSIONS
88instance Json.ToJSON Name where
89 toJSON name =
90 Json.toJSON (nameToString name)
93instance Json.FromJSON Name where
94 parseJSON (Json.String text) =
95 let rawName = Text.unpack text in
96 case nameFromString rawName of
97 Nothing -> fail (rawName ++ " is not a valid module name")
98 Just name -> return name
100 parseJSON _ = mzero