git.iko.soy/elk
on ebbecaf help sign in
elk/compiler/src/Elm/ModuleName.hs
287 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.Name as Name
26import qualified Data.Utf8 as Utf8
27import Data.Word (Word8)
28import Foreign.Ptr (Ptr, plusPtr, minusPtr)
29import Prelude hiding (maybe)
30import qualified System.FilePath as FP
32import qualified Elm.Package as Pkg
33import qualified Json.Decode as D
34import qualified Json.Encode as E
35import qualified Parse.Variable as Var
36import qualified Parse.Primitives as P
37import Parse.Primitives (Row, Col)
41-- RAW
44type Raw = Name.Name
47toChars :: Raw -> String
48toChars =
49 Name.toChars
52toFilePath :: Raw -> FilePath
53toFilePath name =
54 map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toChars name)
57toHyphenPath :: Raw -> FilePath
58toHyphenPath name =
59 map (\c -> if c == '.' then '-' else c) (Name.toChars name)
63-- JSON
66encode :: Raw -> E.Value
67encode =
68 E.name
71decoder :: D.Decoder (Row, Col) Raw
72decoder =
73 D.customString parser (,)
77-- PARSER
80parser :: P.Parser (Row, Col) Raw
81parser =
82 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
83 let
84 (# isGood, newPos, newCol #) = chompStart pos end col
85 in
86 if isGood && minusPtr newPos pos < 256 then
87 let !newState = P.State src newPos end indent row newCol in
88 cok (Utf8.fromPtr pos newPos) newState
90 else if col == newCol then
91 eerr row newCol (,)
93 else
94 cerr row newCol (,)
97chompStart :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)
98chompStart pos end col =
99 let
100 !width = Var.getUpperWidth pos end
101 in
102 if width == 0 then
103 (# False, pos, col #)
104 else
105 chompInner (plusPtr pos width) end (col + 1)
108chompInner :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)
109chompInner pos end col =
110 if pos >= end then
111 (# True, pos, col #)
112 else
113 let
114 !word = P.unsafeIndex pos
115 !width = Var.getInnerWidthHelp pos end word
116 in
117 if width == 0 then
118 if word == 0x2E {-.-} then
119 chompStart (plusPtr pos 1) end (col + 1)
120 else
121 (# True, pos, col #)
122 else
123 chompInner (plusPtr pos width) end (col + 1)
127-- CANONICAL
130data Canonical =
131 Canonical
132 { _package :: !Pkg.Name
133 , _module :: !Name.Name
134 }
138-- INSTANCES
141instance Eq Canonical where
142 (==) (Canonical pkg1 name1) (Canonical pkg2 name2) =
143 name1 == name2 && pkg1 == pkg2
146instance Ord Canonical where
147 compare (Canonical pkg1 name1) (Canonical pkg2 name2) =
148 case compare name1 name2 of
149 LT -> LT
150 EQ -> compare pkg1 pkg2
151 GT -> GT
154instance Binary Canonical where
155 put (Canonical a b) = put a >> put b
156 get = liftM2 Canonical get get
160-- CORE
163{-# NOINLINE basics #-}
164basics :: Canonical
165basics = Canonical Pkg.core Name.basics
168{-# NOINLINE char #-}
169char :: Canonical
170char = Canonical Pkg.core Name.char
173{-# NOINLINE string #-}
174string :: Canonical
175string = Canonical Pkg.core Name.string
178{-# NOINLINE maybe #-}
179maybe :: Canonical
180maybe = Canonical Pkg.core Name.maybe
183{-# NOINLINE result #-}
184result :: Canonical
185result = Canonical Pkg.core Name.result
188{-# NOINLINE list #-}
189list :: Canonical
190list = Canonical Pkg.core Name.list
193{-# NOINLINE array #-}
194array :: Canonical
195array = Canonical Pkg.core Name.array
198{-# NOINLINE dict #-}
199dict :: Canonical
200dict = Canonical Pkg.core Name.dict
203{-# NOINLINE tuple #-}
204tuple :: Canonical
205tuple = Canonical Pkg.core Name.tuple
208{-# NOINLINE platform #-}
209platform :: Canonical
210platform = Canonical Pkg.core Name.platform
213{-# NOINLINE cmd #-}
214cmd :: Canonical
215cmd = Canonical Pkg.core "Platform.Cmd"
218{-# NOINLINE sub #-}
219sub :: Canonical
220sub = Canonical Pkg.core "Platform.Sub"
223{-# NOINLINE debug #-}
224debug :: Canonical
225debug = Canonical Pkg.core Name.debug
228{-# NOINLINE bitwise #-}
229bitwise :: Canonical
230bitwise = Canonical Pkg.core Name.bitwise
234-- HTML
237{-# NOINLINE virtualDom #-}
238virtualDom :: Canonical
239virtualDom = Canonical Pkg.virtualDom Name.virtualDom
243-- JSON
246{-# NOINLINE jsonDecode #-}
247jsonDecode :: Canonical
248jsonDecode = Canonical Pkg.json "Json.Decode"
251{-# NOINLINE jsonEncode #-}
252jsonEncode :: Canonical
253jsonEncode = Canonical Pkg.json "Json.Encode"
257-- WEBGL
260{-# NOINLINE webgl #-}
261webgl :: Canonical
262webgl = Canonical Pkg.webgl "WebGL"
265{-# NOINLINE texture #-}
266texture :: Canonical
267texture = Canonical Pkg.webgl "WebGL.Texture"
270{-# NOINLINE vector2 #-}
271vector2 :: Canonical
272vector2 = Canonical Pkg.linearAlgebra "Math.Vector2"
275{-# NOINLINE vector3 #-}
276vector3 :: Canonical
277vector3 = Canonical Pkg.linearAlgebra "Math.Vector3"
280{-# NOINLINE vector4 #-}
281vector4 :: Canonical
282vector4 = Canonical Pkg.linearAlgebra "Math.Vector4"
285{-# NOINLINE matrix4 #-}
286matrix4 :: Canonical
287matrix4 = Canonical Pkg.linearAlgebra "Math.Matrix4"