First commit.

.gitignore

@@ -0,0 +1,3 @@
+dist
+*.hi
+*.o

IDEAS

@@ -0,0 +1,18 @@
+
+I don't like repeating the function name
+
+hypenToCamelCase ('-':'-':xs) = hypenToCamelCase ('-':xs)
+hypenToCamelCase ('-':x:xs)   = toUpper x : hypenToCamelCase xs
+hypenToCamelCase ('-':xs)     = hypenToCamelCase xs
+hypenToCamelCase (x:xs)       = x : hypenToCamelCase xs
+hypenToCamelCase []           = []
+
+nor do I like to separate it into a `case .. of', or a `where ...',
+best to make it easy to write like this:
+
+hypenToCamelCase
+  ('-':'-':xs) = hypenToCamelCase ('-':xs)
+  ('-':x:xs)   = toUpper x : hypenToCamelCase xs
+  ('-':xs)     = hypenToCamelCase xs
+  (x:xs)       = x : hypenToCamelCase xs
+  []           = []

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c)2010, Chris Done
+
+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 Chris Done 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

@@ -0,0 +1,4 @@
+Lisk
+----
+
+S-expression-based syntax alternative for Haskell.

Setup.hs

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

TELL

@@ -0,0 +1 @@
+exDM69

lisk.cabal

@@ -0,0 +1,63 @@
+-- lisk.cabal auto-generated by cabal init. For additional options,
+-- see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                lisk
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version:             0.1
+
+-- A short (one-line) description of the package.
+Synopsis:            Lisp syntax layer for Haskell.
+
+-- A longer description of the package.
+-- Description:         
+
+-- The license under which the package is released.
+License:             BSD3
+
+-- The file containing the license text.
+License-file:        LICENSE
+
+-- The package author(s).
+Author:              Chris Done
+
+-- An email address to which users can send suggestions, bug reports,
+-- and patches.
+Maintainer:          chrisdone@gmail.com
+
+-- A copyright notice.
+-- Copyright:           
+
+Category:            Language
+
+Build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+-- Extra-source-files:  
+
+-- Constraint on the version of Cabal needed to build this package.
+Cabal-version:       >=1.2
+
+
+Executable lisk
+  -- .hs or .lhs file containing the Main module.
+  Main-is:            Main.hs
+  Hs-source-dirs:     src/
+
+  -- Packages needed in order to build this package.
+  Build-depends:      base >= 4 && < 5,
+                      haskell-src-exts == 1.9.*,
+                      parsec == 3.0.*,
+                      mtl == 1.1.1.*,
+                      regex-compat == 0.93.*
+
+  -- Modules not exported by this package.
+  -- Other-modules:       
+
+  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+  -- Build-tools:         
+

src/Language/Lisk/Parser.hs

