git.iko.soy/elk
on 253bb13 help sign in
elk/compiler/src/Elm/ModuleName.hs
257 lines 4.4 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Elm.ModuleName
3 ( Raw
4 , toChars
5 , toString
6 , toFilePath
7 , toHyphenPath
8 , fromHyphenPath
9 , encode
10 , decoder
11 , Canonical(..)
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.Utf8 as Utf8
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
43toChars :: Raw -> String
44toChars =
45 Name.toChars
48toString :: Raw -> Utf8.String
49toString =
50 Name.toUtf8
53toFilePath :: Raw -> FilePath
54toFilePath name =
55 map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toChars name)
58toHyphenPath :: Raw -> FilePath
59toHyphenPath name =
60 map (\c -> if c == '.' then '-' else c) (Name.toChars name)
63fromHyphenPath :: Utf8.String -> Maybe Raw
64fromHyphenPath str =
65 let
66 chunks =
67 Utf8.split 0x2D {- - -} str
68 in
69 if all isGoodChunk chunks
70 then Just (Name.fromUtf8 (Utf8.join 0x2E {- . -} chunks))
71 else Nothing
75-- JSON
78encode :: Raw -> Encode.Value
79encode =
80 Encode.name
83decoder :: Decode.Decoder Utf8.String Raw
84decoder =
85 do str <- Decode.string
86 if all isGoodChunk (Utf8.split 0x2E {- . -} str)
87 then return (Name.fromUtf8 str)
88 else Decode.failure str
91isGoodChunk :: Utf8.String -> Bool
92isGoodChunk chunk =
93 Utf8.startsWithChar Char.isUpper chunk
94 && Utf8.all (\c -> Char.isAlphaNum c || c == '_') chunk
98-- CANONICAL
101data Canonical =
102 Canonical
103 { _package :: !Pkg.Name
104 , _module :: !Name.Name
105 }
108-- INSTANCES
111instance Eq Canonical where
112 (==) (Canonical pkg1 name1) (Canonical pkg2 name2) =
113 name1 == name2 && pkg1 == pkg2
116instance Ord Canonical where
117 compare (Canonical pkg1 name1) (Canonical pkg2 name2) =
118 case compare name1 name2 of
119 LT -> LT
120 EQ -> compare pkg1 pkg2
121 GT -> GT
124instance Binary Canonical where
125 put (Canonical a b) = put a >> put b
126 get = liftM2 Canonical get get
130-- CORE
133{-# NOINLINE basics #-}
134basics :: Canonical
135basics = Canonical Pkg.core Name.basics
138{-# NOINLINE char #-}
139char :: Canonical
140char = Canonical Pkg.core Name.char
143{-# NOINLINE string #-}
144string :: Canonical
145string = Canonical Pkg.core Name.string
148{-# NOINLINE maybe #-}
149maybe :: Canonical
150maybe = Canonical Pkg.core Name.maybe
153{-# NOINLINE result #-}
154result :: Canonical
155result = Canonical Pkg.core Name.result
158{-# NOINLINE list #-}
159list :: Canonical
160list = Canonical Pkg.core Name.list
163{-# NOINLINE array #-}
164array :: Canonical
165array = Canonical Pkg.core Name.array
168{-# NOINLINE dict #-}
169dict :: Canonical
170dict = Canonical Pkg.core Name.dict
173{-# NOINLINE tuple #-}
174tuple :: Canonical
175tuple = Canonical Pkg.core Name.tuple
178{-# NOINLINE platform #-}
179platform :: Canonical
180platform = Canonical Pkg.core Name.platform
183{-# NOINLINE cmd #-}
184cmd :: Canonical
185cmd = Canonical Pkg.core "Platform.Cmd"
188{-# NOINLINE sub #-}
189sub :: Canonical
190sub = Canonical Pkg.core "Platform.Sub"
193{-# NOINLINE debug #-}
194debug :: Canonical
195debug = Canonical Pkg.core Name.debug
198{-# NOINLINE bitwise #-}
199bitwise :: Canonical
200bitwise = Canonical Pkg.core Name.bitwise
204-- HTML
207{-# NOINLINE virtualDom #-}
208virtualDom :: Canonical
209virtualDom = Canonical Pkg.virtualDom Name.virtualDom
213-- JSON
216{-# NOINLINE jsonDecode #-}
217jsonDecode :: Canonical
218jsonDecode = Canonical Pkg.json "Json.Decode"
221{-# NOINLINE jsonEncode #-}
222jsonEncode :: Canonical
223jsonEncode = Canonical Pkg.json "Json.Encode"
227-- WEBGL
230{-# NOINLINE webgl #-}
231webgl :: Canonical
232webgl = Canonical Pkg.webgl "WebGL"
235{-# NOINLINE texture #-}
236texture :: Canonical
237texture = Canonical Pkg.webgl "WebGL.Texture"
240{-# NOINLINE vector2 #-}
241vector2 :: Canonical
242vector2 = Canonical Pkg.linearAlgebra "Math.Vector2"
245{-# NOINLINE vector3 #-}
246vector3 :: Canonical
247vector3 = Canonical Pkg.linearAlgebra "Math.Vector3"
250{-# NOINLINE vector4 #-}
251vector4 :: Canonical
252vector4 = Canonical Pkg.linearAlgebra "Math.Vector4"
255{-# NOINLINE matrix4 #-}
256matrix4 :: Canonical
257matrix4 = Canonical Pkg.linearAlgebra "Math.Matrix4"