language-elm (empty) → 0.0.1.0
raw patch · 11 files changed
+702/−0 lines, 11 filesdep +HUnitdep +MissingHdep +basesetup-changed
Dependencies added: HUnit, MissingH, base, language-elm, pretty, regex-compat
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- app/Main.hs +4/−0
- language-elm.cabal +48/−0
- src/Decleration.hs +28/−0
- src/Expression.hs +112/−0
- src/Import.hs +55/−0
- src/Program.hs +29/−0
- src/Type.hs +68/−0
- test/Spec.hs +325/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Elias Lawson-Fox (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Elias Lawson-Fox nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# language-elm
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "Fuck"
+ language-elm.cabal view
@@ -0,0 +1,48 @@+name: language-elm+version: 0.0.1.0+synopsis: Generate elm code+description: Generate elm code from an ast+homepage: https://github.com/eliaslfox/language-elm#readme+license: BSD3+license-file: LICENSE+author: Elias Lawson-Fox+maintainer: eliaslfox@gmail.com+copyright: 2017 Elias Lawson-Fox+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Expression, Decleration, Type, Import, Program+ build-depends: base >= 4.7 && < 5, + HUnit >= 1 && < 2, + pretty,+ MissingH,+ regex-compat+ default-language: Haskell2010++executable language-elm-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , language-elm+ default-language: Haskell2010++test-suite language-elm-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , language-elm+ , HUnit+ , pretty+ , MissingH+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/eliaslfox/language-elm
+ src/Decleration.hs view
@@ -0,0 +1,28 @@+module Decleration where++import Type+import Expression+import Text.PrettyPrint++data Dec+ = Dec String TypeDec [Expr] Expr+ | DecType String [String] [(String, [TypeDec])]+ | 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++ 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)
+ src/Expression.hs view
@@ -0,0 +1,112 @@+module Expression where++import Text.PrettyPrint hiding (Str)+import Data.Maybe++data Expr+ = App String [Expr]+ | Case Expr [(Expr, Expr)]+ | Let Expr [(Expr, Expr)] + | List [Expr]+ | Tuple2 Expr Expr+ | Tuple3 Expr Expr Expr+ | Op String Expr Expr+ | Parens Expr+ | Str String+ | Int Int+ | Under+ | BoolTrue+ | BoolFalse+ | Record (Maybe Expr) [(String, Expr)]++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++ 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
+ src/Import.hs view
@@ -0,0 +1,55 @@+module Import where++import Text.PrettyPrint++data ImportType+ = Everything+ | Select [ImportItem]+ | ExposeNothing++data ImportItem + = Item String+ | ItemExposing String [String]+ | ItemEvery String++data Import = Import String (Maybe String) ImportType++docItem :: ImportItem -> Doc+docItem item =+ case item of+ Item str ->+ text str++ ItemExposing name exposes ->+ text name <> (parens . hsep . punctuate (text ",") . map text $ exposes)++ ItemEvery name ->+ text name <> text "(..)"++exposingDoc :: ImportType -> Doc+exposingDoc importType =+ case importType of+ Everything ->+ text "exposing (..)"++ ExposeNothing ->+ empty++ Select imports ->+ text "exposing" <+> (parens . hsep . punctuate (text ",") . map docItem $ imports)++toDocI :: Import -> Doc+toDocI (Import name as exposing) =+ text "import" <+> text name <+> asDoc <+> exposingDoc exposing++ where+ asDoc =+ case as of+ Nothing ->+ empty++ Just str ->+ text "as" <+> text str+ + +
+ src/Program.hs view
@@ -0,0 +1,29 @@+module Program where++import Import+import Decleration+import Text.PrettyPrint+import Data.String.Utils+import Text.Regex+import Data.List++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)++renderProgram :: Program -> String+renderProgram program =+ let + str = (render . genProgram $ program) ++ "\n"+ in+ join "\n" . map addNewline . split "\n" $ str+ where+ addNewline line =+ if (or $ map (\s -> isInfixOf s line) ["::", "type"]) then+ "\n" ++ line+ else+ line
+ src/Type.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module Type where++import Expression+import Text.PrettyPrint+import Data.Maybe++data TypeDec+ = Params String [TypeDec]+ | TApp [TypeDec]+ | TTuple2 TypeDec TypeDec+ | TRecord (Maybe String) [(String, TypeDec)]++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
+ test/Spec.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Test.HUnit+import Expression+import Type+import Decleration+import Import+import Program+import Text.PrettyPrint hiding (Str)+import Control.Monad +import Data.String.Utils++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)])+ ]++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")])+ ]++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+ ]++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"])+ ])+ ]++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"))+ ]++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"]])+ ]++testProgram =+ [ do+ file <- readFile "test/program1.elm"++ let+ ast =+ Program+ "Maybe"+ (Select + [ ItemExposing "Maybe" ["Just", "Nothing"]+ , Item "andThen"+ , Item "map"+ , Item "map2"+ , Item "map3"+ , Item "map4"+ , Item "map5"+ , Item "withDefault"+ ])++ []+ [ 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"]+ ])+ [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")+ ]+ )+ ++ ]+ 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