git.iko.soy/elk
on 9fc0613 help sign in
elk/compiler/src/Elm/ModuleName.hs
279 lines 4.8 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Elm.ModuleName
3 ( Raw
4 , nameToString
5 , nameToSlashPath
6 , nameToHyphenPath
7 , fromHyphenPath
8 , encode
9 , decoder
10 , Canonical(..)
11 , canonicalIsKernel
12 , basics, char, string
13 , maybe, result, list, array, dict, tuple
14 , platform, cmd, sub
15 , debug, bitwise
16 , virtualDom
17 , jsonDecode, jsonEncode
18 , webgl, texture, vector2, vector3, vector4, matrix4
19 )
20 where
23import Control.Monad (liftM2)
24import Data.Binary (Binary(..))
25import qualified Data.Char as Char
26import qualified Data.Name as Name
27import qualified Data.Text as Text
28import Prelude hiding (maybe)
29import qualified System.FilePath as FP
31import qualified Elm.Package as Pkg
32import qualified Json.Decode as Decode
33import qualified Json.Encode as Encode
37-- RAW
40type Raw = Name.Name
43nameToString :: Raw -> String
44nameToString =
45 Name.toString
48nameToSlashPath :: Raw -> FilePath
49nameToSlashPath name =
50 map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toString name)
53nameToHyphenPath :: Raw -> FilePath
54nameToHyphenPath name =
55 map (\c -> if c == '.' then '-' else c) (Name.toString name)
58fromHyphenPath :: Text.Text -> Maybe Raw
59fromHyphenPath txt =
60 let str = Text.unpack txt in
61 if all isGoodChunk (splitOn '-' str)
62 then Just (Name.fromString (map (\c -> if c == '-' then '.' else c) str))
63 else Nothing
67-- JSON
70encode :: Raw -> Encode.Value
71encode =
72 Encode.name
75decoder :: Decode.Decoder Text.Text Raw
76decoder =
77 do txt <- Decode.text
78 let str = Text.unpack txt
79 if all isGoodChunk (splitOn '.' str)
80 then Decode.succeed (Name.fromString str)
81 else Decode.fail txt
84isGoodChunk :: String -> Bool
85isGoodChunk chunk =
86 case chunk of
87 [] ->
88 False
90 first : rest ->
91 Char.isUpper first && all isGoodChar rest
94isGoodChar :: Char -> Bool
95isGoodChar c =
96 Char.isAlphaNum c || c == '_'
99splitOn :: Char -> String -> [String]
100splitOn sep str =
101 uncurry (:) (splitOnHelp sep str)
104splitOnHelp :: Char -> String -> (String, [String])
105splitOnHelp sep str =
106 case str of
107 [] ->
108 ("",[])
110 c : rest ->
111 let
112 (chunk,chunks) = splitOnHelp sep rest
113 in
114 if c == sep then
115 ("", chunk:chunks)
116 else
117 (c:chunk, chunks)
121-- CANONICAL
124data Canonical =
125 Canonical
126 { _package :: !Pkg.Name
127 , _module :: !Name.Name
128 }
129 deriving (Ord)
132canonicalIsKernel :: Canonical -> Bool
133canonicalIsKernel (Canonical _ name) =
134 Name.isKernel name
138-- INSTANCES
141instance Eq Canonical where
142 (==) (Canonical pkg1 name1) (Canonical pkg2 name2) =
143 name1 == name2 && pkg1 == pkg2
146instance Binary Canonical where
147 put (Canonical a b) = put a >> put b
148 get = liftM2 Canonical get get
152-- CORE
155{-# NOINLINE basics #-}
156basics :: Canonical
157basics = Canonical Pkg.core Name.basics
160{-# NOINLINE char #-}
161char :: Canonical
162char = Canonical Pkg.core Name.char
165{-# NOINLINE string #-}
166string :: Canonical
167string = Canonical Pkg.core Name.string
170{-# NOINLINE maybe #-}
171maybe :: Canonical
172maybe = Canonical Pkg.core Name.maybe
175{-# NOINLINE result #-}
176result :: Canonical
177result = Canonical Pkg.core Name.result
180{-# NOINLINE list #-}
181list :: Canonical
182list = Canonical Pkg.core Name.list
185{-# NOINLINE array #-}
186array :: Canonical
187array = Canonical Pkg.core Name.array
190{-# NOINLINE dict #-}
191dict :: Canonical
192dict = Canonical Pkg.core Name.dict
195{-# NOINLINE tuple #-}
196tuple :: Canonical
197tuple = Canonical Pkg.core Name.tuple
200{-# NOINLINE platform #-}
201platform :: Canonical
202platform = Canonical Pkg.core Name.platform
205{-# NOINLINE cmd #-}
206cmd :: Canonical
207cmd = Canonical Pkg.core "Platform.Cmd"
210{-# NOINLINE sub #-}
211sub :: Canonical
212sub = Canonical Pkg.core "Platform.Sub"
215{-# NOINLINE debug #-}
216debug :: Canonical
217debug = Canonical Pkg.core Name.debug
220{-# NOINLINE bitwise #-}
221bitwise :: Canonical
222bitwise = Canonical Pkg.core Name.bitwise
226-- HTML
229{-# NOINLINE virtualDom #-}
230virtualDom :: Canonical
231virtualDom = Canonical Pkg.virtualDom Name.virtualDom
235-- JSON
238{-# NOINLINE jsonDecode #-}
239jsonDecode :: Canonical
240jsonDecode = Canonical Pkg.json "Json.Decode"
243{-# NOINLINE jsonEncode #-}
244jsonEncode :: Canonical
245jsonEncode = Canonical Pkg.json "Json.Encode"
249-- WEBGL
252{-# NOINLINE webgl #-}
253webgl :: Canonical
254webgl = Canonical Pkg.webgl "WebGL"
257{-# NOINLINE texture #-}
258texture :: Canonical
259texture = Canonical Pkg.webgl "WebGL.Texture"
262{-# NOINLINE vector2 #-}
263vector2 :: Canonical
264vector2 = Canonical Pkg.linearAlgebra "Math.Vector2"
267{-# NOINLINE vector3 #-}
268vector3 :: Canonical
269vector3 = Canonical Pkg.linearAlgebra "Math.Vector3"
272{-# NOINLINE vector4 #-}
273vector4 :: Canonical
274vector4 = Canonical Pkg.linearAlgebra "Math.Vector4"
277{-# NOINLINE matrix4 #-}
278matrix4 :: Canonical
279matrix4 = Canonical Pkg.linearAlgebra "Math.Matrix4"