mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 08:45:42 +03:00
Combine AST.Module.Name and Elm.Compiler.Module into Elm.ModuleName
This commit is contained in:
parent
a798228fd9
commit
0fb8be01ac
@ -1,116 +0,0 @@
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Elm.Compiler.Module
|
||||
-- interfaces
|
||||
( I.Interface
|
||||
, I.Interfaces
|
||||
|
||||
-- module names
|
||||
, Raw
|
||||
, nameToString
|
||||
, nameToSlashPath
|
||||
, nameToHyphenPath
|
||||
, fromHyphenPath
|
||||
, encode
|
||||
, decoder
|
||||
|
||||
-- canonical names
|
||||
, ModuleName.Canonical(..)
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
import qualified Data.Char as Char
|
||||
import qualified Data.Name as Name
|
||||
import qualified Data.Text as Text
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
import qualified AST.Module.Name as ModuleName
|
||||
import qualified Elm.Interface as I
|
||||
import qualified Json.Decode as Decode
|
||||
import qualified Json.Encode as Encode
|
||||
|
||||
|
||||
|
||||
-- NAMES
|
||||
|
||||
|
||||
type Raw = Name.Name
|
||||
|
||||
|
||||
nameToString :: Raw -> String
|
||||
nameToString =
|
||||
Name.toString
|
||||
|
||||
|
||||
nameToSlashPath :: Raw -> FilePath
|
||||
nameToSlashPath name =
|
||||
map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toString name)
|
||||
|
||||
|
||||
nameToHyphenPath :: Raw -> FilePath
|
||||
nameToHyphenPath name =
|
||||
map (\c -> if c == '.' then '-' else c) (Name.toString name)
|
||||
|
||||
|
||||
fromHyphenPath :: Text.Text -> Maybe Raw
|
||||
fromHyphenPath txt =
|
||||
let str = Text.unpack txt in
|
||||
if all isGoodChunk (splitOn '-' str)
|
||||
then Just (Name.fromString (map (\c -> if c == '-' then '.' else c) str))
|
||||
else Nothing
|
||||
|
||||
|
||||
|
||||
-- JSON
|
||||
|
||||
|
||||
encode :: Raw -> Encode.Value
|
||||
encode =
|
||||
Encode.name
|
||||
|
||||
|
||||
decoder :: Decode.Decoder Text.Text Raw
|
||||
decoder =
|
||||
do txt <- Decode.text
|
||||
let str = Text.unpack txt
|
||||
if all isGoodChunk (splitOn '.' str)
|
||||
then Decode.succeed (Name.fromString str)
|
||||
else Decode.fail txt
|
||||
|
||||
|
||||
isGoodChunk :: String -> Bool
|
||||
isGoodChunk chunk =
|
||||
case chunk of
|
||||
[] ->
|
||||
False
|
||||
|
||||
first : rest ->
|
||||
Char.isUpper first && all isGoodChar rest
|
||||
|
||||
|
||||
isGoodChar :: Char -> Bool
|
||||
isGoodChar char =
|
||||
Char.isAlphaNum char || char == '_'
|
||||
|
||||
|
||||
splitOn :: Char -> String -> [String]
|
||||
splitOn sep string =
|
||||
uncurry (:) (splitOnHelp sep string)
|
||||
|
||||
|
||||
splitOnHelp :: Char -> String -> (String, [String])
|
||||
splitOnHelp sep string =
|
||||
case string of
|
||||
[] ->
|
||||
("",[])
|
||||
|
||||
char : rest ->
|
||||
let
|
||||
(chunk,chunks) = splitOnHelp sep rest
|
||||
in
|
||||
if char == sep then
|
||||
("", chunk:chunks)
|
||||
else
|
||||
(char:chunk, chunks)
|
||||
|
@ -1,28 +1,124 @@
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module AST.Module.Name
|
||||
( Canonical(..)
|
||||
module Elm.ModuleName
|
||||
( Raw
|
||||
, nameToString
|
||||
, nameToSlashPath
|
||||
, nameToHyphenPath
|
||||
, fromHyphenPath
|
||||
, encode
|
||||
, decoder
|
||||
, Canonical(..)
|
||||
, canonicalIsKernel
|
||||
, basics, char, string
|
||||
, maybe, result, list, array, dict, tuple
|
||||
, platform, cmd, sub
|
||||
, virtualDom, debug, bitwise
|
||||
, debug, bitwise
|
||||
, virtualDom
|
||||
, jsonDecode, jsonEncode
|
||||
, webgl, texture, vector2, vector3, vector4, matrix4
|
||||
, canonicalIsKernel
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
import Prelude hiding (maybe)
|
||||
import Control.Monad (liftM2)
|
||||
import Data.Binary
|
||||
import Data.Binary (Binary(..))
|
||||
import qualified Data.Char as Char
|
||||
import qualified Data.Name as Name
|
||||
import qualified Data.Text as Text
|
||||
import Prelude hiding (maybe)
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
import qualified Elm.Package as Pkg
|
||||
import qualified Json.Decode as Decode
|
||||
import qualified Json.Encode as Encode
|
||||
|
||||
|
||||
|
||||
-- NAMES
|
||||
-- RAW
|
||||
|
||||
|
||||
type Raw = Name.Name
|
||||
|
||||
|
||||
nameToString :: Raw -> String
|
||||
nameToString =
|
||||
Name.toString
|
||||
|
||||
|
||||
nameToSlashPath :: Raw -> FilePath
|
||||
nameToSlashPath name =
|
||||
map (\c -> if c == '.' then FP.pathSeparator else c) (Name.toString name)
|
||||
|
||||
|
||||
nameToHyphenPath :: Raw -> FilePath
|
||||
nameToHyphenPath name =
|
||||
map (\c -> if c == '.' then '-' else c) (Name.toString name)
|
||||
|
||||
|
||||
fromHyphenPath :: Text.Text -> Maybe Raw
|
||||
fromHyphenPath txt =
|
||||
let str = Text.unpack txt in
|
||||
if all isGoodChunk (splitOn '-' str)
|
||||
then Just (Name.fromString (map (\c -> if c == '-' then '.' else c) str))
|
||||
else Nothing
|
||||
|
||||
|
||||
|
||||
-- JSON
|
||||
|
||||
|
||||
encode :: Raw -> Encode.Value
|
||||
encode =
|
||||
Encode.name
|
||||
|
||||
|
||||
decoder :: Decode.Decoder Text.Text Raw
|
||||
decoder =
|
||||
do txt <- Decode.text
|
||||
let str = Text.unpack txt
|
||||
if all isGoodChunk (splitOn '.' str)
|
||||
then Decode.succeed (Name.fromString str)
|
||||
else Decode.fail txt
|
||||
|
||||
|
||||
isGoodChunk :: String -> Bool
|
||||
isGoodChunk chunk =
|
||||
case chunk of
|
||||
[] ->
|
||||
False
|
||||
|
||||
first : rest ->
|
||||
Char.isUpper first && all isGoodChar rest
|
||||
|
||||
|
||||
isGoodChar :: Char -> Bool
|
||||
isGoodChar c =
|
||||
Char.isAlphaNum c || c == '_'
|
||||
|
||||
|
||||
splitOn :: Char -> String -> [String]
|
||||
splitOn sep str =
|
||||
uncurry (:) (splitOnHelp sep str)
|
||||
|
||||
|
||||
splitOnHelp :: Char -> String -> (String, [String])
|
||||
splitOnHelp sep str =
|
||||
case str of
|
||||
[] ->
|
||||
("",[])
|
||||
|
||||
c : rest ->
|
||||
let
|
||||
(chunk,chunks) = splitOnHelp sep rest
|
||||
in
|
||||
if c == sep then
|
||||
("", chunk:chunks)
|
||||
else
|
||||
(c:chunk, chunks)
|
||||
|
||||
|
||||
|
||||
-- CANONICAL
|
||||
|
||||
|
||||
data Canonical =
|
||||
@ -33,18 +129,32 @@ data Canonical =
|
||||
deriving (Ord)
|
||||
|
||||
|
||||
canonicalIsKernel :: Canonical -> Bool
|
||||
canonicalIsKernel (Canonical _ name) =
|
||||
Name.isKernel name
|
||||
|
||||
|
||||
|
||||
-- INSTANCES
|
||||
|
||||
|
||||
instance Eq Canonical where
|
||||
(==) (Canonical pkg home) (Canonical pkg' home') =
|
||||
home == home' && pkg == pkg'
|
||||
(==) (Canonical pkg1 name1) (Canonical pkg2 name2) =
|
||||
name1 == name2 && pkg1 == pkg2
|
||||
|
||||
|
||||
instance Binary Canonical where
|
||||
put (Canonical a b) = put a >> put b
|
||||
get = liftM2 Canonical get get
|
||||
|
||||
|
||||
|
||||
-- PRIMITIVES
|
||||
-- CORE
|
||||
|
||||
|
||||
{-# NOINLINE basics #-}
|
||||
basics :: Canonical
|
||||
basics = Canonical Pkg.core "Basics"
|
||||
basics = Canonical Pkg.core Name.basics
|
||||
|
||||
|
||||
{-# NOINLINE char #-}
|
||||
@ -57,10 +167,6 @@ string :: Canonical
|
||||
string = Canonical Pkg.core Name.string
|
||||
|
||||
|
||||
|
||||
-- CONTAINERS
|
||||
|
||||
|
||||
{-# NOINLINE maybe #-}
|
||||
maybe :: Canonical
|
||||
maybe = Canonical Pkg.core Name.maybe
|
||||
@ -91,10 +197,6 @@ tuple :: Canonical
|
||||
tuple = Canonical Pkg.core Name.tuple
|
||||
|
||||
|
||||
|
||||
-- EFFECTS
|
||||
|
||||
|
||||
{-# NOINLINE platform #-}
|
||||
platform :: Canonical
|
||||
platform = Canonical Pkg.core Name.platform
|
||||
@ -110,15 +212,6 @@ sub :: Canonical
|
||||
sub = Canonical Pkg.core "Platform.Sub"
|
||||
|
||||
|
||||
|
||||
-- MISC
|
||||
|
||||
|
||||
{-# NOINLINE virtualDom #-}
|
||||
virtualDom :: Canonical
|
||||
virtualDom = Canonical Pkg.virtualDom Name.virtualDom
|
||||
|
||||
|
||||
{-# NOINLINE debug #-}
|
||||
debug :: Canonical
|
||||
debug = Canonical Pkg.core Name.debug
|
||||
@ -130,6 +223,15 @@ bitwise = Canonical Pkg.core Name.bitwise
|
||||
|
||||
|
||||
|
||||
-- HTML
|
||||
|
||||
|
||||
{-# NOINLINE virtualDom #-}
|
||||
virtualDom :: Canonical
|
||||
virtualDom = Canonical Pkg.virtualDom Name.virtualDom
|
||||
|
||||
|
||||
|
||||
-- JSON
|
||||
|
||||
|
||||
@ -175,24 +277,3 @@ vector4 = Canonical Pkg.linearAlgebra "Math.Vector4"
|
||||
{-# NOINLINE matrix4 #-}
|
||||
matrix4 :: Canonical
|
||||
matrix4 = Canonical Pkg.linearAlgebra "Math.Matrix4"
|
||||
|
||||
|
||||
|
||||
-- IS KERNEL
|
||||
|
||||
|
||||
canonicalIsKernel :: Canonical -> Bool
|
||||
canonicalIsKernel (Canonical _ name) =
|
||||
Name.isKernel name
|
||||
|
||||
|
||||
|
||||
-- BINARY
|
||||
|
||||
|
||||
instance Binary Canonical where
|
||||
put (Canonical a b) =
|
||||
put a >> put b
|
||||
|
||||
get =
|
||||
liftM2 Canonical get get
|
@ -130,12 +130,12 @@ Executable elm
|
||||
|
||||
-- shared from compiler/
|
||||
Elm.Compiler
|
||||
Elm.Compiler.Module
|
||||
Elm.Compiler.Objects
|
||||
Elm.Compiler.Type
|
||||
Elm.Docs
|
||||
Elm.Kernel
|
||||
Elm.Header
|
||||
Elm.Kernel
|
||||
Elm.ModuleName
|
||||
Elm.Package
|
||||
Json.Decode
|
||||
Json.Encode
|
||||
@ -144,7 +144,6 @@ Executable elm
|
||||
AST.Canonical
|
||||
AST.Optimized
|
||||
AST.Source
|
||||
AST.Module.Name
|
||||
AST.Utils.Binop
|
||||
AST.Utils.Shader
|
||||
AST.Utils.Type
|
||||
@ -240,6 +239,7 @@ Executable elm
|
||||
directory >= 1.2.3.0 && < 2.0,
|
||||
edit-distance >= 0.2 && < 0.3,
|
||||
file-embed,
|
||||
filelock,
|
||||
filepath >= 1 && < 2.0,
|
||||
ghc-prim >= 0.5.2,
|
||||
haskeline,
|
||||
|
Loading…
Reference in New Issue
Block a user