sugar for data and other improvements

- parse types in let (everything but parser was there)
- add sugar for `data`
- move `joinBy` to prelude
- fix highlighting for char in vscode
- better errors for missing imports

src/Lib/Common.idr

@@ -30,12 +30,6 @@ quoteString str = pack $ encode (unpack str) [< '"']
       let v : Nat = cast c in
       if v < 32 then encode cs (acc :< '\\' :< 'u' :< hexDigit (div v 4096) :< hexDigit (div v 256) :< hexDigit (div v 16) :< hexDigit v )
       else encode cs (acc :< c)
-      -- else if v < 128 then encode cs (acc :< c)
-      -- if v < 32 then encode cs (acc :< '\\' :< 'x' :< hexDigit (div v 16) :< hexDigit v )
-      -- else if v < 128 then encode cs (acc :< c)
-      -- -- TODO unicode
-      -- else if v < 256 then encode cs (acc :< '\\' :< 'x' :< hexDigit (div v 16) :< hexDigit v )
-      -- else encode cs (acc :< '\\' :< 'u' :< hexDigit (div v 4096) :< hexDigit (div v 256) :< hexDigit (div v 16) :< hexDigit v )
 
 public export
 data Json : Type where

src/Lib/Elab.idr

@@ -24,7 +24,6 @@ collectDecl ((Def fc nm cl) :: rest@(Def _ nm' cl' :: xs)) =
   else (Def fc nm cl :: collectDecl rest)
 collectDecl (x :: xs) = x :: collectDecl xs
 
-
 -- renaming
 -- dom gamma ren
 data Pden = PR Nat Nat (List Nat)
@@ -724,7 +723,7 @@ buildCase ctx prob scnm scty (dcName, arity, ty) = do
       Just cons <- rewriteConstraint sctynm vars cons [] | _ => pure Nothing
       pure $ Just $ MkClause fc cons pats expr
 
-
+export
 splitArgs : Raw -> List (Raw, Icit) -> (Raw, List (Raw, Icit))
 splitArgs (RApp fc t u icit) args = splitArgs t ((u, icit) :: args)
 splitArgs tm args = (tm, args)

src/Lib/Parser.idr

@@ -174,16 +174,17 @@ letExpr = do
   alts <- startBlock $ someSame $ letAssign
   keyword' "in"
   scope <- typeExpr
-  pure $ foldl (\ acc, (n,fc,v) => RLet fc n (RImplicit fc) v acc) scope (reverse alts)
+  pure $ foldl (\ acc, (n,fc,ty,v) => RLet fc n (fromMaybe (RImplicit fc) ty) v acc) scope (reverse alts)
   where
-    letAssign : Parser (Name,FC,Raw)
+    letAssign : Parser (Name,FC,Maybe Raw,Raw)
     letAssign = do
       fc <- getPos
       name <- ident
       -- TODO type assertion
+      ty <- optional (keyword ":" *> typeExpr)
       keyword "="
       t <- typeExpr
-      pure (name,fc,t)
+      pure (name,fc,ty,t)
 
 pLamArg : Parser (Icit, String, Maybe Raw)
 pLamArg = (Implicit,,) <$> braces (ident <|> uident) <*> optional (sym ":" >> typeExpr)
@@ -441,13 +442,21 @@ parsePFunc = do
   pure $ PFunc fc nm (fromMaybe [] uses) ty src
 
 
+parseShortData : Parser Decl
+parseShortData = do
+  fc <- getPos
+  keyword "data"
+  lhs <- typeExpr
+  keyword "="
+  sigs <- sepBy (keyword "|") typeExpr
+  pure $ ShortData fc lhs sigs
+
 export
 parseData : Parser Decl
 parseData = do
   fc <- getPos
