This module exposes parsers for Elm expressions.
Representations for Elm's expressions.
Representation for Elm's expression containing it's meta information
A parser for Elm expressions.
A parses for term
module Ast.Expression exposing
( Expression(..), MExp
, expression
, term
)
{-| This module exposes parsers for Elm expressions.
# Types
@docs Expression, MExp
# rs
@docs expression
# Expression
@docs term
-}
import Ast.BinOp exposing (..)
import Ast.Common exposing (..)
import Ast.Helpers exposing (..)
import Char
import Combine exposing (..)
import Combine.Char exposing (..)
import Combine.Num
import Dict exposing (Dict)
import Hex
import List exposing (singleton)
import List.Extra exposing (break)
import String
type Collect a
= Cont a
| Stop a
{-| Representation for Elm's expression containing it's meta information
-}
type alias MExp =
WithMeta Expression {}
type alias Operator =
WithMeta String {}
{-| Representations for Elm's expressions.
-}
type Expression
= Character Char
| String String
| Integer Int
| Float Float
| Variable (List Name)
| List (List MExp)
| Tuple (List MExp)
| Access MExp (List MName)
| AccessFunction Name
| Record (List ( MName, MExp ))
| RecordUpdate MName (List ( MName, MExp ))
| If MExp MExp MExp
| Let (List ( MExp, MExp )) MExp
| Case MExp (List ( MExp, MExp ))
| Lambda (List MExp) MExp
| Application MExp MExp
| BinOp MExp MExp MExp
character : Parser s MExp
character =
withMeta <|
Character
<$> between_ (Combine.string "'")
(((Combine.string "\\" *> regex "(n|t|r|\\\\|x..)")
>>= (\a ->
case String.uncons a of
Just ( 'n', "" ) ->
succeed '\n'
Just ( 't', "" ) ->
succeed '\t'
Just ( 'r', "" ) ->
succeed '\x0D'
Just ( '\\', "" ) ->
succeed '\\'
Just ( '0', "" ) ->
succeed '\x00'
Just ( 'x', hex ) ->
hex
|> String.toLower
|> Hex.fromString
|> Result.map Char.fromCode
|> Result.map succeed
|> Result.withDefault (fail "Invalid charcode")
Just other ->
fail ("No such character as \\" ++ toString other)
Nothing ->
fail "No character"
)
)
<|> anyChar
)
string : Parser s MExp
string =
let
singleString =
String
<$> (Combine.string "\"" *> regex "(\\\\\\\\|\\\\\"|[^\"\n])*" <* Combine.string "\"")
multiString =
(String << String.concat)
<$> (Combine.string "\"\"\"" *> many (regex "[^\"]*") <* Combine.string "\"\"\"")
in
withMeta <| multiString <|> singleString
integer : Parser s MExp
integer =
withMeta <| Integer <$> Combine.Num.int
float : Parser s MExp
float =
withMeta <| Float <$> Combine.Num.float
access : Parser s MExp
access =
withMeta <| Access <$> variable <*> many1 (Combine.string "." *> withMeta loName)
accessFunction : Parser s MExp
accessFunction =
withMeta <| AccessFunction <$> (Combine.string "." *> loName)
variable : Parser s MExp
variable =
withMeta <|
Variable
<$> choice
[ singleton <$> loName
, sepBy1 (Combine.string ".") upName
, singleton <$> parens operator
, singleton <$> parens (Combine.regex ",+")
, singleton <$> emptyTuple
]
list : OpTable -> Parser s MExp
list ops =
lazy <|
\() ->
withMeta <| List <$> brackets (commaSeparated_ <| expression ops)
tuple : OpTable -> Parser s MExp
tuple ops =
lazy <|
\() ->
withMeta <|
Tuple
<$> (parens (commaSeparated_ <| expression ops)
>>= (\a ->
case a of
[ _ ] ->
fail "No single tuples"
anyOther ->
succeed anyOther
)
)
record : OpTable -> Parser s MExp
record ops =
lazy <|
\() ->
withMeta <| Record <$> braces (commaSeparated ((,) <$> withMeta loName <*> (symbol "=" *> expression ops)))
simplifiedRecord : Parser s MExp
simplifiedRecord =
let
branch { line, column } =
loName
|> map
(\a ->
( addMeta line column a
, addMeta line column (Variable [ a ])
)
)
in
lazy <|
\() ->
withMeta <|
Record
<$> braces (commaSeparated (withLocation branch))
recordUpdate : OpTable -> Parser s MExp
recordUpdate ops =
lazy <|
\() ->
withMeta <|
RecordUpdate
<$> (symbol "{" *> withMeta loName)
<*> (symbol "|"
*> commaSeparated ((,) <$> withMeta loName <*> (symbol "=" *> expression ops))
<* Combine.string "}"
)
letExpression : OpTable -> Parser s MExp
letExpression ops =
lazy <|
\() ->
withMeta <|
Let
<$> (symbol_ "let" *> many1 (letBinding ops))
<*> (symbol "in" *> expression ops)
letBinding : OpTable -> Parser s ( MExp, MExp )
letBinding ops =
lazy <|
\() ->
(,)
<$> (between_ whitespace <| expression ops)
<*> (symbol "=" *> expression ops)
ifExpression : OpTable -> Parser s MExp
ifExpression ops =
lazy <|
\() ->
withMeta <|
If
<$> (symbol "if" *> expression ops)
<*> (symbol "then" *> expression ops)
<*> (symbol "else" *> expression ops)
caseExpression : OpTable -> Parser s MExp
caseExpression ops =
let
binding indent =
lazy <|
\() ->
(,)
<$> (exactIndentation indent *> expression ops)
<*> (symbol "->" *> expression ops)
in
lazy <|
\() ->
withMeta <|
Case
<$> (symbol "case" *> expression ops)
<*> (whitespace
*> Combine.string "of"
*> lookAhead countIndent
>>= (\indent ->
many1 (binding indent)
)
)
countIndent : Parser s Int
countIndent =
newline *> spaces >>= (String.filter (\char -> char == ' ') >> String.length >> succeed)
lambda : OpTable -> Parser s MExp
lambda ops =
lazy <|
\() ->
withMeta <|
Lambda
<$> (symbol "\\" *> many (between_ spaces <| term ops))
<*> (symbol "->" *> expression ops)
application : OpTable -> Parser s MExp
application ops =
lazy <|
\() ->
withLocation
(\l ->
chainl
((\a b -> addMeta l.line l.column (Application a b)) <$ spacesOrIndentedNewline (l.column + 1))
(term ops)
)
spacesOrIndentedNewline : Int -> Parser s ()
spacesOrIndentedNewline indentation =
lazy <|
\() ->
or (spaces_ *> succeed ())
(countIndent
>>= (\column ->
if column < indentation then
fail "Arguments have to be at least the same indentation as the function"
else
succeed ()
)
)
operatorOrAsBetween : Parser s (WithMeta String {})
operatorOrAsBetween =
lazy <|
\() ->
withMeta <| between_ whitespace <| operator <|> symbol_ "as"
successOrEmptyList : Parser s (List a) -> Parser s (List a)
successOrEmptyList p =
lazy <| \() -> choice [ p, succeed [] ]
binary : OpTable -> Parser s MExp
binary ops =
lazy <|
\() ->
let
next =
operatorOrAsBetween
>>= (\op ->
lazy <|
\() ->
or (Cont <$> application ops) (Stop <$> expression ops)
>>= (\e ->
case e of
Cont t ->
(::) ( op, t ) <$> successOrEmptyList next
Stop ex ->
succeed [ ( op, ex ) ]
)
)
in
application ops
>>= (\e -> successOrEmptyList next >>= (\eops -> split ops 0 e eops))
{-| A parses for term
-}
term : OpTable -> Parser s MExp
term ops =
lazy <|
\() ->
choice
[ access
, variable
, accessFunction
, string
, float
, integer
, character
, parens (between_ whitespace (expression ops))
, list ops
, tuple ops
, recordUpdate ops
, record ops
, simplifiedRecord
]
{-| A parser for Elm expressions.
-}
expression : OpTable -> Parser s MExp
expression ops =
lazy <|
\() ->
choice
[ binary ops
, letExpression ops
, caseExpression ops
, ifExpression ops
, lambda ops
]
op : OpTable -> String -> ( Assoc, Int )
op ops n =
Dict.get n ops
|> Maybe.withDefault ( L, 9 )
assoc : OpTable -> String -> Assoc
assoc ops n =
Tuple.first <| op ops n
level : OpTable -> String -> Int
level ops n =
Tuple.second <| op ops n
hasLevel : OpTable -> Int -> ( Operator, MExp ) -> Bool
hasLevel ops l ( n, _ ) =
level ops (dropMeta n) == l
split : OpTable -> Int -> MExp -> List ( Operator, MExp ) -> Parser s MExp
split ops l e eops =
case eops of
[] ->
succeed e
_ ->
findAssoc ops l eops
>>= (\assoc ->
sequence (splitLevel ops l e eops)
>>= (\es ->
let
ops_ =
List.filterMap
(\x ->
if hasLevel ops l x then
Just (Tuple.first x)
else
Nothing
)
eops
in
case assoc of
R ->
joinR es ops_
_ ->
joinL es ops_
)
)
splitLevel : OpTable -> Int -> MExp -> List ( Operator, MExp ) -> List (Parser s MExp)
splitLevel ops l e eops =
case break (hasLevel ops l) eops of
( lops, ( _, e_ ) :: rops ) ->
split ops (l + 1) e lops :: splitLevel ops l e_ rops
( lops, [] ) ->
[ split ops (l + 1) e lops ]
joinL : List MExp -> List Operator -> Parser s MExp
joinL es ops =
case ( es, ops ) of
( [ e ], [] ) ->
succeed e
( a :: b :: remE, ( e, { line, column } ) :: remO ) ->
joinL
(addMeta line
column
(BinOp (addMeta line column <| Variable [ e ]) a b)
:: remE
)
remO
_ ->
fail ""
joinR : List MExp -> List Operator -> Parser s MExp
joinR es ops =
case ( es, ops ) of
( [ e ], [] ) ->
succeed e
( a :: b :: remE, ( e, { line, column } ) :: remO ) ->
joinR (b :: remE) remO
|> andThen
(\exp ->
succeed
(addMeta line column <|
BinOp (addMeta line column (Variable [ e ])) a exp
)
)
_ ->
fail ""
findAssoc : OpTable -> Int -> List ( Operator, MExp ) -> Parser s Assoc
findAssoc ops l eops =
let
lops =
List.filter (hasLevel ops l) eops
assocs =
List.map (assoc ops << dropMeta << Tuple.first) lops
error issue =
let
operators =
List.map (Tuple.first >> dropMeta) lops |> String.join " and "
in
"conflicting " ++ issue ++ " for operators " ++ operators
in
if List.all ((==) L) assocs then
succeed L
else if List.all ((==) R) assocs then
succeed R
else if List.all ((==) N) assocs then
case assocs of
[ _ ] ->
succeed N
_ ->
fail <| error "precedence"
else
fail <| error "associativity"