port aoc2023 day4

more stuff in Prelude, typechecking fixes, solving autos

playground/samples/Day2.newt

@@ -26,14 +26,6 @@ pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o`
 pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, '  ')`
 pfunc toInt : String -> Int := `s => Number(s)`
 
-mapM : ∀ a b c. (a -> Either b c) -> List a -> Either b (List c)
-mapM f Nil = Right Nil
-mapM f (x :: xs) = case f x of
-  Left msg => Left msg
-  Right v => case mapM f xs of
-    Left msg => Left msg
-    Right vs => Right $ v :: vs
-
 maxd : Draw -> Draw -> Draw
 maxd (a,b,c) (d,e,f) = (max a d, max b e, max c f)
 
@@ -48,7 +40,7 @@ parseColor line = case split line " " of
   x => Left $ "Bad draw" ++ repr x
 
 parseDraw : String -> Either String Draw
-parseDraw line = case mapM parseColor $ split line ", " of
+parseDraw line = case mapM {Either String} parseColor $ split line ", " of
   Right parts => Right $ foldl maxd (0,0,0) parts
   Left err => Left err
 
@@ -60,7 +52,7 @@ parseGame line =
     (a :: b :: Nil) => case split a " " of
       ("Game" :: ns :: Nil) =>
         let num = toInt ns in
-        case mapM parseDraw $ split b "; " of
+        case mapM {Either String} parseDraw $ split b "; " of
           Right parts => Right $ MkGame num parts
           Left err => Left err
       _ => Left "No Game"
@@ -85,7 +77,7 @@ part2 (MkGame n parts :: rest) =
 run : String -> Async Unit
 run fn = do
   text <- fetchText fn
-  case mapM parseGame (split (trim text) "\n") of
+  case mapM {Either String} parseGame (split (trim text) "\n") of
     Left err => putStrLn $ "fail " ++ err
     Right games => do
       putStrLn "part1"

playground/samples/Prelude.newt

@@ -26,6 +26,10 @@ infixl 6 _==_
 class Eq a where
   _==_ : a → a → Bool
 
+infixl 6 _/=_
+_/=_ : ∀ a. {{Eq a}} → a → a → Bool
+a /= b = not (a == b)
+
 data Nat : U where
   Z : Nat
   S : Nat -> Nat
@@ -159,6 +163,14 @@ class Applicative (f : U → U) where
   return : {0 a} → a → f a
   _<*>_ : {0 a b} -> f (a → b) → f a → f b
 
+class Traversable (t : U → U) where
+  traverse : {f : U → U} → {{appf : Applicative f}} → {a : U} → {b : U} → (a → f b) → t a → f (t b)
+
+instance Applicative Maybe where
+  return a = Just a
+  Nothing <*> _ = Nothing
+  Just f <*> fa = f <$> fa
+
 infixr 2 _<|>_
 class Alternative (m : U → U) where
   _<|>_ : {0 a} → m a → m a → m a
@@ -306,6 +318,21 @@ instance Monad List where
   bind Nil amb = Nil
   bind (x :: xs) amb = amb x ++ bind xs amb
 
+
+
+-- This is traverse, but we haven't defined Traversable yet
+mapA : ∀ m. {{Applicative m}} {0 a b} → (a → m b) → List a → m (List b)
+mapA f Nil = return Nil
+mapA f (x :: xs) = return _::_ <*> f x <*> mapA f xs
+
+
+mapM : ∀ m. {{Monad m}} {0 a b} → (a → m b) → List a → m (List b)
+mapM f Nil = pure Nil
+mapM f (x :: xs) = do
+  b <- f x
+  bs <- mapM f xs
+  pure (b :: bs)
+
 class HasIO (m : U -> U) where
   liftIO : ∀ a. IO a → m a
 
@@ -483,3 +510,30 @@ getAt! : ∀ a. {{Inhabited a}} → Nat → List a → a
 getAt! _ Nil = default
 getAt! Z (x :: xs) = x
 getAt! (S k) (x :: xs) = getAt! k xs
+
+
+instance ∀ a. Applicative (Either a) where
+  return b = Right b
+  Right x <*> Right y = Right (x y)
+  Left x <*> _ = Left x
+  Right x <*> Left y = Left y
+
+instance ∀ a. Monad (Either a) where
+  pure x = Right x
+  bind (Right x) mab = mab x
+  bind (Left x) mab = Left x
+
+instance Monad Maybe where
+  pure x = Just x
+  bind Nothing mab = Nothing
+  bind (Just x) mab = mab x
+
+
+elem : ∀ a. {{Eq a}} → a → List a → Bool
+elem v Nil = False
+elem v (x :: xs) = if v == x then True else elem v xs
+
+-- TODO no empty value on my `Add`, I need a group..
+-- sum : ∀ a. {{Add a}} → List a → a
+-- sum xs = foldl _+_
+pfunc trace uses (debugStr) : ∀ a. String -> a -> a := `(_, msg, a) => { console.log(msg,debugStr(_,a)); return a }`