-  keyword "data"
-  name <- uident <|> ident <|> token MixFix
-  keyword ":"
+  -- commit when we hit ":"
+  name <- try $ (keyword "data" *> (uident <|> ident <|> token MixFix) <* keyword ":")
   ty <- typeExpr
   keyword "where"
   decls <- startBlock $ manySame $ parseSig
@@ -500,7 +509,7 @@ parseNorm = DCheck <$> getPos <* keyword "#check" <*> typeExpr <* keyword ":" <*
 export
 parseDecl : Parser Decl
 parseDecl = parseMixfix <|> parsePType <|> parsePFunc
-  <|> parseNorm <|> parseData <|> parseSig <|> parseDef
+  <|> parseNorm <|> parseData <|> parseShortData <|> parseSig <|> parseDef
   <|> parseClass <|> parseInstance <|> parseRecord
 
 

src/Lib/Parser/Impl.idr

@@ -140,6 +140,11 @@ mutual
   export many : Parser a -> Parser (List a)
   many p = some p <|> pure []
 
+-- one or more `a` seperated by `s`
+export
+sepBy : Parser s -> Parser a -> Parser (List a)
+sepBy s a = (::) <$> a <*> many (s *> a)
+
 export
 getPos : Parser FC
 getPos = P $ \toks, com, ops, indent => case toks of
@@ -196,7 +201,7 @@ token' k = pred (\t => t.val.kind == k) "Expected a \{show k} token"
 export
 keyword' : String -> Parser ()
 -- FIXME make this an appropriate whitelist
-keyword' kw = ignore $ pred (\t => t.val.text == kw && t.val.kind /= Character) "Expected \{kw}"
+keyword' kw = ignore $ pred (\t => t.val.text == kw && (t.val.kind == Keyword || t.val.kind == Symbol || t.val.kind == Number)) "Expected \{kw}"
 
 ||| expect indented token of given kind
 export

src/Lib/Prettier.idr

@@ -138,7 +138,7 @@ fill [] = Empty
 fill [x] = x
 fill (x :: y :: xs) = (flatten x <+> fill (flatten y :: xs)) `Alt` (x </> fill (y :: xs))
 
-||| separate with space
+||| separate with comma
 export
 commaSep : List Doc -> Doc
 commaSep = folddoc (\a, b => a ++ text "," <+/> b)

src/Lib/ProcessDecl.idr

@@ -416,6 +416,28 @@ processDecl ns (Instance instfc ty decls) = do
     apply (VPi fc nm icit rig a b) (x :: xs) = apply !(b $$ x) xs
     apply x (y :: xs) = error instfc "expected pi type \{show x}"
 