@@ -0,0 +1,244 @@
+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction,
+             ViewPatterns, FlexibleInstances #-}
+module Language.Lisk.Parser where
+
+import Data.List
+import Data.Either
+import Control.Monad.Reader
+import Control.Monad.Error
+import Control.Arrow
+import Control.Applicative
+import Control.Monad.Identity
+import Data.Char
+import Text.Parsec hiding ((<|>),many,token)
+import Text.Parsec.Combinator
+import Language.Haskell.Exts.Syntax
+import Language.Haskell.Exts.Pretty
+import qualified Language.Haskell.Exts.Parser as P (parseExp,parse,ParseResult(..))
+
+data LiskExpr = LSym SrcLoc String
+              | LTCM SrcLoc String
+              | LList SrcLoc [LiskExpr]
+  deriving Show
+
+type LP = Parsec String ()
+
+printLiskToHaskell = prettyPrint
+
+parseLisk = parse (spaces *> liskModule <* spaces)
+
+printLiskFragment p = either (putStrLn.show) (putStrLn.prettyPrint) . parse p ""
+
+printLisk str =
+  case parse liskModule "" str of
+    Left e   -> error $ show e ++ suggest
+    Right ex -> putStrLn $ prettyPrint ex
+
+liskModule = parens $ do
+  loc <- getLoc
+  symbolOf "module" <?> "module"
+  spaces1
+  name <- liskModuleName
+  spaces
+  importDecls <- many $ try $ spaces *> liskImportDecl
+  spaces
+  decls <- sepBy liskDecl spaces
+  return $ Module loc name [] Nothing Nothing importDecls decls
+
+symbolOf = string
+
+liskDecl = try liskTypeSig <|> try liskFunBind <|> liskPatBind
+
+liskTypeSig = parens $ do
+  loc <- getLoc
+  symbolOf "::" <?> "type signature e.g. (:: x :string)"
+  spaces1
+  idents <- pure <$> liskIdent <|>
+            parens (sepBy1 liskIdent spaces1)
+  spaces1
+  typ <- liskType
+  return $ TypeSig loc idents typ
+
+liskType = try liskTyCon <|> try liskTyVar  <|> liskTyApp
+
+liskTyApp = parens $ do
+  op <- liskType
+  spaces1
+  args <- sepBy1 liskType spaces1
+  let op' =
+        case op of
+          TyCon (Special (TupleCon b n)) -> TyCon $ Special $ TupleCon b $ length args
+          _ -> op
+  return $ foldl TyApp op' args
+
+liskTyCon = TyCon <$> liskQName
+
+liskTyVar = TyVar <$> liskName
+
+liskPatBind = parens $ do
+  loc <- getLoc
+  symbolOf "=" <?> "pattern binding e.g. (= x \"Hello, World!\")"
+  spaces1
+  pat <- liskPat
+  typ <- return Nothing -- liskType -- TODO
+  spaces1
+  rhs <- liskRhs
+  binds <- liskBinds
+  return $ PatBind loc pat Nothing rhs binds
+
+liskFunBind = FunBind <$> sepBy1 liskMatch spaces1
+
+liskMatch = parens $ do
+  loc <- getLoc
+  symbolOf "=" <?> "pattern binding e.g. (= x \"Hello, World!\")"
+  spaces1
+  name <- liskName
+  spaces1
+  pats <- (pure <$> liskPat) <|> parens (sepBy1 liskPat spaces1)
+  typ <- return Nothing -- liskType -- TODO
+  spaces1
+  rhs <- liskRhs
+  binds <- liskBinds
+  return $ Match loc name pats typ rhs binds
+
+liskBinds = try liskBDecls <|> liskIPBinds
+
+liskBDecls = BDecls <$> pure [] -- TODO
+
+liskIPBinds = IPBinds <$> pure [] -- TODO
+
+liskPat = liskPVar -- TODO
+
+liskRhs = liskUnguardedRhs
+
+liskUnguardedRhs = UnGuardedRhs <$> liskExp
+
+ -- TODO
+liskExp = try liskVar
+          <|> try liskLit
+          <|> try liskApp
+
+liskApp = try liskTupleApp <|> try liskOpApp <|> try liskIdentApp <|> liskOpPartial
+
+liskTupleApp = parens $ do
+  string ","
+  args <- (spaces1 *> sepBy1 liskExp spaces1) <|> pure []
+  let op = Var $ Special $ TupleCon Boxed $ max 2 (length args)
+      paren | null args = id
+            | otherwise = Paren
+  return $ paren $ foldl App op $ args
+
+liskIdentApp = parens $ do
+  op <- liskExp
+  spaces1
+  args <- sepBy1 liskExp spaces1
+  return $ Paren $ foldl App op $ args
+
+liskOpApp = parens $ do
+  op <- QVarOp <$> liskOp
+  spaces1
+  args <- (:) <$> (liskExp <* spaces) <*> sepBy1 liskExp spaces1
+  return $ Paren $ foldl1 (flip InfixApp op) args
+
+liskOpPartial = parens $ do
+  op <- Var <$> liskOp
+  spaces1
+  e <- liskExp
+  return $ App op e
+
+liskOp = UnQual . Symbol <$> many1 (oneOf ".*-+/\\=<>")
+
+liskLit = Lit <$> (liskChar <|> try liskString <|> liskInt)
+
+liskChar = Char <$> (string "\\" *> (space <|> newline <|> noneOf "\n \t"))
+    where space = const ' ' <$> string "Space"
+                  <|> const '\n' <$> string "Newline"
+
+liskString = do
+  strRep <- char '\"' *> (concat <$> many liskStringSeq) <* char '\"'
+  case P.parseExp $ "\"" ++ strRep ++ "\"" of
+    P.ParseOk (Lit s@String{}) -> return s
+    P.ParseFailed _ msg -> parserFail msg
+  where liskStringSeq = ("\\"++) <$> (char '\\' *> (pure <$> noneOf "\n"))
+                        <|> pure <$> noneOf "\n\""
+
+liskInt = Int <$> (read <$> many1 digit)
+
+liskPVar = PVar <$> liskName
+
+liskQName = try liskSpecial <|> try liskQual <|> try liskUnQual
+
+liskQual = mzero -- TODO
+
+liskUnQual = UnQual <$> liskName
+
+liskSpecial = Special <$> spec where
+    spec = string "()"  *> pure UnitCon
+       <|> string "[]"  *> pure ListCon
+       <|> string "->"  *> pure FunCon
+       <|> string ","   *> pure (TupleCon Boxed{-TODO:boxed-} 0)
+
+liskName = try liskIdent <|> liskSymbol
+
+liskVar = Var <$> liskUnQual
+
+liskIdent = Ident . hyphenToCamelCase . colonToConsTyp <$> ident where
+    ident = ((++) <$> (string ":" <|> pure "")
+                  <*> many1 liskIdentifierToken)
+
+colonToConsTyp (':':x:xs) = toUpper x : xs
+colonToConsTyp xs = xs
+
+liskSymbol = Symbol <$> many1 liskIdentifierToken
+
+liskList = mzero -- TODO
+
+liskImportDecl = parens $ do
+  loc <- getLoc
+  symbolOf "import" <?> "import"
+  spaces1
+  name <- liskModuleName
+  return $ ImportDecl { 
+      importLoc = loc
+    , importModule = name
+    , importQualified = False
+    , importSrc = False
+    , importPkg = Nothing
+    , importAs = Nothing
+    , importSpecs = Nothing
+    }
+
+liskModuleName = (<?> "module name (e.g. `:module.some-name')") $ do
+  char ':'
+  parts <- sepBy1 modulePart (string ".")
+  return $ ModuleName $ intercalate "." parts
+  where modulePart = format <$> many liskIdentifierToken
+        format = hyphenToCamelCase . upperize
+        upperize (x:xs) = toUpper x : xs
+
+liskDefIdentifier = do
+  ident <- many1 liskIdentifierToken
+  return $ Ident ident
+
+liskIdentifierToken = letter <|> digit <|> oneOf "-"
+
+hyphenToCamelCase ('-':'-':xs) = hyphenToCamelCase ('-':xs)
+hyphenToCamelCase ('-':x:xs)   = toUpper x : hyphenToCamelCase xs
+hyphenToCamelCase ('-':xs)     = hyphenToCamelCase xs
+hyphenToCamelCase (x:xs)       = x : hyphenToCamelCase xs
+hyphenToCamelCase []           = []
+
+getLoc = posToLoc <$> getPosition where
+  posToLoc pos =
+    SrcLoc { srcFilename = sourceName pos 
+           , srcLine     = sourceLine pos
+           , srcColumn   = sourceColumn pos
+           }
+
+parens = between (char '(') (char ')')
+
+suggest = "\n(are you trying to use not-currently-supported syntax?)"
+
+bi f g = f . g . f
+
+spaces1 = many1 space