language-elm 0.0.10.1 → 0.1.0.0

raw patch · 12 files changed

+772/−555 lines, 12 filesdep +hspecdep +mtldep +protoludedep −HUnitdep ~MissingHdep ~basedep ~prettysetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, mtl, protolude

Dependencies removed: HUnit

Dependency ranges changed: MissingH, base, pretty

API changes (from Hackage documentation)

Files

• README.md +5/−0
• Setup.hs +1/−1
• language-elm.cabal +12/−7
• src/Elm/Classes.hs +16/−0
• src/Elm/Decleration.hs +27/−18
• src/Elm/Expression.hs +200/−115
• src/Elm/GenError.hs +22/−0
• src/Elm/Import.hs +45/−34
• src/Elm/Program.hs +32/−17
• src/Elm/Type.hs +65/−52
• test/Renderer.hs +28/−0
• test/Spec.hs +319/−311

@@ -7,6 +7,10 @@ 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 func (x, y) = (x, func y) ``` +-->

@@ -1,2 +1,2 @@-import Distribution.Simple+import           Distribution.Simple main = defaultMain

@@ -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 @@  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 

@@ -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

@@ -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 @@     -- | 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)--        DecTypeAlias str typeParams t->-            text "type alias" <+> text str <+> (hsep . map text $ typeParams) <+> text "=" <+> toDocT t+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 -        DecType str typeParams types ->-            text "type" <+> text str <+> (hsep . map text $ typeParams) <+> text "=" <+>-                (hsep . punctuate (text " |") . map toDec $ types)+             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)) -            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

@@ -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 "{}"+    {-+      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 (Just main) [] ->-            toDoc main+-- | Allows creating variables with overloaded strings+instance IsString Expr where+    fromString = Var -        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+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

@@ -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 []

@@ -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

@@ -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

@@ -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 @@     = 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 []+instance IsString TypeDec where+    fromString x = Params x [] -vopTApp :: TypeDec -> Doc-vopTApp t =-    case t of-        Params str types ->-            toDocT $ Params str types-            -        TRecord main decs ->-            toDocT $ TRecord main decs+instance Generate TypeDec where+    generate typeDec =+        case typeDec of+             Params type_ params -> do+                 docParams <- mapM vopParam params+                 return $ text type_ <+> hsep docParams -        _ ->-            parens $ toDocT t+             TApp decs -> do+                 docDecs <- mapM vopTApp decs+                 return . hsep . intersperse "->" $ docDecs -vopParam :: TypeDec -> Doc-vopParam t =-    case t of-        Params str [] ->-            text str+             TTuple [] -> do+                return "()" -        _ ->-            parens $ toDocT t-        +             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 -toDocT :: TypeDec -> Doc-toDocT t =-    case t of-        Params p decs ->-            text p <+> (hsep . map vopParam $ decs)+             TRecord Nothing [] -> do+                 tell $ Error "Unable to create a record type with no base and no constraints"+                 return "" -        TApp types ->-            hsep . punctuate (text " ->") . map vopTApp $ types-            -        TTuple2 t1 t2 ->-            lparen <> toDocT t1 <> comma <+> toDocT t2 <> rparen+             TRecord (Just str) [] -> do+                 tell $ WarningList ["You are creating a record type from " ++ str ++ " with no constraints"]+                 return . text $ str -        TRecord Nothing [] ->-            "{}"+             TRecord Nothing constraints -> do+                 cDoc <- generateTRecordList constraints+                 return $ lbrace <+> cDoc <+> rbrace -        TRecord (Just main) [] ->-            text main+             TRecord (Just str) constraints -> do+                 cDoc <- generateTRecordList constraints+                 return $ lbrace <+> text str <+> text "|" <+> cDoc <+> rbrace -        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+        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_

@@ -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

@@ -1,324 +1,332 @@ {-# LANGUAGE OverloadedStrings #-} -module Main where--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])-    ]+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) -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