module Elm.Expression
( Expr(..)
) where
import Protolude
import Control.Monad (mapM, when)
import Control.Monad.Writer (tell)
import Data.List hiding (map)
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