git.iko.soy/elk
on master help sign in
Split out Elm.Compiler.Module for module names
811e7adEvan Czaplicki
compiler/Elm/Compiler.hs+10−27
compare with master
unifiedsplit
@@ -1,13 +1,13 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3−module Elm.Compiler (version, ModuleName, moduleNameToPath, moduleNameToString, parseDependencies, elmToJs) where
3+module Elm.Compiler (version, parseDependencies, elmToJs) where
4
4
5import Control.Monad.Error (MonadError, MonadIO, liftIO, throwError)
5import Control.Monad.Error (MonadError, MonadIO, liftIO, throwError)
6import qualified Data.List as List
6import qualified Data.List as List
7−import System.FilePath ((</>))
8import System.IO.Unsafe (unsafePerformIO)
7import System.IO.Unsafe (unsafePerformIO)
9
8
10−import qualified AST.Module as Module
9+import qualified AST.Module as Module (HeaderAndImports(HeaderAndImports), Interfaces)
10+import qualified Elm.Compiler.Module as Module
11import qualified Elm.Compiler.Version as Version
11import qualified Elm.Compiler.Version as Version
12import qualified Metadata.Prelude as Prelude
12import qualified Metadata.Prelude as Prelude
13import qualified Parse.Helpers as Help
13import qualified Parse.Helpers as Help
@@ -21,33 +21,16 @@ version =
21 Version.version
21 Version.version
22
22
23
23
24−-- MODULE NAMES
25−
26−newtype ModuleName =
27− ModuleName [String]
28−
29−
30−moduleNameToPath :: ModuleName -> FilePath
31−moduleNameToPath (ModuleName names) =
32− List.foldl1 (</>) names
33−
34−
35−moduleNameToString :: ModuleName -> String
36−moduleNameToString (ModuleName names) =
37− List.intercalate "." names
38−
39−
40-- DEPENDENCIES
24-- DEPENDENCIES
41
25
42−parseDependencies :: (MonadIO m, MonadError String m) => FilePath -> m (ModuleName, [ModuleName])
26+parseDependencies :: (MonadError String m) => String -> m (Module.Name, [Module.Name])
43−parseDependencies filePath =
27+parseDependencies src =
44− do src <- liftIO (readFile filePath)
45− case Help.iParse Parse.headerAndImports src of
28+ case Help.iParse Parse.headerAndImports src of
46− Left msg ->
29+ Left msg ->
47− throwError (show msg)
30+ throwError (show msg)
48
31
49− Right (Module.HeaderAndImports names _exports imports) ->
32+ Right (Module.HeaderAndImports names _exports imports) ->
50− return ( ModuleName names, map (ModuleName . fst) imports )
33+ return ( Module.Name names, map (Module.Name . fst) imports )
51
34
52
35
53-- COMPILATION
36-- COMPILATION
compiler/Elm/Compiler/Module.hsnew file+57
@@ -0,0 +1,57 @@
1+module Elm.Compiler.Module (Name(Name), nameToPath, nameToString, nameFromString) where
2+
3+import Control.Monad (mzero)
4+import qualified Data.Aeson as Json
5+import qualified Data.Char as Char
6+import qualified Data.List as List
7+import qualified Data.Text as Text
8+import System.FilePath ((</>))
9+import qualified AST.Module as Module
10+
11+
12+newtype Name = Name [String]
13+ deriving (Eq, Ord)
14+
15+
16+nameToPath :: Name -> FilePath
17+nameToPath (Name names) =
18+ List.foldl1 (</>) names
19+
20+
21+nameToString :: Name -> String
22+nameToString (Name names) =
23+ List.intercalate "." names
24+
25+
26+nameFromString :: String -> Maybe Name
27+nameFromString raw =
28+ Name `fmap` mapM isLegit names
29+ where
30+ names =
31+ filter (/= ".") (List.groupBy (\a b -> a /= '.' && b /= '.') raw)
32+
33+ isLegit name =
34+ case name of
35+ [] -> Nothing
36+ char:rest ->
37+ if Char.isUpper char && all legitChar rest
38+ then Just name
39+ else Nothing
40+
41+ legitChar char =
42+ Char.isAlphaNum char || char `elem` "_'"
43+
44+
45+instance Json.ToJSON Name where
46+ toJSON name =
47+ Json.toJSON (nameToString name)
48+
49+
50+instance Json.FromJSON Name where
51+ parseJSON (Json.String text) =
52+ let rawName = Text.unpack text in
53+ case nameFromString rawName of
54+ Nothing -> fail (rawName ++ " is not a valid module name")
55+ Just name -> return name
56+
57+ parseJSON _ = mzero