@@ -1,13 +1,13 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings, UnboxedTuples #-}
22module Elm.ModuleName
33 ( Raw
44 , toChars
5− , toString
65 , toFilePath
76 , toHyphenPath
8− , fromHyphenPath
7+ --
98 , encode
109 , decoder
10+ --
1111 , Canonical(..)
1212 , basics, char, string
1313 , maybe, result, list, array, dict, tuple
@@ -25,12 +25,17 @@ import Data.Binary (Binary(..))
2525import qualified Data.Char as Char
2626import qualified Data.Name as Name
2727import qualified Data.Utf8 as Utf8
28+import Data.Word (Word8)
29+import Foreign.Ptr (Ptr, plusPtr, minusPtr)
2830import Prelude hiding (maybe)
2931import qualified System.FilePath as FP
3032
3133import qualified Elm.Package as Pkg
32−import qualified Json.Decode as Decode
33−import qualified Json.Encode as Encode
34+import qualified Json.Decode as D
35+import qualified Json.Encode as E
36+import qualified Parse.Variable as Var
37+import qualified Parse.Primitives as P
38+import Parse.Primitives (Row, Col)
3439
3540
3641
@@ -45,11 +50,6 @@ toChars =
4550 Name.toChars
4651
4752
48−toString :: Raw -> Utf8.String
49−toString =
50− Name.toUtf8
51−
52−
5353toFilePath :: Raw -> FilePath
5454toFilePath name =
5555 map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toChars name)
@@ -60,38 +60,68 @@ toHyphenPath name =
6060 map (\c -> if c == '.' then '-' else c) (Name.toChars name)
6161
6262
63−fromHyphenPath :: Utf8.String -> Maybe Raw
64−fromHyphenPath 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
72−
73−
7463
7564-- JSON
7665
7766
78−encode :: Raw -> Encode.Value
67+encode :: Raw -> E.Value
7968encode =
80− Encode.name
69+ E.name
8170
8271
83−decoder :: Decode.Decoder Utf8.String Raw
72+decoder :: D.Decoder (Row, Col) Raw
8473decoder =
85− do str <- Decode.string
86− if all isGoodChunk (Utf8.split 0x2E {- . -} str)
87− then return (Name.fromUtf8 str)
88− else Decode.failure str
74+ D.customString parser (,)
75+
76+
8977
78+-- PARSER
9079
91−isGoodChunk :: Utf8.String -> Bool
92−isGoodChunk chunk =
93− Utf8.startsWithChar Char.isUpper chunk
94− && Utf8.all (\c -> Char.isAlphaNum c || c == '_') chunk
80+
81+parser :: P.Parser (Row, Col) Raw
82+parser =
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
90+
91+ else if col == newCol then
92+ eerr row newCol (,)
93+
94+ else
95+ cerr row newCol (,)
96+
97+
98+chompStart :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)
99+chompStart 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)
107+
108+
109+chompInner :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)
110+chompInner 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)
95125
96126
97127
@@ -105,6 +135,7 @@ data Canonical =
105135 }
106136
107137
138+
108139-- INSTANCES
109140
110141