git.iko.soy/elk
on 0885d8a 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 , canonicalIsKernel
13 , basics, char, string
14 , maybe, result, list, array, dict, tuple
15 , platform, cmd, sub
16 , debug, bitwise
17 , virtualDom
18 , jsonDecode, jsonEncode
19 , webgl, texture, vector2, vector3, vector4, matrix4
20 )
21 where
24import Control.Monad (liftM2)
25import Data.Binary (Binary(..))
26import qualified Data.Char as Char
27import qualified Data.Name as Name
28import qualified Data.Utf8 as Utf8
29import Prelude hiding (maybe)
30import qualified System.FilePath as FP
32import qualified Elm.Package as Pkg
33import qualified Json.Decode as Decode
34import qualified Json.Encode as Encode
38-- RAW
41type Raw = Name.Name
44toChars :: Raw -> String
45toChars =
46 Name.toChars
49toString :: Raw -> Utf8.String
50toString =
51 Name.toUtf8
54toFilePath :: Raw -> FilePath
55toFilePath name =
56 map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toChars name)
59toHyphenPath :: Raw -> FilePath
60toHyphenPath name =
61 map (\c -> if c == '.' then '-' else c) (Name.toChars name)
64fromHyphenPath :: Utf8.String -> Maybe Raw
65fromHyphenPath str =
66 let
67 chunks =
68 Utf8.split 0x2D {- - -} str
69 in
70 if all isGoodChunk chunks
71 then Just (Name.fromUtf8 (Utf8.join 0x2E {- . -} chunks))
72 else Nothing
76-- JSON
79encode :: Raw -> Encode.Value
80encode =
81 Encode.name
84decoder :: Decode.Decoder Utf8.String Raw
85decoder =
86 do str <- Decode.string
87 if all isGoodChunk (Utf8.split 0x2E {- . -} str)
88 then return (Name.fromUtf8 str)
89 else Decode.failure str
92isGoodChunk :: Utf8.String -> Bool
93isGoodChunk chunk =
94 Utf8.startsWithChar Char.isUpper chunk
95 && Utf8.all (\c -> Char.isAlphaNum c || c == '_') chunk
99-- CANONICAL
102data Canonical =
103 Canonical
104 { _package :: !Pkg.Name
105 , _module :: !Name.Name
106 }
107 deriving (Ord)
110canonicalIsKernel :: Canonical -> Bool
111canonicalIsKernel (Canonical _ name) =
112 Name.isKernel name
116-- INSTANCES
119instance Eq Canonical where
120 (==) (Canonical pkg1 name1) (Canonical pkg2 name2) =
121 name1 == name2 && pkg1 == pkg2
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"