+processDecl ns (ShortData fc lhs sigs) = do
+  (nm,args) <- getArgs lhs []
+  let ty = foldr (\ (fc,n), a => (RPi fc (BI fc n Explicit Many) (RU fc) a)) (RU fc) args
+  cons <- traverse (mkDecl args []) sigs
+  let dataDecl = Data fc nm ty cons
+  putStrLn "SHORTDATA"
+  putStrLn "\{pretty dataDecl}"
+  processDecl ns dataDecl
+  where
+    getArgs : Raw -> List (FC, String) -> M (String, List (FC, String))
+    getArgs (RVar fc1 nm) acc = pure (nm, acc)
+    getArgs (RApp _ t (RVar fc' nm) _) acc = getArgs t ((fc', nm) :: acc)
+    getArgs tm _ = error (getFC tm) "Expected contructor application, got: \{show tm}"
+
+    mkDecl : List (FC, Name) -> List Raw -> Raw -> M Decl
+    mkDecl args acc (RVar fc' name) = do
+      let base = foldr (\ ty, acc => RPi (getFC ty) (BI (getFC ty) "_" Explicit Many) ty acc) lhs acc
+      let ty = foldr (\ (fc,nm), acc => RPi fc (BI fc nm Implicit Zero) (RU fc) acc) base args
+      pure $ TypeSig fc' [name] ty
+    mkDecl args acc (RApp fc' t u icit) = mkDecl args (u :: acc) t
+    mkDecl args acc tm = error (getFC tm) "Expected contructor application, got: \{show tm}"
+
 processDecl ns (Data fc nm ty cons) = do
   putStrLn "-----"
   putStrLn "Data \{nm}"

src/Lib/Syntax.idr

@@ -120,6 +120,7 @@ data Decl
   | Def FC Name (List (Raw, Raw)) -- (List Clause)
   | DCheck FC Raw Raw
   | Data FC Name Raw (List Decl)
+  | ShortData FC Raw (List Raw)
   | PType FC Name (Maybe Raw)
   | PFunc FC Name (List String) Raw String
   | PMixFix FC (List Name) Nat Fixity
@@ -133,6 +134,7 @@ HasFC Decl where
   getFC (Def x str xs) = x
   getFC (DCheck x tm tm1) = x
   getFC (Data x str tm xs) = x
+  getFC (ShortData x _ _) = x
   getFC (PType x str mtm) = x
   getFC (PFunc x str _ tm str1) = x
   getFC (PMixFix x strs k y) = x
@@ -182,6 +184,7 @@ Show Decl where
   show (Data _ str xs ys) = foo ["Data", show str, show xs, show ys]
   show (DCheck _ x y) = foo ["DCheck", show x, show y]
   show (PType _ name ty) = foo ["PType", name, show ty]
+  show (ShortData _ lhs sigs) = foo ["ShortData", show lhs, show sigs]
   show (PFunc _ nm uses ty src) = foo ["PFunc", nm, show uses, show ty, show src]
   show (PMixFix _ nms prec fix) = foo ["PMixFix", show nms, show prec, show fix]
   show (Class _ nm tele decls) = foo ["Class",  nm, "...", show $ map show decls]
@@ -280,6 +283,9 @@ Pretty Raw where
 prettyBind : (BindInfo, Raw) -> Doc
 prettyBind (BI _ nm icit quant, ty) = wrap icit (text (show quant ++ nm) <+> text ":" <+> pretty ty)
 
+pipeSep : List Doc -> Doc
+pipeSep = folddoc (\a, b => a <+/> text "|" <+> b)
+
 export
 Pretty Decl where
   pretty (TypeSig _ nm ty) = spread (map text nm) <+> text ":" <+> nest 2 (pretty ty)
@@ -295,6 +301,7 @@ Pretty Decl where
   pretty (Class _ nm tele decls) = text "class" <+> text nm <+> ":" <+> spread (map prettyBind tele)
     <+> (nest 2 $ text "where" </> stack (map pretty decls))
   pretty (Instance _ _ _) = text "TODO pretty Instance"
+  pretty (ShortData _ lhs sigs) = text "data" <+> pretty lhs <+> "=" <+> pipeSep (map pretty sigs)
 
 export
 Pretty Module where

src/Lib/Tokenizer.idr

@@ -8,8 +8,8 @@ import Lib.Common
 keywords : List String
 keywords = ["let", "in", "where", "case", "of", "data", "U", "do",
             "ptype", "pfunc", "module", "infixl", "infixr", "infix",
-            "∀", "forall",
-            "class", "instance",
+            "∀", "forall", "import", "uses",
+            "class", "instance", "record", "constructor",
             "if", "then", "else",
             "$", "λ", "?", "@",
              "->", "→", ":", "=>", ":=", "=", "<-", "\\", "_", "|"]

src/Lib/Types.idr

@@ -92,17 +92,6 @@ public export
 HasFC BindInfo where
   getFC (BI fc _ _ _) = fc
 
--- do we just admit string names for these and let the prim functions
--- sort it out?
--- I'd like Int / String to have syntax
-
-data PrimType = StringType | IntType
-
-data PrimVal : Type where
-  PrimString : String -> PrimVal
-  PrimInt : Int -> PrimVal
-  PrimChar : Char -> PrimVal
-
 public export
 data Tm : Type