summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoreliaslfox <>2017-09-12 04:53:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-09-12 04:53:00 (GMT)
commitc6066429cbcc1176795ab6255ce500afe433c150 (patch)
treed4af750be74f4ae5420da3484c8e8161100e68df
parent50018f80cbc035cac0ec9abd08700d00e0cca9ec (diff)
version 0.1.0.00.1.0.0
-rw-r--r--README.md5
-rw-r--r--Setup.hs2
-rw-r--r--language-elm.cabal19
-rw-r--r--src/Elm/Classes.hs16
-rw-r--r--src/Elm/Decleration.hs45
-rw-r--r--src/Elm/Expression.hs317
-rw-r--r--src/Elm/GenError.hs22
-rw-r--r--src/Elm/Import.hs79
-rw-r--r--src/Elm/Program.hs49
-rw-r--r--src/Elm/Type.hs135
-rw-r--r--test/Renderer.hs28
-rw-r--r--test/Spec.hs630
12 files changed, 782 insertions, 565 deletions
diff --git a/README.md b/README.md
index 746fc00..cb1bebc 100644
--- a/README.md
+++ b/README.md
@@ -7,6 +7,10 @@ Install language-elm from stack
stack install language-elm
```
+## Documentation
+[Documentation](https://hackage.haskell.org/package/language-elm)
+
+<!--
Import the libraries
```haskell
import Elm.Decleration
@@ -85,3 +89,4 @@ mapSecond :: (a -> b) -> ((a1, a)) -> ((a1, b))
mapSecond func (x, y) = (x, func y)
```
+-->
diff --git a/Setup.hs b/Setup.hs
index 9a994af..4467109 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,2 @@
-import Distribution.Simple
+import Distribution.Simple
main = defaultMain
diff --git a/language-elm.cabal b/language-elm.cabal
index 0593a62..a15f9ab 100644
--- a/language-elm.cabal
+++ b/language-elm.cabal
@@ -1,5 +1,5 @@
name: language-elm
-version: 0.0.10.1
+version: 0.1.0.0
synopsis: Generate elm code
description: Generate elm code from an ast
homepage: https://github.com/eliaslfox/language-elm#readme
@@ -15,20 +15,25 @@ cabal-version: >=1.10
library
hs-source-dirs: src
- exposed-modules: Elm.Decleration, Elm.Expression, Elm.Import, Elm.Program, Elm.Type
- build-depends: base >= 4.7 && < 5,
- pretty,
- MissingH
+ exposed-modules: Elm.Decleration, Elm.Expression, Elm.Import, Elm.Program, Elm.Type, Elm.Classes, Elm.GenError
+ build-depends: base >= 4.9.1 && < 4.10,
+ pretty >= 1.1.3 && < 1.2,
+ MissingH >= 1.4.0 && < 1.5,
+ mtl >= 2.2.1 && < 2.3,
+ protolude >= 0.2 && < 0.3
default-language: Haskell2010
test-suite language-elm-test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
+ other-modules: Renderer
build-depends: base
, language-elm
- , HUnit
- , pretty
+ , pretty >= 1.1.3 && < 1.2
+ , hspec >= 2.4.4 && < 2.5
+ , mtl >= 2.2.1 && < 2.3
+ , protolude >= 0.2 && < 0.3
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
diff --git a/src/Elm/Classes.hs b/src/Elm/Classes.hs
new file mode 100644
index 0000000..032d809
--- /dev/null
+++ b/src/Elm/Classes.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_HADDOCK -prune #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE Safe #-}
+
+-- | A series of helper classes to make writing an ast easier
+module Elm.Classes where
+
+import Protolude ()
+
+import Control.Monad.Writer
+import Elm.GenError
+import Text.PrettyPrint
+
+class Generate a where
+ generate :: a -> Writer GenError Doc
diff --git a/src/Elm/Decleration.hs b/src/Elm/Decleration.hs
index f12f3e0..5d1037c 100644
--- a/src/Elm/Decleration.hs
+++ b/src/Elm/Decleration.hs
@@ -1,11 +1,15 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Safe #-}
-- | Top level declerations
module Elm.Decleration where
-import Elm.Type
-import Elm.Expression
-import Text.PrettyPrint
+import Elm.Classes
+import Elm.Expression
+import Elm.Type
+import Text.PrettyPrint
-- | Used to declare functions, variables, and types
data Dec
@@ -16,20 +20,25 @@ data Dec
-- | Declare a type alias
| DecTypeAlias String [String] TypeDec
-toDocD :: Dec -> Doc
-toDocD dec =
- case dec of
- Dec str typeDec args body ->
- text str <+> text ":" <+> toDocT typeDec $+$
- hang (text str <+> (hsep . map toDoc $ args) <+> text "=") 4 (toDoc body)
+instance Generate Dec where
+ generate dec =
+ case dec of
+ Dec name type_ params value -> do
+ typeDoc <- generate type_
+ paramDocs <- mapM generate params
+ valueDoc <- generate value
+ return $ text name <+> ":" <+> typeDoc $+$ text name <+> hsep paramDocs <+> "=" $+$ nest 4 valueDoc
- DecTypeAlias str typeParams t->
- text "type alias" <+> text str <+> (hsep . map text $ typeParams) <+> text "=" <+> toDocT t
+ DecType name params instances -> do
+ let (keys, values) = unzip instances
+ let keyDocs = map text keys
+ valueDocs <- mapM (mapM generate) values
+ let instanceDocs = map (\(key, values') -> key <+> hsep values') $ zip keyDocs valueDocs
+ let paramDocs = map text params
+ return $ "type" <+> text name <+> hsep paramDocs $+$
+ (nest 4 $ "=" <+> head instanceDocs $+$ (vcat . map ((<+>)"|") . tail $ instanceDocs))
- DecType str typeParams types ->
- text "type" <+> text str <+> (hsep . map text $ typeParams) <+> text "=" <+>
- (hsep . punctuate (text " |") . map toDec $ types)
-
- where
- toDec (str, t) =
- text str <+> (hsep . map vopParam $ t)
+ DecTypeAlias name params type_ -> do
+ typeDoc <- generate type_
+ let paramDocs = map text params
+ return $ "type alias" <+> text name <+> hsep paramDocs <+> "=" $+$ nest 4 typeDoc
diff --git a/src/Elm/Expression.hs b/src/Elm/Expression.hs
index e17d8b5..d9f0f10 100644
--- a/src/Elm/Expression.hs
+++ b/src/Elm/Expression.hs
@@ -1,126 +1,211 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Werror -Wall #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Safe #-}
-- | Used to declare expressions
-module Elm.Expression where
+module Elm.Expression
+ ( Expr(..)
+ ) where
-import Text.PrettyPrint hiding (Str)
-import Data.Maybe
+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)
-- | The expression type
-data Expr
- -- | Function application
- = App String [Expr]
- | Case Expr [(Expr, Expr)]
- | Let Expr [(Expr, Expr)]
- | List [Expr]
- | Tuple2 Expr Expr
- | Tuple3 Expr Expr Expr
- -- | Inline operators
- | Op String Expr Expr
- -- | Expressions wrapped in parens
- | Parens Expr
- -- | String literals
+data Expr {-
+ Constants
+ -}
+ -- | A boolean literal
+ = Bool Bool
+ -- | A string literal
| Str String
- -- | Integer literals
+ -- | An integer literal
| Int Int
- -- | The underscore placeholder
+ -- | A float literal
+ | Float Float
+ -- | An underscore variable placeholder
| Under
- -- | Boolean false literal
- | BoolTrue
- -- | Boolean true literal
- | BoolFalse
- -- | Record creation and update syntax
- | Record (Maybe Expr) [(String, Expr)]
-
--- | Shortcut for variables
-var :: String -> Expr
-var str = App str []
-
--- Takes an expression
--- if its a single variable or tuple then id
--- else wrap it in parens
-vop :: Expr -> Doc
-vop expr =
- case expr of
- App str [] ->
- text str
-
- Tuple2 exp1 exp2 ->
- toDoc $ Tuple2 exp1 exp2
-
- Tuple3 expr1 expr2 expr3 ->
- toDoc $ Tuple3 expr1 expr2 expr3
-
- Str str ->
- doubleQuotes $ text str
-
- Record a b ->
- toDoc $ Record a b
-
- other ->
- parens $ toDoc other
-
-toDoc :: Expr -> Doc
-toDoc expr =
- case expr of
- App str exprs ->
- text str <+> (hsep . map vop $ exprs)
-
- Tuple2 expr1 expr2 ->
- parens $ toDoc expr1 <> comma <+> toDoc expr2
-
- Tuple3 expr1 expr2 expr3 ->
- parens $ toDoc expr1 <> comma <+> toDoc expr2 <> comma <+> toDoc expr3
-
- Str str ->
- doubleQuotes . text $ str
-
- Op op expr1 expr2 ->
- vop expr1 <+> text op <+> vop expr2
-
- Case expr exprs ->
- hang (text "case" <+> vop expr <+> text "of") 4 (vcat . map caseToDoc $ exprs)
-
- where
- caseToDoc (expr1, expr2) =
- toDoc expr1 <+> text "->" $$ (nest 4 $ toDoc expr2)
-
-
- List exprs ->
- char '[' <> (hsep . punctuate (text ",") . map toDoc $ exprs) <> char ']'
-
- Let expr exprs ->
- text "let" $+$ (nest 4 . vcat . map letToDoc $ exprs) $+$ text "in" $+$ (nest 4 $ toDoc expr)
-
- where
- letToDoc (expr1, expr2) =
- toDoc expr1 <+> char '=' <+> toDoc expr2
-
- Int i ->
- int i
-
- Under ->
- char '_'
-
- BoolTrue ->
- text "True"
-
- BoolFalse ->
- text "False"
-
- Record Nothing [] ->
- text "{}"
-
- Record (Just main) [] ->
- toDoc main
+ {-
+ Inline
+ -}
+ -- | A variable
+ | Var String
+ -- | Function application, the tail is applied to the head
+ | App [Expr]
+ -- | A list of expressions
+ | List [Expr]
+ -- | Apply an inline operator to two expressions
+ | Op String
+ Expr
+ Expr
+ -- | A tuple of expressions
+ | Tuple [Expr]
+ -- | A record, the first paramater is an optional record to update from
+ | Record (Maybe Expr)
+ [(String, Expr)]
+ {-
+ Multi Line
+ -}
+ -- | A let expression
+ | Let Expr
+ [(Expr, Expr)]
+ -- | A case expression
+ | Case Expr
+ [(Expr, Expr)]
+ {-
+ Util
+ -}
+ -- | Wrap an expression in parens, should be mostly automatic
+ | Parens Expr
- Record main parts ->
- let
- front = fmap (\x -> toDoc x <+> char '|') main
- in
- char '{' <+> (Data.Maybe.fromMaybe empty front)
- <+> nest 4 (hsep . punctuate (char ',') . map docPart $ parts)
- <+> char '}'
- where
- docPart (name, value) =
- text name <+> char '=' <+> toDoc value
+-- | Allows creating variables with overloaded strings
+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 []
+ -- I don't think this has a valid meaning
+ -> do
+ tell $ Error "Invalid syntax, trying to apply nothing"
+ return $ text ""
+ App [expr'] -> generate expr'
+ App exprs
+ -- If only I could understand my own code :(
+ -> 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) $
+ -- I would love for someone, somewhere, to get this warning
+ 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)) []
+ -- tbh, what would you even be trying to do?
+ -> 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 _) _
+ -- This seems to be how it is
+ -> 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
+ -- Generates the list of key value pairs in a record
+ 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
+ -- Generates the list of declerations in a let expression
+ 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
+ -- Generates the list of cases in a case statement
+ 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
+ -- takes an expression and wraps it in parens
+ -- if required for nesting it in another expression
+ 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
diff --git a/src/Elm/GenError.hs b/src/Elm/GenError.hs
new file mode 100644
index 0000000..6ee0e24
--- /dev/null
+++ b/src/Elm/GenError.hs
@@ -0,0 +1,22 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE Strict #-}
+
+module Elm.GenError where
+
+import Protolude
+
+import Data.String
+
+data GenError
+ = WarningList [String]
+ | Error String
+ deriving (Eq, Show)
+
+instance Monoid GenError where
+ mappend (Error str) _ = Error str
+ mappend _ (Error str) = Error str
+ mappend (WarningList a) (WarningList b) = WarningList $ a ++ b
+ mempty = WarningList []
diff --git a/src/Elm/Import.hs b/src/Elm/Import.hs
index b83ad5c..9b05195 100644
--- a/src/Elm/Import.hs
+++ b/src/Elm/Import.hs
@@ -1,61 +1,72 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Safe #-}
-- | Ast for expressing imports
module Elm.Import where
-import Text.PrettyPrint
+import Protolude hiding (empty, (<>))
+
+import Control.Monad (mapM)
+import Data.Maybe
+import Data.String
+import Elm.Classes
+import Text.PrettyPrint
-- | Possible ways to expose an import
data ImportType
= Everything
| Select [ImportItem]
- | ExposeNothing
-- | Possible ways to expose a sub import
-data ImportItem
+data ImportItem
= Item String
| ItemExposing String [String]
| ItemEvery String
-- | A full import
-data Import = Import String (Maybe String) ImportType
+data Import = Import String (Maybe String) (Maybe ImportType)
-docItem :: ImportItem -> Doc
-docItem item =
- case item of
- Item str ->
- text str
+instance Generate ImportItem where
+ generate item =
+ case item of
+ Item str ->
+ return . text $ str
- ItemExposing name exposes ->
- text name <> (parens . hsep . punctuate (text ",") . map text $ exposes)
+ ItemExposing str [] ->
+ return $ text str <> "()"
- ItemEvery name ->
- text name <> text "(..)"
+ ItemExposing str exposedItems ->
+ return $ text str <> (parens . hsep . punctuate "," . map text $ exposedItems)
-exposingDoc :: ImportType -> Doc
-exposingDoc importType =
- case importType of
- Everything ->
- text "exposing (..)"
+ ItemEvery str ->
+ return $ text str <> "(..)"
- ExposeNothing ->
- empty
+instance Generate ImportType where
+ generate item =
+ case item of
+ Everything ->
+ return "(..)"
- Select imports ->
- text "exposing" <+> (parens . hsep . punctuate (text ",") . map docItem $ imports)
+ Select [] -> do
+ return "()"
-toDocI :: Import -> Doc
-toDocI (Import name as exposing) =
- text "import" <+> text name <+> asDoc <+> exposingDoc exposing
+ Select items -> do
+ docItems <- mapM generate items
+ return $ parens . hsep . punctuate "," $ docItems
- where
- asDoc =
- case as of
- Nothing ->
- empty
- Just str ->
- text "as" <+> text str
-
-
+instance Generate Import where
+ generate (Import name as exposing) = do
+ let asDoc = Data.Maybe.fromMaybe empty $ fmap (\str -> "as" <+> text str) $ as
+ exposingDoc <-
+ case exposing of
+ Nothing ->
+ return empty
+ Just e -> do
+ docE <- generate e
+ return $ "exposing" <+> docE
+ return $ "import" <+> text name <+> asDoc <+> exposingDoc
diff --git a/src/Elm/Program.hs b/src/Elm/Program.hs
index 2c60061..d06a678 100644
--- a/src/Elm/Program.hs
+++ b/src/Elm/Program.hs
@@ -1,33 +1,48 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- {-# LANGUAGE Safe #-}
-- | Module for creating a program
module Elm.Program where
-import Elm.Import
-import Elm.Decleration
-import Text.PrettyPrint
-import Data.String.Utils
-import Data.List
+import Protolude hiding (join)
+
+import Control.Monad.Writer hiding (join)
+import Data.List hiding (map)
+import Data.String
+import Data.String.Utils
+import Elm.Classes
+import Elm.Decleration
+import Elm.GenError
+import Elm.Import
+import Text.PrettyPrint
-- | Program type
data Program = Program String ImportType [Import] [Dec]
-genProgram :: Program -> Doc
-genProgram (Program name exports imports declerations) =
- text "module" <+> text name <+> exposingDoc exports
- $+$ (foldl ($+$) empty . map toDocI $ imports)
- $+$ (foldl ($+$) empty . map toDocD $ declerations)
+instance Generate Program where
+ generate (Program name exports imports declerations) = do
+ exportDoc <- generate exports
+ importDocs <- mapM generate imports
+ decDocs <- mapM generate declerations
+ return $ "module" <+> text name <+> "exposing" <+> exportDoc $+$
+ vcat importDocs $+$
+ vcat decDocs
+
--- | Convert a program to a string of code
-renderProgram :: Program -> String
+-- | Convert a program to a string of code with newlines between declerations
+renderProgram :: Program -> (String, GenError)
renderProgram program =
- let
- str = (render . genProgram $ program) ++ "\n"
+ let
+ (doc, parseError) = runWriter $ generate program
+ str = render doc
in
- join "\n" . map addNewline . split "\n" $ str
+ ((join "\n" . map addNewline . split "\n" $ str)++"\n", parseError)
where
addNewline line =
- if (or $ map (\s -> isInfixOf s line) ["::", "type"]) then
- "\n" ++ line
+ if (or $ map (\s -> isInfixOf s line) [":", "type"]) then
+ "\n\n" ++ line
else
line
diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs
index c4d7673..62668cc 100644
--- a/src/Elm/Type.hs
+++ b/src/Elm/Type.hs
@@ -1,12 +1,17 @@
{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
-- | Ast for declaring types
module Elm.Type where
-import Elm.Expression
-import Text.PrettyPrint
-import Data.Maybe
+import Control.Monad.Writer (tell)
+import Data.List (intersperse)
+import Data.Maybe
+import Data.String
+import Elm.Classes
+import Elm.Expression
+import Elm.GenError
+import Text.PrettyPrint
-- | Data type to represent types
data TypeDec
@@ -14,63 +19,71 @@ data TypeDec
= Params String [TypeDec]
-- | A function type
| TApp [TypeDec]
- -- | A two tuple type
- | TTuple2 TypeDec TypeDec
+ -- | A tuple type
+ | TTuple [TypeDec]
-- | A record type
| TRecord (Maybe String) [(String, TypeDec)]
--- | Shortcut for declaring a type variable
-tvar :: String -> TypeDec
-tvar str =
- Params str []
-
-vopTApp :: TypeDec -> Doc
-vopTApp t =
- case t of
- Params str types ->
- toDocT $ Params str types
-
- TRecord main decs ->
- toDocT $ TRecord main decs
-
- _ ->
- parens $ toDocT t
-
-vopParam :: TypeDec -> Doc
-vopParam t =
- case t of
- Params str [] ->
- text str
-
- _ ->
- parens $ toDocT t
-
-
-toDocT :: TypeDec -> Doc
-toDocT t =
- case t of
- Params p decs ->
- text p <+> (hsep . map vopParam $ decs)
-
- TApp types ->
- hsep . punctuate (text " ->") . map vopTApp $ types
-
- TTuple2 t1 t2 ->
- lparen <> toDocT t1 <> comma <+> toDocT t2 <> rparen
-
- TRecord Nothing [] ->
- "{}"
-
- TRecord (Just main) [] ->
- text main
-
- TRecord main decs ->
- let
- front = fmap (\x -> text x <+> "|") main
- in
- "{" <+> Data.Maybe.fromMaybe empty front
- <+> (hsep . punctuate "," . map docDec $ decs)
- <+> "}"
- where
- docDec (name, dec) =
- text name <+> ":" <+> toDocT dec
+instance IsString TypeDec where
+ fromString x = Params x []
+
+instance Generate TypeDec where
+ generate typeDec =
+ case typeDec of
+ Params type_ params -> do
+ docParams <- mapM vopParam params
+ return $ text type_ <+> hsep docParams
+
+ TApp decs -> do
+ docDecs <- mapM vopTApp decs
+ return . hsep . intersperse "->" $ docDecs
+
+ TTuple [] -> do
+ return "()"
+
+ TTuple [item] -> do
+ tell $ WarningList ["Attempt to create a one item tuple"]
+ parens <$> generate item
+ TTuple items -> do
+ docItems <- mapM generate items
+ return . parens . hsep . punctuate "," $ docItems
+
+ TRecord Nothing [] -> do
+ tell $ Error "Unable to create a record type with no base and no constraints"
+ return ""
+
+ TRecord (Just str) [] -> do
+ tell $ WarningList ["You are creating a record type from " ++ str ++ " with no constraints"]
+ return . text $ str
+
+ TRecord Nothing constraints -> do
+ cDoc <- generateTRecordList constraints
+ return $ lbrace <+> cDoc <+> rbrace
+
+ TRecord (Just str) constraints -> do
+ cDoc <- generateTRecordList constraints
+ return $ lbrace <+> text str <+> text "|" <+> cDoc <+> rbrace
+
+ where
+ generateTRecordList constraints = do
+ let (keys, values) = unzip constraints
+ let docKeys = map text keys
+ docValues <- mapM generate values
+ let docList = zip docKeys docValues
+ return . hsep . punctuate "," . map (\(a, b) -> a <+> ":" <+> b) $ docList
+
+ vopParam type_ =
+ case type_ of
+ Params str [] ->
+ return . text $ str
+
+ _ ->
+ parens <$> generate type_
+
+ vopTApp type_ =
+ case type_ of
+ TApp _ ->
+ parens <$> generate type_
+
+ _ ->
+ generate type_
diff --git a/test/Renderer.hs b/test/Renderer.hs
new file mode 100644
index 0000000..55fe5bf
--- /dev/null
+++ b/test/Renderer.hs
@@ -0,0 +1,28 @@
+module Renderer where
+
+import Control.Monad.Writer
+import Elm.Classes
+import Elm.Expression
+import Elm.GenError
+import Text.PrettyPrint
+
+renderExpr :: Expr -> String
+renderExpr expr =
+ let
+ (doc, err) = runWriter . generate $ expr
+ in
+ if err == WarningList [] then
+ Text.PrettyPrint.render doc
+ else
+ error $ "Generation Error: " ++ show err
+
+
+render :: (Generate a) => a -> String
+render expr =
+ let
+ (doc, err) = runWriter . generate $ expr
+ in
+ if err == WarningList [] then
+ Text.PrettyPrint.render doc
+ else
+ error $ "Generation Error: " ++ show err
diff --git a/test/Spec.hs b/test/Spec.hs
index d57bdd5..b7b2252 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,324 +1,332 @@
{-# LANGUAGE OverloadedStrings #-}
-module Main where
+import Control.Monad.Writer
+import Elm.Classes
+import Elm.Decleration
+import Elm.Expression
+import Elm.GenError
+import Elm.Import
+import Elm.Program
+import Elm.Type
+import Renderer
+import Test.Hspec
+import Text.PrettyPrint hiding (Str, render)
-import Test.HUnit
-import Elm.Expression
-import Elm.Type
-import Elm.Decleration
-import Elm.Import
-import Elm.Program
-import Text.PrettyPrint hiding (Str)
-import Control.Monad
-
-assertString :: String -> String -> String -> Assertion
-assertString preface expected actual =
- unless (actual == expected) (assertFailure msg)
- where msg = (if null preface then "" else preface ++ "\n") ++
- "expected:\n\n" ++ expected ++ "\n but got:\n\n" ++ actual ++
- "\n" ++ (show . length $ expected) ++ " - "
- ++ (show . length $ actual)
-
-testRender ast =
- (render . toDoc $ ast) ++ "\n"
-
-testRenderDec ast =
- (render . toDocD $ ast) ++ "\n"
-
-testApp =
- [ do
- assertEqual "No arguments" (text "f") (toDoc $ App "f" [])
- , do
- assertEqual "single var" (text "f a") (toDoc $ App "f" [App "a" []])
- assertEqual "two vars" (text "f a b") (toDoc $ App "f" [App "a" [], App "b" []])
- , do
- assertEqual "parens" (text "f (a b)") (toDoc $ App "f" [App "a" [App "b" []]])
- ]
-
-testCase =
- [ do
- text <- readFile "test/case1.txt"
- let
- ast =
- Case (App "color" [])
- [ (App "Red" [], Str "red")
- , (App "Blue" [], Str "blue")
- , (App "Green" [], Str "green")
- ]
- assertEqual "colors" text $ testRender ast
- , do
- text <- readFile "test/case2.txt"
- let
- ast =
- Case (App "m" [])
- [ (App "Just" [var "data"], var "data")
- , (var "Nothing", Str "")
- ]
- assertEqual "maybe" text $ testRender ast
- , do
- text <- readFile "test/case3.txt"
- let
- ast =
- Case (Tuple2 (var "a") (var "b"))
- [ (Tuple2 (Int 1) (Int 2), BoolTrue)
- , (Under, BoolFalse)
- ]
- assertEqual "tuple" text $ testRender ast
- , do
- text <- readFile "test/case4.txt"
- let
- ast =
- Case (App "f" [var "x"])
- [ (BoolTrue, Str "true")
- , (BoolFalse, Str "false")
- ]
-
- assertEqual "application" text $ testRender ast
- , do
- text <- readFile "test/case5.txt"
- let
- ast =
- Case (var "b")
- [ (BoolTrue,
- Let (Str "true")
- [ (Under, App "Debug.log" [Str "logging", Str "its true"])
- ])
- , (BoolFalse,
- Let (Str "false")
- [ (Under, App "Debug.log" [Str "logging", Str "its false"])
- ])
- ]
-
- assertEqual "let in case" text $ testRender ast
- ]
-
-testLet =
- [ do
- text <- readFile "test/let1.txt"
- let
- ast =
- Let (var "a")
- [ (var "a", Int 5) ]
-
- assertEqual "application" text $ testRender ast
- , do
- text <- readFile "test/let2.txt"
- let
- ast =
- Let (App "f" [var "a", var "b"])
- [ (var "a", Int 5)
- , (var "b", Int 6)
- ]
- assertEqual "more variables" text $ testRender ast
- ]
-
-testOp =
- [ do
- assertEqual "plus" (text "a + b") (toDoc $ Op "+" (var "a") (var "b"))
- assertEqual "compose" (text "a <<< b") (toDoc $ Op "<<<" (var "a") (var "b"))
- assertEqual "longer names" (text "abc >>> def")
- (toDoc $ Op ">>>" (var "abc") (var "def"))
- assertEqual "parens" (text "(f a) + (g b)")
- (toDoc $ (Op "+" (App "f" [var "a"]) (App "g" [var "b"])))
- ]
-
-testList =
- [ do
- assertEqual "empty" (text "[]") (toDoc $ List [])
- , do
- assertEqual "some stuff" (text "[1, 2, 3]")
- (toDoc $ List [Int 1, Int 2, Int 3])
- ]
-
-testRecord =
- [ do
- assertEqual "empty" (text "{}") (toDoc $ Record Nothing [])
- assertEqual "no sets" (text "a") (toDoc $ Record (Just $ var "a") [])
- assertEqual "some stuff"
- (text "{ a | b = 5 }")
- (toDoc $ Record (Just $ var "a") [("b", Int 5)])
- ]
+main = hspec $ do
+ describe "Setup" $ do
+ it "Should work" $ do
+ 5 `shouldBe` 5
+ describe "Expression" $ do
+ describe "Bool" $ do
+ it "Should render true properly" $ do
+ let expr = Bool True
+ renderExpr expr `shouldBe` "True"
+ it "Should render false properly" $ do
+ let expr = Bool False
+ renderExpr expr `shouldBe` "False"
+ describe "Int" $ do
+ it "Should work" $ do
+ renderExpr (Int 5) `shouldBe` "5"
+ describe "Float" $ do
+ it "Should work" $ do
+ renderExpr (Float 1.2) `shouldBe` "1.2"
+ describe "String" $ do
+ it "Should work" $ do
+ renderExpr (Str "hello") `shouldBe` "\"hello\""
+ describe "Tuple" $ do
+ it "Should work for 0 tuples" $ do
+ renderExpr (Tuple []) `shouldBe` "()"
+ it "Should work for larger tuples" $ do
+ renderExpr (Tuple [Int 5, Int 6]) `shouldBe` "( 5, 6 )"
+ renderExpr (Tuple [Int 2, Float 2.5]) `shouldBe` "( 2, 2.5 )"
+ describe "Var" $ do
+ it "Should work" $ do
+ renderExpr (Var "a") `shouldBe` "a"
+ renderExpr (Var "abc") `shouldBe` "abc"
+ it "Should work with overloadedstrings" $ do
+ renderExpr "a" `shouldBe` "a"
+ renderExpr "abc" `shouldBe` "abc"
+ it "Should error on an empty string" $ do
+ (runWriter . generate $ Var "") `shouldBe` (text "", Error "An empty string is not a valid variable name")
+ it "Should wrap operators in parens" $ do
+ pending
+ it "Should only allow operators with valid characters" $ do
+ pending
+ it "Should only allow variables with valid characters" $ do
+ pending
+ describe "Under" $ do
+ it "Does this I guess" $ do
+ renderExpr Under `shouldBe` "_"
+ describe "List" $ do
+ it "Should work for empty lists" $ do
+ renderExpr (List []) `shouldBe` "[]"
+ it "Should work for single item lists" $ do
+ renderExpr (List ["a"]) `shouldBe` "[a]"
+ it "Should work for multi item lists" $ do
+ renderExpr (List ["a", "b", "c"]) `shouldBe` "[a, b, c]"
+ it "Should work with overloaded lists" $ do
+ renderExpr (List ["a", "b", "c"]) `shouldBe` "[a, b, c]"
+ describe "Function Application" $ do
+ it "Should work for 0 params" $ do
+ renderExpr (App ["a"]) `shouldBe` "a"
+ it "Should work for multiple params" $ do
+ renderExpr (App ["a", "b", "c"]) `shouldBe` "a b c"
+ renderExpr (App ["a", Int 5, "b", Int 7]) `shouldBe` "a 5 b 7"
+ it "Should nest properly" $ do
+ renderExpr (App ["a", App ["b", "c"]]) `shouldBe` "a (b c)"
+ describe "Inline operators" $ do
+ it "Should work" $ do
+ renderExpr (Op "+" "a" "b") `shouldBe` "a + b"
+ it "Should error on invalid operator characters" $ do
+ pending
+ describe "Record" $ do
+ it "Should work when empty" $ do
+ renderExpr (Record Nothing []) `shouldBe` "{}"
+ it "Should work with key value pairs" $ do
+ renderExpr (Record Nothing [("a", Int 5), ("b", Int 6)])
+ `shouldBe` "{ a = 5, b = 6 }"
+ it "Should allow updates" $ do
+ renderExpr (Record (Just "a") [("b", Int 5)])
+ `shouldBe` "{ a | b = 5 }"
+ it "Should warn here" $ do
+ (runWriter . generate $ Record (Just "data") [])
+ `shouldBe` ("data", WarningList ["Trying to update record data with no changed fields"])
+ it "Should error here" $ do
+ (runWriter . generate $ Record (Just $ App ["f", Int 5]) [])
+ `shouldBe` ("", Error "You are unable to update a record with a non constant")
+ describe "Let" $ do
+ it "Should work with one dec" $ do
+ text <- liftIO . readFile $ "test/spec/let1.txt"
+ let
+ ast = Let "a" [("a", Int 5)]
+ renderExpr ast ++ "\n" `shouldBe` text
+ it "Should work with more than one dec" $ do
+ text <- liftIO . readFile $ "test/spec/let2.txt"
+ let
+ ast = Let (Op "+" "a" "b") [("a", Int 5), ("b", Int 6)]
+ renderExpr ast ++ "\n" `shouldBe` text
+ it "Should error with zero declerations" $ do
+ (runWriter . generate $ Let "a" [])
+ `shouldBe` ("", Error "Unable to create let expression with 0 bindings")
+ describe "Case" $ do
+ it "Should work" $ do
+ text <- liftIO . readFile $ "test/spec/case1.txt"
+ let
+ ast =
+ Case "m"
+ [(App ["Just", "x"], "x")
+ ,("Nothing", Int 0)
+ ]
+ renderExpr ast ++ "\n" `shouldBe` text
+ it "Should generate an error with no cases" $ do
+ let
+ ast = Case "m" []
+ (runWriter . generate $ ast)
+ `shouldBe` ("", Error "Unable to create case expression with 0 cases")
-testType =
- [ do
- assertEqual "simple" (text "a") (toDocT $ tvar "a")
- assertEqual "param" (text "Maybe a") (toDocT $ Params "Maybe" [tvar "a"])
- assertEqual "multi param" (text "Result String Int")
- (toDocT $ Params "Result" [tvar "String", tvar "Int"])
- , do
- assertEqual "app" (text "a -> b")
- (toDocT $ TApp [tvar "a", tvar "b"])
- assertEqual "more app" (text "a -> b -> c")
- (toDocT $ TApp [tvar "a", tvar "b", tvar "c"])
- assertEqual "nested app" (text "(a -> b) -> a -> b")
- (toDocT $ TApp [TApp [tvar "a", tvar "b"], tvar "a", tvar "b"])
- , do
- assertEqual "more nested stuff" (text "Maybe (a -> b) String")
- (toDocT $ Params "Maybe" [TApp [tvar "a", tvar "b"], tvar "String"])
- assertEqual "alternate nesting" (text "Maybe (Maybe a)")
- (toDocT $ Params "Maybe" [Params "Maybe" [tvar "a"]])
- , do
- assertEqual "record types" (text "{}") (toDocT $ TRecord Nothing [])
- assertEqual "memier record types"
- (text "{ a : Int, b : Int }")
- (toDocT $ TRecord Nothing [("a", tvar "Int"), ("b", tvar "Int")])
- assertEqual "the dankest rarest memes"
- (text "{ a | b : Int }")
- (toDocT $ TRecord (Just "a") [("b", tvar "Int")])
- ]
+ describe "Type" $ do
+ describe "Params" $ do
+ it "Should work for without params" $ do
+ render (Params "a" [])
+ `shouldBe` "a"
+ it "Should work with params" $ do
+ render (Params "a" [Params "b" []])
+ `shouldBe` "a b"
+ it "Should put params in parens if needed" $ do
+ render (Params "a" [Params "b" [Params "c" []]])
+ `shouldBe` "a (b c)"
-testDec =
- [ do
- text <- readFile "test/dec.txt"
- let
- ast =
- Dec
- "withDefault"
- (TApp [tvar "a", Params "Maybe" [tvar "a"], tvar "a"])
- [var "default", var "maybe"]
- (Case
- (var "maybe")
- [ (App "Just" [var "data"], var "data")
- , (var "Nothing", var "default")
- ])
- assertEqual "test" text $ testRenderDec ast
- ]
+ describe "TApp" $ do
+ it "Should work" $ do
+ render (TApp [Params "a" [], Params "b" []])
+ `shouldBe` "a -> b"
-testDecType =
- [ do
- assertEqual "what even goes here?" (text "type User = User String")
- (toDocD $ DecType "User" [] [("User", [tvar "String"])])
- assertEqual "que??" (text "type Color = Red | Blue | Green")
- (toDocD $ DecType "Color" [] [("Red", []), ("Blue", []), ("Green", [])])
- assertEqual ":(" (text "type Data = DataA (Maybe String) | DataB (String -> Int)")
- (toDocD $ DecType "Data" []
- [ ("DataA", [Params "Maybe" [tvar "String"]])
- , ("DataB", [TApp [tvar "String", tvar "Int"]])
- ])
- assertEqual "noh" (text "type Maybe a = Nothing | Just a")
- (toDocD $ DecType "Maybe" ["a"]
- [ ("Nothing", [])
- , ("Just", [tvar "a"])
- ])
- ]
+ it "Should put nested tapps in parens" $ do
+ render (TApp [Params "a" [], TApp [Params "a" [], Params "b" []]])
+ `shouldBe` "a -> (a -> b)"
-testDecTypeAlias =
- [ do
- assertEqual "this stuff" (text "type alias Model = Int")
- (toDocD $ DecTypeAlias "Model" [] (tvar "Int"))
- assertEqual "dubple" (text "type alias Duple a = (a, a)")
- (toDocD $ DecTypeAlias "Duple" ["a"] $ TTuple2 (tvar "a") (tvar "a"))
- ]
+ describe "TTuple" $ do
+ it "Should work for unit" $ do
+ render (TTuple []) `shouldBe` "()"
-testImport =
- [ do
- assertEqual "wut" (text "import List") (toDocI $ Import "List" Nothing ExposeNothing)
- assertEqual "wut" (text "import List as L") (toDocI $ Import "List" (Just "L") ExposeNothing)
- assertEqual "wut" (text "import List exposing (map)") (toDocI $ Import "List" Nothing $ Select [Item "map"])
- assertEqual "wut" (text "import List as L exposing (map)")
- (toDocI $ Import "List" (Just "L") $ Select [Item "map"])
- assertEqual "wut" (text "import List exposing (List(..))")
- (toDocI $ Import "List" Nothing $ Select [ItemEvery "List"])
- assertEqual "wut" (text "import List exposing (List(Cons))")
- (toDocI $ Import "List" Nothing $ Select [ItemExposing "List" ["Cons"]])
- ]
+ it "Should return the value and warn with a one item tuple" $ do
+ let
+ ast =
+ TTuple [Params "a" []]
+ (runWriter . generate $ ast)
+ `shouldBe` ("(a)", WarningList ["Attempt to create a one item tuple"])
+ it "Should work for multiple item tuples" $ do
+ render (TTuple [Params "a" [], Params "b" []])
+ `shouldBe` "(a, b)"
-testProgram =
- [ do
- file <- readFile "test/program1.elm"
+ describe "TRecord" $ do
+ it "Should error when passed nothing" $ do
+ let
+ ast =
+ TRecord Nothing []
+ (runWriter . generate $ ast)
+ `shouldBe` ("", Error "Unable to create a record type with no base and no constraints")
- let
- ast =
- Program
- "Maybe"
- (Select
- [ ItemExposing "Maybe" ["Just", "Nothing"]
- , Item "andThen"
- , Item "map"
- , Item "map2"
- , Item "map3"
- , Item "map4"
- , Item "map5"
- , Item "withDefault"
- ])
+ it "Should warn when there are no constraints" $ do
+ let
+ ast =
+ TRecord (Just "a") []
+ (runWriter . generate $ ast)
+ `shouldBe` ("a", WarningList ["You are creating a record type from a with no constraints"])
+ it "Should work with no base" $ do
+ let
+ ast =
+ TRecord Nothing
+ [ ("a", Params "Int" [])
+ , ("b", Params "Int" [])
+ ]
+ render ast `shouldBe` "{ a : Int, b : Int }"
- []
- [ DecType "Maybe" ["a"] [ ("Nothing", []), ("Just", [tvar "a"]) ]
- , Dec "withDefault"
- (TApp [tvar "a", Params "Maybe" [tvar "a"], tvar "a"])
- [var "default", var "maybe"]
- (Case (var "maybe")
- [ (App "Just" [var "value"], var "value")
- , (var "Nothing", var "default")
- ])
- , Dec "map"
- (TApp
- [ TApp [tvar "a", tvar "b"]
- , Params "Maybe" [tvar "a"]
- , Params "Maybe" [tvar "b"]
- ])
- [var "f", var "maybe"]
- (Case (var "maybe")
- [ (App "Just" [var "value"], App "Just" [App "f" [var "value"]])
- , (var "Nothing", var "Nothing")
- ])
- , Dec "map2"
- (TApp
- [ TApp [tvar "a", tvar "b", tvar "value"]
- , Params "Maybe" [tvar "a"]
- , Params "Maybe" [tvar "b"]
- , Params "Maybe" [tvar "value"]
- ])
- [var "func", var "ma", var "mb"]
- (Case (Tuple2 (var "ma") (var "mb"))
- [ (Tuple2 (App "Just" [var "a"]) (App "Just" [var "b"])
- , App "Just" [App "func" [var "a", var "b"]])
- , (var "_", var "Nothing")
- ])
- , Dec "map3"
- (TApp
- [ TApp
- [ tvar "a"
- , tvar "b"
- , tvar "c"
- , tvar "value"
- ]
- , Params "Maybe" [tvar "a"]
- , Params "Maybe" [tvar "b"]
- , Params "Maybe" [tvar "c"]
- , Params "Maybe" [tvar "value"]
+ it "Should work with a base" $ do
+ let
+ ast =
+ TRecord (Just "a")
+ [ ("b", Params "Int" [])
+ , ("c", Params "Int" [])
+ ]
+ render ast `shouldBe` "{ a | b : Int, c : Int }"
+ describe "Import" $ do
+ describe "ImportItem" $ do
+ it "Should work for single items" $ do
+ render (Item "Maybe")
+ `shouldBe` "Maybe"
+ it "Should work for sub importing" $ do
+ render (ItemExposing "Maybe" ["Just", "Nothing"])
+ `shouldBe` "Maybe(Just, Nothing)"
+ it "Should working for sub importing everything" $ do
+ render (ItemEvery "Maybe")
+ `shouldBe` "Maybe(..)"
+ describe "ImportType" $ do
+ it "Should properly select everything" $ do
+ render (Everything) `shouldBe` "(..)"
+ it "Should properly select only types" $ do
+ render (Select []) `shouldBe` "()"
+ it "Should properly select items" $ do
+ render (Select [Item "Just", Item "withDefault"])
+ `shouldBe` "(Just, withDefault)"
+ render (Select [ItemEvery "Just", Item "withDefault"])
+ `shouldBe` "(Just(..), withDefault)"
+ describe "Import" $ do
+ it "Should import stuff" $ do
+ render (Import "List" Nothing Nothing)
+ `shouldBe` "import List"
+ it "Should render with an alias" $ do
+ render (Import "Maybe" (Just "M") Nothing)
+ `shouldBe` "import Maybe as M"
+ it "Should expose from the imports" $ do
+ render (Import "Maybe" Nothing $ Just $ Select [Item "withDefault"])
+ `shouldBe` "import Maybe exposing (withDefault)"
+ describe "Dec" $ do
+ it "Should work for simple delcerations" $ do
+ let
+ ast =
+ Dec "add5"
+ (TApp ["Int", "Int"])
+ [Var "x"]
+ (Op "+" (Var "x") (Int 5))
+ file <- readFile "test/spec/dec1.txt"
+ render ast ++ "\n" `shouldBe` file
+ it "Should work for more complex declerations" $ do
+ let
+ ast =
+ Dec "withDefault"
+ (TApp ["a", Params "Maybe" ["a"], "a"])
+ ["default", "m"]
+ (Case "m"
+ [ (App ["Just", "x"], "x")
+ , ("Nothing", "default")
+ ])
+ file <- readFile "test/spec/dec2.txt"
+ render ast ++ "\n" `shouldBe` file
+ it "Should properly handle type declerations" $ do
+ -- \_(*_*)_/
+ let
+ ast =
+ DecType "Maybe"
+ ["a"]
+ [ ("Nothing", [])
+ , ("Just", ["a"])
+ ]
+ file <- readFile "test/spec/dec3.txt"
+ render ast ++ "\n" `shouldBe` file
+ it "Should properly handle type aliases" $ do
+ let
+ ast =
+ DecTypeAlias "Model" ["a"] (Params "Maybe" ["a"])
+ file <- readFile "test/spec/dec4.txt"
+ render ast ++ "\n" `shouldBe` file
+ describe "Program" $ do
+ it "Should work" $ do
+ let
+ ast =
+ Program "Maybe"
+ (Select
+ [ ItemExposing "Maybe" ["Just", "Nothing"]
+ , Item "andThen"
+ , Item "map"
+ , Item "map2"
+ , Item "map3"
+ , Item "map4"
+ , Item "map5"
+ , Item "withDefault"
])
- [var "func", var "ma", var "mb", var "mc"]
- (Case (Tuple3 (var "ma") (var "mb") (var "mc"))
- [ (Tuple3
- (App "Just" [var "a"])
- (App "Just" [var "b"])
- (App "Just" [var "c"]),
- (App "Just" [App "func" [var "a", var "b", var "c"]]))
- , (var "_", var "Nothing")
+ []
+ [ DecType "Maybe" ["a"]
+ [ ("Nothing", [])
+ , ("Just", ["a"])
]
- )
-
-
- ]
- Main.assertString "meh" file $ renderProgram ast
- ]
-
-tests =
- TestList
- [ "test var" ~: testApp
- , "test case" ~: testCase
- , "test let" ~: testLet
- , "test op" ~: testOp
- , "test list" ~: testList
- , "test record" ~: testRecord
- , "test type" ~: testType
- , "test dec type alias" ~: testDecTypeAlias
- , "test dec type" ~: testDecType
- , "test dec" ~: testDec
- , "test import" ~: testImport
- , "test program" ~: testProgram
- ]
-
-main :: IO Counts
-main = runTestTT tests
+ , Dec "withDefault"
+ (TApp ["a", Params "Maybe" ["a"], "a"])
+ ["default", "maybe"]
+ (Case "maybe"
+ [ (App ["Just", "value"], "value")
+ , ("Nothing", "default")
+ ])
+ , Dec "map"
+ (TApp [TApp ["a", "b"], Params "Maybe" ["a"], Params "Maybe" ["b"]])
+ ["f", "maybe"]
+ (Case "maybe"
+ [ (App ["Just", "value"], App ["Just", App ["f", "value"]])
+ , ("Nothing", "Nothing")
+ ])
+ , Dec "map2"
+ (TApp
+ [ TApp ["a", "b", "value"]
+ , Params "Maybe" ["a"]
+ , Params "Maybe" ["b"]
+ , Params "Maybe" ["value"]
+ ])
+ ["func", "ma", "mb"]
+ (Case (Tuple ["ma", "mb"])
+ [ (Tuple [App ["Just", "a"], App ["Just", "b"]],
+ App ["Just", App ["func", "a", "b"]])
+ , (Under, "Nothing")
+ ])
+ , Dec "map3"
+ (TApp
+ [ TApp ["a", "b", "c", "value"]
+ , Params "Maybe" ["a"]
+ , Params "Maybe" ["b"]
+ , Params "Maybe" ["c"]
+ , Params "Maybe" ["value"]
+ ])
+ ["func", "ma", "mb", "mc"]
+ (Case (Tuple ["ma", "mb", "mc"])
+ [ (Tuple
+ [ App ["Just", "a"]
+ , App ["Just", "b"]
+ , App ["Just", "c"]
+ ],
+ App ["Just", App ["func", "a", "b", "c"]])
+ , (Under, "Nothing")
+ ])
+ ]
+ file <- readFile "test/program1.elm"
+ let (str, err) = renderProgram ast
+ err `shouldBe` WarningList []
+ str `shouldBe` file