├── .gitignore ├── .stylish-haskell.yaml ├── .vscode └── settings.json ├── LICENSE ├── README.md ├── Setup.hs ├── default.nix ├── docs ├── all.js └── index.html ├── exe └── Main.hs ├── hinc.cabal ├── src └── Hinc │ └── Parser.hs ├── stack.yaml ├── syntax.txt ├── web └── Main.hs └── why.md /.gitignore: -------------------------------------------------------------------------------- 1 | .stack* 2 | stack.yaml.lock 3 | result -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | steps: 2 | - simple_align: 3 | cases: true 4 | top_level_patterns: true 5 | records: true 6 | 7 | # Import cleanup 8 | - imports: 9 | align: global 10 | list_align: after_alias 11 | pad_module_names: true 12 | long_list_align: inline 13 | empty_list_align: inherit 14 | list_padding: 4 15 | separate_lists: true 16 | space_surround: false 17 | 18 | # Language pragmas 19 | - language_pragmas: 20 | style: vertical 21 | align: true 22 | remove_redundant: true 23 | language_prefix: language 24 | 25 | # Remove trailing whitespace 26 | - trailing_whitespace: {} 27 | 28 | columns: 100 29 | newline: native 30 | cabal: true 31 | language_extensions: 32 | - BangPatterns 33 | - ConstraintKinds 34 | - DataKinds 35 | - DefaultSignatures 36 | - DeriveAnyClass 37 | - DeriveDataTypeable 38 | - DeriveGeneric 39 | - DerivingStrategies 40 | - DerivingVia 41 | - ExplicitNamespaces 42 | - FlexibleContexts 43 | - FlexibleInstances 44 | - FunctionalDependencies 45 | - GADTs 46 | - GeneralizedNewtypeDeriving 47 | - InstanceSigs 48 | - KindSignatures 49 | - LambdaCase 50 | - MultiParamTypeClasses 51 | - MultiWayIf 52 | - NamedFieldPuns 53 | - NoImplicitPrelude 54 | - OverloadedStrings 55 | - QuasiQuotes 56 | - RecordWildCards 57 | - ScopedTypeVariables 58 | - StandaloneDeriving 59 | - TemplateHaskell 60 | - TupleSections 61 | - TypeApplications 62 | - TypeFamilies 63 | - ViewPatterns 64 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "[haskell]": { 3 | "editor.formatOnSave": true, 4 | "editor.defaultFormatter": "vigoo.stylish-haskell" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, Alejandro Serrano 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Alejandro Serrano nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `hinc`: Haskell In New Clothes 2 | 3 | Braces-and-parens syntax for your favorite language! 4 | 5 | ### [Try it!](https://serras.github.io/hinc/) 6 | 7 | Check the fully-undocumented `hinc`-to-Haskell transpiler. 8 | 9 | ### [Why?](https://github.com/serras/hinc/blob/master/why.md) 10 | 11 | Discussions as [issues](https://github.com/serras/hinc/issues) are also welcome. 12 | 13 | ### How have you developed it? 14 | 15 | That part is actually quite cool. The whole transpiler is developed using a usual stack of `megaparsec` to parse `hinc` code and `haskell-src-exts` to pretty print Haskell code. All of this, in addition to the front-end developed with Miso, is compiled to a single JavaScript file. Really, completely serverless! -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | with (import (builtins.fetchTarball { 2 | url = "https://github.com/dmjio/miso/archive/ea25964565074e73d4052b56b60b6e101fa08bc5.tar.gz"; 3 | sha256 = "1yb9yvc0ln4yn1jk2k5kwwa1s32310abawz40yd8cqqkm1z7w6wg"; 4 | }) {}); 5 | let 6 | haskell-src-exts-src = pkgs.fetchFromGitHub { 7 | owner = "haskell-suite"; 8 | repo = "haskell-src-exts"; 9 | rev = "62e545855dd07839c06c750dc68e9b546260c25d"; 10 | sha256 = "0sqa6ylmmycllanvpbm3iq8pr0ccjx274mxlyz9symknri5q4f2x"; 11 | }; 12 | haskell-src-exts = pkgs.haskell.packages.ghcjs.callCabal2nix "haskell-src-exts" haskell-src-exts-src {}; 13 | in 14 | pkgs.haskell.packages.ghcjs.callCabal2nix "hinc" ./. { inherit haskell-src-exts; } -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Haskell In New Clothes 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /exe/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = putStrLn "Hello, Haskell!" 5 | -------------------------------------------------------------------------------- /hinc.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: hinc 3 | version: 0.1.0.0 4 | -- synopsis: 5 | -- description: 6 | -- bug-reports: 7 | license: BSD3 8 | license-file: LICENSE 9 | author: Alejandro Serrano 10 | maintainer: trupill@gmail.com 11 | -- copyright: 12 | category: Language 13 | build-type: Simple 14 | 15 | library 16 | exposed-modules: Hinc.Parser 17 | build-depends: base >=4.12 && <5, text, 18 | megaparsec >= 7, 19 | haskell-src-exts >= 1.23 && < 1.24 20 | hs-source-dirs: src 21 | default-language: Haskell2010 22 | 23 | executable hinc 24 | if impl(ghcjs) 25 | buildable: False 26 | main-is: Main.hs 27 | build-depends: base >=4.12 && <5, hinc 28 | hs-source-dirs: exe 29 | default-language: Haskell2010 30 | 31 | executable hincweb 32 | if !impl(ghcjs) 33 | buildable: False 34 | main-is: Main.hs 35 | ghcjs-options: -dedupe 36 | build-depends: base >=4.12 && <5, text, 37 | megaparsec >= 7, 38 | haskell-src-exts >= 1.23 && < 1.24, 39 | hinc, miso 40 | hs-source-dirs: web 41 | default-language: Haskell2010 -------------------------------------------------------------------------------- /src/Hinc/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# language FlexibleContexts #-} 2 | {-# language OverloadedStrings #-} 3 | module Hinc.Parser where 4 | 5 | import Control.Applicative (Alternative) 6 | import Data.Char (isPunctuation, isSymbol) 7 | import Data.List (intercalate) 8 | import Data.Maybe (fromMaybe) 9 | import qualified Data.Text as T 10 | import Data.Void 11 | import Language.Haskell.Exts.Pretty (Pretty, prettyPrint) 12 | import qualified Language.Haskell.Exts.Syntax as Hs 13 | import Text.Megaparsec 14 | import Text.Megaparsec.Char 15 | import qualified Text.Megaparsec.Char.Lexer as L 16 | 17 | type Parser = Parsec Void T.Text 18 | 19 | tester :: Pretty a => Parser a -> T.Text -> IO () 20 | tester p txt = case prettyPrint <$> parse p "test" txt of 21 | Left e -> print e 22 | Right s -> putStrLn s 23 | 24 | -- BASIC PARSERS 25 | -- ============= 26 | 27 | spaceConsumer :: Parser () 28 | spaceConsumer = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/") 29 | 30 | symbol :: T.Text -> Parser T.Text 31 | symbol = L.symbol spaceConsumer 32 | lexeme :: Parser a -> Parser a 33 | lexeme = L.lexeme spaceConsumer 34 | 35 | parens, braces, angles, brackets :: Parser a -> Parser a 36 | parens = between (symbol "(") (symbol ")") 37 | braces = between (symbol "{") (symbol "}") 38 | angles = between (symbol "<") (symbol ">") 39 | brackets = between (symbol "[") (symbol "]") 40 | 41 | semicolon, comma, colon, dot, arrow :: Parser T.Text 42 | semicolon = symbol ";" 43 | comma = symbol "," 44 | colon = symbol ":" 45 | dot = symbol "." 46 | arrow = symbol "=>" 47 | 48 | lower, upper, anyChar :: Parser Char 49 | lower = lowerChar <|> single '_' 50 | upper = upperChar 51 | anyChar = alphaNumChar <|> single '_' 52 | 53 | signed :: (Num a) 54 | => Parser () -- ^ How to consume white space after the sign 55 | -> Parser a -- ^ How to parse the number itself 56 | -> Parser a -- ^ Parser for signed numbers 57 | signed spc p = option id (L.lexeme spc sign) <*> p 58 | where 59 | sign = negate <$ single '-' 60 | 61 | punctuation :: Parser Char 62 | punctuation = satisfy (`elem` (":!|@#$%&/=?^+*,-_<>" :: String)) 63 | 64 | optionalOrEmpty :: Alternative f => f [a] -> f [a] 65 | optionalOrEmpty p 66 | = fromMaybe [] <$> optional p 67 | 68 | -- NAMES 69 | -- ===== 70 | 71 | varP, litP, nameP :: Parser (Hs.Name ()) 72 | varP 73 | = Hs.Ident () <$> lexeme ((:) <$> lower <*> many anyChar) 74 | <|> Hs.Symbol () 75 | <$> lexeme ((:) <$> satisfy (`elem` ("!|@#$%&/=?^+*,-_<>" :: String)) 76 | <*> many punctuation) 77 | litP 78 | = Hs.Ident () <$> lexeme ((:) <$> upper <*> many anyChar) 79 | <|> Hs.Symbol () <$> lexeme ((:) <$> single ':' <*> many punctuation) 80 | 81 | nameP = varP <|> litP 82 | 83 | opvarP, oplitP, opnameP :: Parser (Hs.Name ()) 84 | opvarP = Hs.Symbol () 85 | <$> lexeme ((:) <$> satisfy (\c -> c /= ':' && (isPunctuation c || isSymbol c)) 86 | <*> many punctuation) 87 | oplitP = Hs.Symbol () <$> lexeme ((:) <$> single ':' <*> many punctuation) 88 | opnameP = opvarP <|> oplitP 89 | 90 | modNameP :: Parser (Hs.ModuleName ()) 91 | modNameP 92 | = Hs.ModuleName () . intercalate "." 93 | <$> ((\(Hs.Ident _ i) -> i) <$> litP) `sepBy1` single '.' 94 | 95 | qnameP :: Parser (Hs.Name ()) -> Parser (Hs.QName ()) 96 | qnameP r 97 | = Hs.Qual () <$> brackets modNameP <*> r 98 | <|> Hs.UnQual () <$> r 99 | 100 | -- EXPRESSIONS 101 | -- =========== 102 | 103 | argP :: Parser (Hs.Name (), Maybe (Hs.Type ())) 104 | argP = (,) <$> varP <*> optional (colon >> typeP) 105 | 106 | argPPat :: Parser (Hs.Pat ()) 107 | argPPat = f <$> argP 108 | where 109 | f (nm, Nothing) = Hs.PVar () nm 110 | f (nm, Just ty) = Hs.PatTypeSig () (Hs.PVar () nm) ty 111 | 112 | -- variable, constant, or expression between parentheses 113 | basicExprP :: Parser (Hs.Exp ()) 114 | basicExprP 115 | = try (parens exprP) 116 | <|> Hs.Var () <$> qnameP varP 117 | <|> Hs.Con () <$> qnameP litP 118 | 119 | -- basic expression followed by arguments 120 | exprWithArgsP :: Parser (Hs.Exp ()) 121 | exprWithArgsP 122 | = foldl (Hs.App ()) 123 | <$> basicExprP 124 | <*> optionalOrEmpty (parens (exprP `sepBy` comma)) 125 | 126 | -- f1(...).f2(...).f3(...) and so on 127 | dottedExprP :: Parser (Hs.Exp ()) 128 | dottedExprP = f . reverse <$> dottedExprP' 129 | where 130 | f [x] = x 131 | f (x:xs) = Hs.App () x (f xs) 132 | dottedExprP' :: Parser [Hs.Exp ()] 133 | dottedExprP' = (:) <$> exprWithArgsP 134 | <*> (try (dot *> dottedExprP') 135 | <|> pure []) 136 | 137 | exprP :: Parser (Hs.Exp ()) 138 | exprP 139 | = Hs.If () <$ symbol "if" <*> parens exprP 140 | <*> exprP <* symbol "else" <*> exprP 141 | <|> Hs.Do () <$ symbol "effect" 142 | <*> braces (many stmtP) 143 | <|> braces (Hs.Let () <$> bindsP <*> exprP) 144 | <|> brackets (Hs.List () <$> exprP `sepBy` comma) 145 | <|> try (Hs.Lambda () 146 | <$> parens (argPPat `sepBy` comma) 147 | <* arrow 148 | <*> exprP) 149 | <|> Hs.Lit () <$> literalP 150 | <|> dottedExprP 151 | 152 | stmtP :: Parser (Hs.Stmt ()) 153 | stmtP = try (Hs.Generator () 154 | <$ symbol "let" 155 | <*> (Hs.PVar () <$> varP) 156 | <* symbol "=" 157 | <* (symbol "await" <|> symbol "do") 158 | <*> exprP) 159 | <|> try (Hs.LetStmt () . Hs.BDecls () <$> letBindP) 160 | <|> Hs.Qualifier () <$> exprP 161 | 162 | literalP :: Parser (Hs.Literal ()) 163 | literalP = lexeme ((\c -> Hs.Char () c ("'" <> [c] <> "'")) 164 | <$ single '\'' <*> L.charLiteral <* single '\'') 165 | <|> lexeme ((\s -> Hs.String () s ("\"" <> s <> "\"")) 166 | <$ char '"' <*> manyTill L.charLiteral (char '"')) 167 | <|> lexeme ((\i -> Hs.Int () i (show i)) 168 | <$> signed spaceConsumer (lexeme L.decimal)) 169 | -- <|> (\i -> Hs.Frac () i (show i)) 170 | -- <$> L.signed spaceConsumer (lexeme L.float) 171 | 172 | -- TYPES AND CONTEXTS 173 | -- ================== 174 | 175 | assertionP :: Parser (Hs.Asst ()) 176 | assertionP 177 | = asstNormal 178 | <$> parens (typeP `sepBy` comma) 179 | <* colon 180 | <*> tyHead 181 | <|> asstNormal 182 | <$> ((: []) <$> typeP) 183 | <* colon 184 | <*> tyHead 185 | where 186 | asstNormal :: [Hs.Type ()] -> Hs.Type () -> Hs.Asst () 187 | asstNormal [] ty = Hs.TypeA () ty 188 | asstNormal (x:xs) ty = asstNormal xs (Hs.TyApp () ty x) 189 | 190 | contextP :: Parser (Hs.Context ()) 191 | contextP 192 | = contextNormal 193 | <$ symbol "where" 194 | <*> assertionP `sepBy` comma 195 | where 196 | contextNormal [] = Hs.CxEmpty () 197 | contextNormal [x] = Hs.CxSingle () x 198 | contextNormal xs = Hs.CxTuple ()xs 199 | 200 | -- TODO: create custom prelude where Type, Unit, Arrow, Equals ... are exported 201 | tyHead :: Parser (Hs.Type ()) 202 | tyHead 203 | = Hs.TyPromoted () . Hs.PromotedCon () True 204 | <$ single '^' <*> qnameP litP 205 | <|> Hs.TyWildCard () <$ single '_' <*> optional varP 206 | <|> Hs.TyVar () <$> varP 207 | <|> Hs.TyCon () <$> qnameP litP 208 | 209 | tyvarbindP :: Parser (Hs.TyVarBind ()) 210 | tyvarbindP 211 | = try (Hs.KindedVar () <$> varP <* colon <*> typeP) 212 | <|> Hs.UnkindedVar () <$> varP 213 | 214 | typeP :: Parser (Hs.Type ()) 215 | typeP 216 | = try (tyFun <$> parens (typeP `sepBy` comma) <* arrow <*> typeP) 217 | <|> try (parens (Hs.TyKind () <$> typeP <* colon <*> typeP)) 218 | <|> try ((\vars ty ctx -> Hs.TyForall () vars ctx ty) 219 | <$> (Just <$> angles (tyvarbindP `sepBy` comma)) 220 | <*> typeP 221 | <*> optional contextP) 222 | <|> Hs.TyStar () <$ symbol "Type" 223 | <|> Hs.TyList () <$ symbol "List" <*> angles typeP 224 | <|> tyNormal <$> tyHead 225 | <*> optionalOrEmpty (parens (typeP `sepBy` comma)) 226 | <*> optionalOrEmpty (angles (typeP `sepBy` comma)) 227 | 228 | where 229 | tyFun :: [Hs.Type ()] -> Hs.Type () -> Hs.Type () 230 | tyFun [] t = t 231 | tyFun (x:xs) t = Hs.TyFun () x (tyFun xs t) 232 | tyNormal :: Hs.Type () -> [Hs.Type ()] -> [Hs.Type ()] -> Hs.Type () 233 | tyNormal ty (a:as) rs = tyNormal (Hs.TyApp () ty a) as rs 234 | tyNormal ty [] (r:rs) = tyNormal (Hs.TyApp () ty r) [] rs 235 | tyNormal ty [] [] = ty 236 | 237 | -- DECLARATIONS AND BINDS 238 | -- ====================== 239 | 240 | bindsP :: Parser (Hs.Binds ()) 241 | bindsP = Hs.BDecls () <$> declsP 242 | 243 | declsP :: Parser [Hs.Decl ()] 244 | declsP = concat <$> some (letBindP <|> ((:[]) <$> dataDeclP)) 245 | 246 | letBindP :: Parser [Hs.Decl ()] 247 | letBindP 248 | = putTogether 249 | <$ symbol "let" 250 | <*> varP 251 | <*> optionalOrEmpty (angles (tyvarbindP `sepBy` comma)) 252 | <*> optionalOrEmpty (parens (argP `sepBy` comma)) 253 | <*> optional (colon >> typeP) 254 | <*> optional contextP 255 | <* symbol "=" 256 | <*> exprP 257 | where 258 | putTogether :: Hs.Name () -> [Hs.TyVarBind ()] 259 | -> [(Hs.Name (), Maybe (Hs.Type ()))] 260 | -> Maybe (Hs.Type ()) -> Maybe (Hs.Context ()) 261 | -> Hs.Exp () -> [Hs.Decl ()] 262 | putTogether fname tyvars args result ctx body 263 | = [ Hs.TypeSig () [fname] (recreateTy tyvars ctx (map snd args) result) 264 | , Hs.FunBind () [ Hs.Match () fname (map (Hs.PVar () . fst) args) 265 | (Hs.UnGuardedRhs () body) Nothing ] ] 266 | 267 | recreateTy :: [Hs.TyVarBind ()] -> Maybe (Hs.Context ()) 268 | -> [Maybe (Hs.Type ())] -> Maybe (Hs.Type ()) 269 | -> Hs.Type () 270 | recreateTy [] Nothing args res 271 | = recreateTy2 args res 272 | recreateTy vars ctx args res 273 | = Hs.TyForall () (Just vars) ctx (recreateTy2 args res) 274 | 275 | recreateTy2 :: [Maybe (Hs.Type ())] 276 | -> Maybe (Hs.Type ()) -> Hs.Type () 277 | recreateTy2 [] Nothing 278 | = Hs.TyWildCard () Nothing 279 | recreateTy2 [] (Just r) 280 | = r 281 | recreateTy2 (Nothing : as) r 282 | = Hs.TyFun () (Hs.TyWildCard () Nothing) (recreateTy2 as r) 283 | recreateTy2 (Just a : as) r 284 | = Hs.TyFun () a (recreateTy2 as r) 285 | 286 | dataOrNewP :: Parser (Hs.DataOrNew ()) 287 | dataOrNewP 288 | = Hs.DataType () <$ symbol "data" 289 | <|> Hs.NewType () <$ symbol "newtype" 290 | 291 | dataDeclP :: Parser (Hs.Decl ()) 292 | dataDeclP 293 | = buildDataDecl 294 | <$> dataOrNewP 295 | <*> litP 296 | <*> optionalOrEmpty (angles (tyvarbindP `sepBy` comma)) 297 | <*> optional (colon *> typeP) 298 | <*> braces (constructorDeclP `sepBy` comma) 299 | <*> optionalOrEmpty (colon >> typeP `sepBy` comma) 300 | where 301 | buildDataDecl :: Hs.DataOrNew () 302 | -> Hs.Name () 303 | -> [Hs.TyVarBind ()] 304 | -> Maybe (Hs.Type ()) 305 | -> [Hs.Type () -> Hs.GadtDecl ()] 306 | -> [Hs.Type ()] 307 | -> Hs.Decl () 308 | buildDataDecl new tyname tyargs kind cons derivs -- TODO deriving 309 | = let orig 310 | = foldl (\h n -> Hs.TyApp () h (Hs.TyVar () (varKindName n))) 311 | (Hs.TyCon () (Hs.UnQual () tyname)) tyargs 312 | in Hs.GDataDecl 313 | () new Nothing 314 | (foldl (Hs.DHApp ()) (Hs.DHead () tyname) tyargs) 315 | kind (map ($ orig) cons) 316 | [Hs.Deriving () Nothing 317 | (map (Hs.IRule () Nothing Nothing . typeToDeriving) derivs)] 318 | 319 | varKindName (Hs.KindedVar _ nm _) = nm 320 | varKindName (Hs.UnkindedVar _ nm) = nm 321 | 322 | typeToDeriving :: Hs.Type () -> Hs.InstHead () 323 | typeToDeriving (Hs.TyApp _ t a) 324 | = Hs.IHApp () (typeToDeriving t) a 325 | typeToDeriving (Hs.TyCon _ nm) 326 | = Hs.IHCon () nm 327 | 328 | constructorDeclP :: Parser (Hs.Type () -> Hs.GadtDecl ()) 329 | constructorDeclP 330 | = (\nm vars flds ty ctx orig -> Hs.GadtDecl () nm vars ctx flds (ty orig)) 331 | <$> litP 332 | <*> optional (angles (tyvarbindP `sepBy` comma)) 333 | <*> optional (parens (gadtArgP `sepBy` comma)) 334 | <*> (fromMaybe id <$> optional (const <$ colon <*> typeP)) 335 | <*> optional contextP 336 | where 337 | gadtArgP :: Parser (Hs.FieldDecl ()) 338 | gadtArgP 339 | = Hs.FieldDecl () 340 | <$> some varP 341 | <* colon 342 | <*> typeP 343 | 344 | -- MODULES 345 | -- ======= 346 | 347 | moduleHeadP :: Parser (Hs.ModuleHead ()) 348 | moduleHeadP 349 | = Hs.ModuleHead () 350 | <$ symbol "module" 351 | <*> modNameP 352 | <*> pure Nothing 353 | <*> pure Nothing -- TODO: export list 354 | 355 | modulePragmaP :: Parser (Hs.ModulePragma ()) 356 | modulePragmaP 357 | = Hs.LanguagePragma () 358 | <$ symbol "use" 359 | <*> litP `sepBy1` comma 360 | 361 | moduleP :: Parser (Hs.Module ()) 362 | moduleP 363 | = flip (Hs.Module ()) 364 | <$> many modulePragmaP 365 | <*> (Just <$> moduleHeadP) 366 | <*> pure [] -- TODO: import list 367 | <*> declsP 368 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | packages: 3 | - . 4 | extra-deps: 5 | - haskell-src-exts-1.23.1 -------------------------------------------------------------------------------- /syntax.txt: -------------------------------------------------------------------------------- 1 | LEXICAL ELEMENTS 2 | ---------------- 3 | 4 | var 5 | ::= variables (start with lowercase letter) 6 | | operators not starting with : 7 | con 8 | ::= constants (start with uppercase letter) 9 | | operators starting with : 10 | 11 | literal 12 | ::= number 13 | | 'a' 14 | | "string" 15 | 16 | GENERAL 17 | ------- 18 | 19 | arg, typedvar 20 | ::= var 21 | | var ':' type 22 | 23 | EXPRESSIONS 24 | ----------- 25 | 26 | expr 27 | ::= dotted-expr 28 | | 'if' '(' expr ')' expr 'else' expr 29 | | 'effect'? '{' stmt* '}' # both pure and effectful 30 | | '[' expr* ']' 31 | | '(' arg* ')' '=>' expr 32 | | expr op expr 33 | | literal 34 | 35 | basic-expr 36 | ::= '(' expr ')' 37 | | var 38 | | con 39 | 40 | dotted-expr 41 | ::= basic-expr ('(' expr* ')')? ('.' dotted-expr)? 42 | 43 | stmt 44 | ::= let-decl 45 | | 'let' var '=' ('await' | 'do') expr 46 | | expr 47 | 48 | TYPES 49 | ----- 50 | 51 | type 52 | ::= '(' type* ')' '=>' type 53 | | '(' type ':' type ')' 54 | | '<' typedvar* '>' type context? 55 | | tyhead '<' type* '>' 56 | 57 | tyhead 58 | ::= var 59 | | con 60 | | '_' 61 | 62 | context 63 | ::= 'where' type 64 | | 'where' '(' type* ')' 65 | 66 | 67 | DECLARATIONS 68 | ------------ 69 | 70 | decl 71 | ::= let-decl 72 | | data-decl 73 | 74 | let-decl 75 | ::= 'let' var ('<' typedvar* '>')? 76 | ('(' arg* ')')? (':' type)? context? 77 | '=' expr 78 | 79 | data-decl 80 | ::= ('data' | 'newtype') con ('<' typedvar* '>')? (':' type)? 81 | '{' constructor* '}' 82 | (':' type*)? 83 | 84 | constructor 85 | ::= con ('<' typedvar* '>')? ('(' arg* ')')? 86 | (':' type)? context? -------------------------------------------------------------------------------- /web/Main.hs: -------------------------------------------------------------------------------- 1 | {-# language NamedFieldPuns #-} 2 | {-# language OverloadedStrings #-} 3 | {-# language RecordWildCards #-} 4 | 5 | module Main where 6 | 7 | import Data.List (intercalate) 8 | import Hinc.Parser 9 | import Language.Haskell.Exts.Pretty (Pretty, prettyPrint) 10 | import Miso 11 | import Miso.String (JSString, fromMisoString, toMisoString) 12 | import Text.Megaparsec 13 | 14 | main :: IO () 15 | main = startApp App {..} 16 | where 17 | initialAction = Translate 18 | model = Model (toMisoString initialCode) "" 19 | update = updateModel 20 | view = viewModel 21 | events = defaultEvents 22 | subs = [] 23 | mountPoint = Nothing 24 | logLevel = Off 25 | 26 | initialCode = unlines [ 27 | "data Maybe {" 28 | , " Nothing," 29 | , " Just(value: a)" 30 | , "} : Show, Eq" 31 | , "" 32 | , "let f(xs: List, p: (Int) => Bool): List" 33 | , " = effect {" 34 | , " let x = await xs" 35 | , " guard(p(x))" 36 | , " x.add(1).pure" 37 | , " }" 38 | ] 39 | 40 | data Model = Model { 41 | currentText :: JSString 42 | , translated :: JSString 43 | } deriving (Show, Eq) 44 | 45 | data Action 46 | = ChangeCurrentText JSString 47 | | Translate 48 | deriving (Show, Eq) 49 | 50 | updateModel :: Action -> Model -> Effect Action Model 51 | updateModel (ChangeCurrentText t) m 52 | = noEff (m { currentText = t }) 53 | updateModel Translate m 54 | = let s = fromMisoString $ currentText m 55 | in case map prettyPrint <$> Text.Megaparsec.parse declsP "test" s of 56 | Left e -> noEff (m { translated = toMisoString (show e) }) 57 | Right s -> noEff (m { translated = toMisoString (intercalate "\n\n" s) }) 58 | 59 | 60 | -- | Constructs a virtual DOM from a model 61 | viewModel :: Model -> View Action 62 | viewModel Model { currentText, translated } 63 | = div_ [ class_ "jumbotron vh-100"] [ 64 | h1_ [ class_ "display-4" ] [ text "Haskell In New Clothes" ] 65 | , p_ [ class_ "lead" ] 66 | [ text "Braces-and-parens syntax for your favorite language " 67 | , a_ [ href_ "https://github.com/serras/hinc/blob/master/why.md" ] [ text "Why?" ] ] 68 | , div_ [ class_ "row" ] [ 69 | div_ [ class_ "col" ] [ 70 | textarea_ [ class_ "form-control text-monospace" 71 | , onChange ChangeCurrentText 72 | , rows_ "10" ] 73 | [ text currentText ] 74 | ] 75 | , div_ [ class_ "col-1" ] [ 76 | button_ [ class_ "btn btn-primary" 77 | , onClick Translate ] 78 | [ text "->" ] 79 | ] 80 | , div_ [ class_ "col" ] [ 81 | textarea_ [ class_ "form-control text-monospace" 82 | , rows_ "10" 83 | , readonly_ True ] 84 | [ text translated ] 85 | ] 86 | ] 87 | , div_ [ class_ "text-muted" ] 88 | [ text "Proudly \129322 developed by " 89 | , a_ [ href_ "https://twitter.com/trupill" ] [ text "@trupill" ] 90 | , text " using " 91 | , a_ [ href_ "https://haskell-miso.org/" ] [ text "Miso 🍲" ] 92 | , text " and hosted in " 93 | , a_ [ href_ "https://github.com/serras/hinc" ] [ text "GitHub" ] 94 | ] 95 | , link_ [ rel_ "stylesheet" 96 | , href_ "https://stackpath.bootstrapcdn.com/bootstrap/4.5.2/css/bootstrap.min.css" ] 97 | ] 98 | -------------------------------------------------------------------------------- /why.md: -------------------------------------------------------------------------------- 1 | # Dressing Up Haskell 2 | 3 | Haskell is, in my opinion, one of the best languages to learn how to code in functional style. Purity by default, powerful pattern matching, and handling of effects, are key ideas which appear in full clarity in Haskell. Alas, many people find Haskell's syntax difficult at the beginning. I always feel I need to devote more time than I should when introducing Haskell. 4 | 5 | Hence this experiment: Haskell In New Clothes (`hinc` for short); reimagining Haskell with a syntax inspired in modern JavaScript (or should I say [ECMAScript](https://en.wikipedia.org/wiki/ECMAScript)?). As an appetizer, here is how I envision one would write `mapM` in `hinc`: 6 | 7 | ```javascript 8 | let mapM(f: (a) => m, lst: List): m> where m : Effect 9 | = case (lst) { 10 | when Nil -> Nil.pure 11 | when Cons(x, xs) -> effect { 12 | let y = await f(x) 13 | let ys = await xs.mapM(f) 14 | Cons(y, ys).pure 15 | } 16 | } 17 | ``` 18 | 19 | Are you horrified? Maybe you are wondering whether I've cross the blurry line between sanity and madness? Keep reading! [Try it!](https://serras.github.io/hinc/) 20 | 21 | Of course, I am not the first one to try this. [BuckleScript](https://bucklescript.github.io/) and [Reason](https://reasonml.github.io/) provide a JavaScript-like syntax for OCaml, another important functional language. Note however that their goal is also to compile to JavaScript, whereas in Haskell world we are well-served by GHCJS. 22 | 23 | ## No top-level matching on definitions 24 | 25 | Haskellers would usually not use `case` when writing `mapM`, relying instead on the implicit top-level matching in definitions: 26 | 27 | ```haskell 28 | mapM _ [] = [] 29 | mapM f (x:xs) = ... 30 | ``` 31 | 32 | This is one feature which people usually find weird at the beginning (why duplicating the name of the function? why do arguments have _no names_?). In fact, this feature is not shared by other languages outside of Haskell derivatives (such as Agda or Idris) and OCaml. In Scala many functions start with a [explicit `match`](https://docs.scala-lang.org/tour/pattern-matching.html). 33 | 34 | ## Applications 35 | 36 | Most functional programs are simple sequences of nested applications. We dress up those to look a bit more like our parenthesized-application friends. 37 | 38 | ### Currying everywhere (tuples are not special) 39 | 40 | Most programmers are used to call a function with two arguments as `function(arg1, arg2)`. However, in Haskell one writes `function arg1 arg2` instead. The usual reasoning is that `function(arg1, arg2)` is actually calling a _one_-argument `function` with a _tuple_ as the single argument. But why make tuples so special? 41 | 42 | `hinc` adopts the philosophy that `(...)` is just a way to provide arguments, not any kind of tuple constructor. Everything is "translated" into a curried version. So one writes: 43 | 44 | ```javascript 45 | function(arg1, arg2) 46 | (x, y) => body 47 | (Int, Bool) => List 48 | ``` 49 | 50 | and this is taken exactly as Haskell's: 51 | 52 | ```haskell 53 | function arg1 arg2 54 | \x -> \y -> body 55 | Int -> Bool -> List Int 56 | ``` 57 | 58 | ### Postfix application with `.` 59 | 60 | In the `hinc` version of `mapM`, we use `.` in a way that resembles object-oriented notation. However, this is only a syntactic trick. Any use of `.` is simply application where the last argument appears at the front: 61 | 62 | ``` 63 | x.f(a, b, ..., z) ==> f(a, b, ..., z, x) 64 | ``` 65 | 66 | Libraries such as [Ramda](https://ramdajs.com/) explicitly mention _data-last_ functions as a good pattern. Most Haskell functions already follow this pattern, and that's where the choice of `.` comes from. For example, where Haskellers would write: 67 | 68 | ```haskell 69 | f = average . filter (> 0) . map normalize 70 | ``` 71 | 72 | in `hinc` the idiomatic translation would be: 73 | 74 | ```haskell 75 | let f(lst) = lst.map(normalize) 76 | .filter((x) => x > 0) 77 | .average 78 | ``` 79 | 80 | Note how the order in which operations are written is reversed. This is not by coincidence: people learning Haskell usually have problems with point-free style not because of the composition operator _per se_, but because code is suddenly "reversed". Other communities such as F# have adopted the "pipe forward" operator instead of composition as the default style. 81 | 82 | ## Java/Swift/TypeScript-syntax for types 83 | 84 | This is just a syntactic change: `hinc` adopts the convention of writing type arguments using angle brackets. So `Maybe Int` becomes `Maybe`. As mentioned above, functions are written with their arguments in parentheses, even though they are "translated" into its curried form. 85 | 86 | Note that `hinc` still keeps one interesting feature of Haskell: implicit variable quantification. In the definition of `mapM` above the programmer doesn't have to implicitly say that `a`, `b`, and `m` are type variables. If desired, that could be done as: 87 | 88 | ```javascript 89 | let mapM(f: (a) => b, lst: List): List 90 | ``` 91 | 92 | In addition, `hinc` drops some of the built-in types in Haskell, leaving only `=>` as special syntax. So one writes `List` for `[Int]`, `Tuple` for `(Int, Bool)`, and `Equals` for `Int ~ Bool`. 93 | 94 | ### Intertwined signatures and definitions 95 | 96 | One of the outstanding characteristics of Haskell code is that type signatures are written _separately_ from their definitions. For example, `mapM` would be written as follows: 97 | 98 | ```haskell 99 | mapM :: Monad m => (a -> m b) -> [a] -> m [b] 100 | ``` 101 | 102 | In `hinc` the types are written next to the arguments they relate to. 103 | 104 | ### Constraints go at the end 105 | 106 | The definition of `mapM` requires a `Monad` constraint on `m`. In `hinc`, those are written _at the end_ of the typing: 107 | 108 | ```javascript 109 | let mapM(f: (a) => m, lst: List): m> where m : Effect 110 | ``` 111 | 112 | The inspiration comes from [Rust traits](https://doc.rust-lang.org/book/ch10-02-traits.html#clearer-trait-bounds-with-where-clauses). 113 | 114 | From that same source we also introduce the syntax `t : c` to what would be written simply `c t` in Haskell. So for example the `elem` function would be written as: 115 | 116 | ```javascript 117 | let elem(xs: List, e: a) where a : Eq 118 | ``` 119 | 120 | Yes, the resemblance to subtyping constraints in other languages is completely intentional ;) 121 | 122 | ### Data type definition 123 | 124 | Following similar ideas, the definition of data types _always_ uses record and GADT syntax. The type of lists would be then defined as: 125 | 126 | ```haskell 127 | data List { 128 | Nil, 129 | Cons(head: a, tail: List) 130 | } 131 | ``` 132 | 133 | This syntax extends in an easy way to support GADTs by adding a result type to each constructor: 134 | 135 | ```haskell 136 | data Vec { 137 | VNil : Vec, 138 | VCons(vhead: a, vtail: Vec) : Vec 139 | } 140 | ``` 141 | 142 | ## Blocks with and without effects 143 | 144 | Haskell's syntax for pure and effectful functions are quite different. In the former case, we have one single expression which is decorated by `let` bindings in front and `where` bindings at the end: 145 | 146 | ```haskell 147 | f x = let t = g x in t * t 148 | ``` 149 | 150 | When writing effectful function one usually goes to `do` notation, where bindings can actually take two forms depending on whether they are pure or not: 151 | 152 | ```haskell 153 | f x = do 154 | t <- g x 155 | let r = t * t 156 | pure r 157 | ``` 158 | 159 | `hinc` tries to narrow this gap by providing just a single kind of block, introduced by curly braces (hey! I said I was inspired by JavaScript!), and where you can have a bunch of `let`s and a final expression. 160 | 161 | ```javascript 162 | let f(x) = { 163 | let t = g(x) 164 | t * t 165 | } 166 | ``` 167 | 168 | If the block has effects, that same keyword introduces the block. Inside of it, one uses `await` where Haskell would use the backarrow `<-`: 169 | 170 | ```javascript 171 | let f(x) = effect { 172 | let t = await g(x) 173 | let r = t * t 174 | r.pure 175 | } 176 | ``` 177 | 178 | The idea here is to focus on the _similarities_ between both blocks, instead of making the syntax completely apart from each other. `async` is a concept which has been incorporated by [JavaScript](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/async_function), [Rust](https://rust-lang.github.io/async-book/01_getting_started/04_async_await_primer.html), [Kotlin](https://kotlinlang.org/docs/reference/coroutines/coroutines-guide.html), and there are discussions in several other languages. 179 | 180 | --------------------------------------------------------------------------------