git.iko.soy/elk
on effb8be help sign in
elk/compiler/src/Elm/ModuleName.hs
288 lines 5.2 kB history raw
1{-# LANGUAGE BangPatterns, OverloadedStrings, UnboxedTuples #-}
2module Elm.ModuleName
3 ( Raw
4 , toChars
5 , toFilePath
6 , toHyphenPath
7 --
8 , encode
9 , decoder
10 --
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 Data.Word (Word8)
29import Foreign.Ptr (Ptr, plusPtr, minusPtr)
30import Prelude hiding (maybe)
31import qualified System.FilePath as FP
33import qualified Elm.Package as Pkg
34import qualified Json.Decode as D
35import qualified Json.Encode as E
36import qualified Parse.Variable as Var
37import qualified Parse.Primitives as P
38import Parse.Primitives (Row, Col)
42-- RAW
45type Raw = Name.Name
48toChars :: Raw -> String
49toChars =
50 Name.toChars
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)
64-- JSON
67encode :: Raw -> E.Value
68encode =
69 E.name
72decoder :: D.Decoder (Row, Col) Raw
73decoder =
74 D.customString parser (,)
78-- PARSER
81parser :: P.Parser (Row, Col) Raw
82parser =
83 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
84 let
85 (# isGood, newPos, newCol #) = chompStart pos end col
86 in
87 if isGood && minusPtr newPos pos < 256 then
88 let !newState = P.State src newPos end indent row newCol in
89 cok (Utf8.fromPtr pos newPos) newState
91 else if col == newCol then
92 eerr row newCol (,)
94 else
95 cerr row newCol (,)
98chompStart :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)
99chompStart pos end col =
100 let
101 !width = Var.getUpperWidth pos end
102 in
103 if width == 0 then
104 (# False, pos, col #)
105 else
106 chompInner (plusPtr pos width) end (col + 1)
109chompInner :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)
110chompInner pos end col =
111 if pos >= end then
112 (# True, pos, col #)
113 else
114 let
115 !word = P.unsafeIndex pos
116 !width = Var.getInnerWidthHelp pos end word
117 in
118 if width == 0 then
119 if word == 0x2E {-.-} then
120 chompStart (plusPtr pos 1) end (col + 1)
121 else
122 (# True, pos, col #)
123 else
124 chompInner (plusPtr pos width) end (col + 1)
128-- CANONICAL
131data Canonical =
132 Canonical
133 { _package :: !Pkg.Name
134 , _module :: !Name.Name
135 }
139-- INSTANCES
142instance Eq Canonical where
143 (==) (Canonical pkg1 name1) (Canonical pkg2 name2) =
144 name1 == name2 && pkg1 == pkg2
147instance Ord Canonical where
148 compare (Canonical pkg1 name1) (Canonical pkg2 name2) =
149 case compare name1 name2 of
150 LT -> LT
151 EQ -> compare pkg1 pkg2
152 GT -> GT
155instance Binary Canonical where
156 put (Canonical a b) = put a >> put b
157 get = liftM2 Canonical get get
161-- CORE
164{-# NOINLINE basics #-}
165basics :: Canonical
166basics = Canonical Pkg.core Name.basics
169{-# NOINLINE char #-}
170char :: Canonical
171char = Canonical Pkg.core Name.char
174{-# NOINLINE string #-}
175string :: Canonical
176string = Canonical Pkg.core Name.string
179{-# NOINLINE maybe #-}
180maybe :: Canonical
181maybe = Canonical Pkg.core Name.maybe
184{-# NOINLINE result #-}
185result :: Canonical
186result = Canonical Pkg.core Name.result
189{-# NOINLINE list #-}
190list :: Canonical
191list = Canonical Pkg.core Name.list
194{-# NOINLINE array #-}
195array :: Canonical
196array = Canonical Pkg.core Name.array
199{-# NOINLINE dict #-}
200dict :: Canonical
201dict = Canonical Pkg.core Name.dict
204{-# NOINLINE tuple #-}
205tuple :: Canonical
206tuple = Canonical Pkg.core Name.tuple
209{-# NOINLINE platform #-}
210platform :: Canonical
211platform = Canonical Pkg.core Name.platform
214{-# NOINLINE cmd #-}
215cmd :: Canonical
216cmd = Canonical Pkg.core "Platform.Cmd"
219{-# NOINLINE sub #-}
220sub :: Canonical
221sub = Canonical Pkg.core "Platform.Sub"
224{-# NOINLINE debug #-}
225debug :: Canonical
226debug = Canonical Pkg.core Name.debug
229{-# NOINLINE bitwise #-}
230bitwise :: Canonical
231bitwise = Canonical Pkg.core Name.bitwise
235-- HTML
238{-# NOINLINE virtualDom #-}
239virtualDom :: Canonical
240virtualDom = Canonical Pkg.virtualDom Name.virtualDom
244-- JSON
247{-# NOINLINE jsonDecode #-}
248jsonDecode :: Canonical
249jsonDecode = Canonical Pkg.json "Json.Decode"
252{-# NOINLINE jsonEncode #-}
253jsonEncode :: Canonical
254jsonEncode = Canonical Pkg.json "Json.Encode"
258-- WEBGL
261{-# NOINLINE webgl #-}
262webgl :: Canonical
263webgl = Canonical Pkg.webgl "WebGL"
266{-# NOINLINE texture #-}
267texture :: Canonical
268texture = Canonical Pkg.webgl "WebGL.Texture"
271{-# NOINLINE vector2 #-}
272vector2 :: Canonical
273vector2 = Canonical Pkg.linearAlgebra "Math.Vector2"
276{-# NOINLINE vector3 #-}
277vector3 :: Canonical
278vector3 = Canonical Pkg.linearAlgebra "Math.Vector3"
281{-# NOINLINE vector4 #-}
282vector4 :: Canonical
283vector4 = Canonical Pkg.linearAlgebra "Math.Vector4"
286{-# NOINLINE matrix4 #-}
287matrix4 :: Canonical
288matrix4 = Canonical Pkg.linearAlgebra "Math.Matrix4"