module Elm.Expression
( Expr(..)
) where
import Protolude
import Control.Monad (mapM, when)
import Control.Monad.Writer (tell)
import Data.String (IsString (..), String)
import Elm.Classes (Generate (..))
import Elm.GenError (GenError (..))
import Text.PrettyPrint hiding (Str)
data Expr
= Bool Bool
| Str String
| Int Int
| Float Float
| Under
| Var String
| App [Expr]
| List [Expr]
| Op String
Expr
Expr
| Tuple [Expr]
| Record (Maybe Expr)
[(String, Expr)]
| Let Expr
[(Expr, Expr)]
| Case Expr
[(Expr, Expr)]
| Parens Expr
instance IsString Expr where
fromString = Var
instance Generate Expr where
generate expr =
case expr of
Var str -> do
when (str == "") $
tell $ Error "An empty string is not a valid variable name"
return $ text str
App []
-> do
tell $ Error "Invalid syntax, trying to apply nothing"
return $ text ""
App [expr'] -> generate expr'
App exprs
-> do
docs <- mapM vop exprs
return . hsep $ docs
Tuple [] ->
return "()"
Tuple items -> do
when (length items > 9) $
tell $ Error "Length of tuple is too long"
when (length items > 7) $
tell $
WarningList
[ "Tuples of length longer than seven are not comparable"
]
docs <- mapM generate items
return $ lparen <+> (hsep . punctuate "," $ docs) <+> rparen
Str str -> return . doubleQuotes . text $ str
Op op expr1 expr2 -> do
doc1 <- vop expr1
doc2 <- vop expr2
return $ doc1 <+> text op <+> doc2
Case _ [] -> do
tell $ Error "Unable to create case expression with 0 cases"
return ""
Case value options -> do
docValue <- generate value
optionsList <- genCaseList options
return $ "case" <+> docValue <+> "of" $+$ nest 4 optionsList
List items -> do
docs <- mapM generate items
return . brackets . hsep . punctuate "," $ docs
Let _ [] -> do
tell $ Error "Unable to create let expression with 0 bindings"
return ""
Let value bindings -> do
bindingsList <- genLetList bindings
valueDoc <- generate value
return $
"let" $+$ nest 4 bindingsList $+$ "in" $+$ nest 4 valueDoc
Int val -> do
when (val > 9007199254740991) $
tell $
WarningList
[ "The number " ++
show val ++
" is larger than the largest safe number in js"
]
return . int $ val
Float val -> do
when (val > 9007199254740991) $
tell $
WarningList
[ "The number " ++
show val ++
" is larger that the largest safe number in js"
]
return . float $ val
Under -> return . char $ '_'
Bool bool' ->
if bool'
then return . text $ "True"
else return . text $ "False"
Record Nothing [] -> return "{}"
Record (Just (Var str)) []
-> do
tell $
WarningList
[ "Trying to update record " ++
str ++ " with no changed fields"
]
return . text $ str
Record (Just (Var str)) updates -> do
list' <- genRecordList updates
return $ lbrace <+> text str <+> "|" <+> list' <+> rbrace
Record (Just _) _
-> do
tell $
Error
"You are unable to update a record with a non constant"
return ""
Record Nothing updates -> do
list' <- genRecordList updates
return $ lbrace <+> list' <+> rbrace
Parens expr' -> do
doc <- generate expr'
return . parens $ doc
where
genRecordList updates = do
let (keys, values) = unzip updates
let docKeys = map text keys
docValues <- mapM generate values
return . hsep . punctuate "," . map (\(a, b) -> a <+> "=" <+> b) $
zip docKeys docValues
genLetList bindings = do
let (keys, values) = unzip bindings
docKeys <- mapM generate keys
docValues <- mapM generate values
return . vcat . map (\(a, b) -> a <+> "=" <+> b) $
zip docKeys docValues
genCaseList options = do
let (keys, values) = unzip options
docKeys <- mapM generate keys
docValues <- sequence . map generate $ values
return . vcat . punctuate "\n" . map (\(a, b) -> a <+> "->" $+$ nest 4 b) $
zip docKeys docValues
vop expr' =
case expr' of
Var _ -> generate expr'
Tuple _ -> generate expr'
List _ -> generate expr'
Int _ -> generate expr'
Float _ -> generate expr'
Under -> generate expr'
Str _ -> generate expr'
Record _ _ -> generate expr'
_ -> do
doc <- generate expr'
return . parens $ doc