diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Main where - -main :: IO () -main = putStrLn "Fuck" diff --git a/language-elm.cabal b/language-elm.cabal --- a/language-elm.cabal +++ b/language-elm.cabal @@ -1,48 +1,37 @@ -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 +name: language-elm +version: 0.0.2.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, + hs-source-dirs: src + exposed-modules: Elm.Expression, Elm.Decleration, Elm.Type, Elm.Import, Elm.Program + build-depends: base >= 4.7 && < 5, 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 + MissingH + default-language: Haskell2010 test-suite language-elm-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Spec.hs - build-depends: base + 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 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 source-repository head - type: git - location: https://github.com/eliaslfox/language-elm + type: git + location: https://github.com/eliaslfox/language-elm diff --git a/src/Decleration.hs b/src/Decleration.hs deleted file mode 100644 --- a/src/Decleration.hs +++ /dev/null @@ -1,28 +0,0 @@ -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) diff --git a/src/Elm/Decleration.hs b/src/Elm/Decleration.hs new file mode 100644 --- /dev/null +++ b/src/Elm/Decleration.hs @@ -0,0 +1,28 @@ +module Elm.Decleration where + +import Elm.Type +import Elm.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) diff --git a/src/Elm/Expression.hs b/src/Elm/Expression.hs new file mode 100644 --- /dev/null +++ b/src/Elm/Expression.hs @@ -0,0 +1,112 @@ +module Elm.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 diff --git a/src/Elm/Import.hs b/src/Elm/Import.hs new file mode 100644 --- /dev/null +++ b/src/Elm/Import.hs @@ -0,0 +1,55 @@ +module Elm.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 + + + diff --git a/src/Elm/Program.hs b/src/Elm/Program.hs new file mode 100644 --- /dev/null +++ b/src/Elm/Program.hs @@ -0,0 +1,28 @@ +module Elm.Program where + +import Elm.Import +import Elm.Decleration +import Text.PrettyPrint +import Data.String.Utils +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 diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs new file mode 100644 --- /dev/null +++ b/src/Elm/Type.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} +module Elm.Type where + +import Elm.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 diff --git a/src/Expression.hs b/src/Expression.hs deleted file mode 100644 --- a/src/Expression.hs +++ /dev/null @@ -1,112 +0,0 @@ -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 diff --git a/src/Import.hs b/src/Import.hs deleted file mode 100644 --- a/src/Import.hs +++ /dev/null @@ -1,55 +0,0 @@ -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 - - - diff --git a/src/Program.hs b/src/Program.hs deleted file mode 100644 --- a/src/Program.hs +++ /dev/null @@ -1,29 +0,0 @@ -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 diff --git a/src/Type.hs b/src/Type.hs deleted file mode 100644 --- a/src/Type.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# 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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,14 +3,13 @@ module Main where import Test.HUnit -import Expression -import Type -import Decleration -import Import -import Program +import Elm.Expression +import Elm.Type +import Elm.Decleration +import Elm.Import +import Elm.Program import Text.PrettyPrint hiding (Str) import Control.Monad -import Data.String.Utils assertString :: String -> String -> String -> Assertion assertString preface expected actual =