Add some string and array builtins, add array literals

7 files changed, 178 insertions, 81 deletions

diff --git a/fig-bless/main/Main.hs b/fig-bless/main/Main.hs
index c43bfc6..f429638 100644
--- a/fig-bless/main/Main.hs
+++ b/fig-bless/main/Main.hs
@@ -8,7 +8,7 @@ import Options.Applicative
 
 import Control.Exception.Safe (Handler(..), catches)
 
-import Data.Text.IO (putStrLn)
+import Data.Text.IO (putStr, putStrLn)
 import qualified Data.Text.IO as T.IO
 import qualified Data.ByteString.Lazy as B.L
 
@@ -85,13 +85,26 @@ writeError o e
     ]
   | otherwise = liftIO . hPutStrLn stderr $ pretty e
 
-writeSuccess :: (MonadIO m, Pretty e, Aeson.ToJSON e) => Options -> e -> m ()
-writeSuccess o e
+writeEval :: (MonadIO m, Pretty t, Aeson.ToJSON t) => Options -> [ValueF t] -> [EffectF t] -> m ()
+writeEval o st ef
   | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object
     [ "status" Aeson..= ("success" :: Text)
-    , "data" Aeson..= e
+    , "data" Aeson..= Aeson.object
+      [ "stack" Aeson..= st
+      , "effects" Aeson..= reverse ef
+      ]
+    ]
+  | otherwise = do
+      liftIO . putStr $ "Stack:\n" <> pretty st
+      liftIO . putStr $ "Effects:\n" <> pretty (reverse ef)
+
+writeType :: (MonadIO m, Pretty e, Aeson.ToJSON e) => Options -> e -> m ()
+writeType o t
+  | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object
+    [ "status" Aeson..= ("error" :: Text)
+    , "data" Aeson..= t
     ]
-  | otherwise = liftIO . putStrLn $ pretty e
+  | otherwise = liftIO . hPutStrLn stderr $ pretty t
 
 main :: IO ()
 main = do
@@ -108,16 +121,13 @@ main = do
           _ty <- typeOfProgram (initializeEnv ext builtins) prog
           let vm = initialize eo.fuel (Dictionary mempty) builtins
           vm' <- runProgram ext prog vm
-          let
-            stack :: [ValueF Spanning (Fix (ValueF Spanning))]
-            stack = vm'.stack
-          writeSuccess opts stack
+          writeEval opts vm'.stack vm'.effects
         Type to -> do
           prog <- parse "<input>" (programF spanning <* eof) to.src
           let ?term = Nothing
           let ext = pure . unSpanning
           ty <- typeOfProgram (initializeEnv ext builtins) prog
-          writeSuccess opts ty
+          writeType opts ty
         Dict o -> do
           src <- T.IO.readFile o.path
           dict <- parse "<input>" (dictionaryF spanning <* eof) src
@@ -126,10 +136,7 @@ main = do
           _env <- checkDictionary (initializeEnv ext builtins) dict
           let vm = initialize o.fuel dict builtins
           vm' <- runWord ext o.entrypoint vm
-          let
-            stack :: [ValueF Spanning (Fix (ValueF Spanning))]
-            stack = vm'.stack
-          writeSuccess opts stack
+          writeEval opts vm'.stack vm'.effects
     )
     [ Handler \(e :: Syn.ParseError) -> writeError opts e
     , Handler \(e :: RuntimeError Spanning) -> writeError opts e
diff --git a/fig-bless/src/Fig/Bless/Builtins.hs b/fig-bless/src/Fig/Bless/Builtins.hs
index 1246e57..8e199d7 100644
--- a/fig-bless/src/Fig/Bless/Builtins.hs
+++ b/fig-bless/src/Fig/Bless/Builtins.hs
@@ -9,48 +9,52 @@ import Fig.Prelude
 import Control.Monad.State.Strict (execStateT, StateT)
 
 import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
 
 import qualified Fig.Bless.Syntax as Syn
 import Fig.Bless.Types
 import Fig.Bless.Runtime
 
 -- * Helper functions
-stateful :: Running m t v => [BType] -> [BType] -> StateT (VM m t v) m a -> Builtin m t v
+stateful :: Running m t => [BType] -> [BType] -> StateT (VM m t) m a -> Builtin m t
 stateful inp out f = (execStateT f, BProgType {..})
 
-push :: (Running m t v, MonadState (VM m' t v) m) => ValueF t v -> m ()
+push :: (Running m t, MonadState (VM m' t) m) => ValueF t -> m ()
 push v = state \vm -> ((), vm { stack = v : vm.stack })
 
-pop :: (Running m t v, MonadState (VM m' t v) m) => m (ValueF t v)
+pop :: (Running m t, MonadState (VM m' t) m) => m (ValueF t)
 pop = get >>= \case
   vm | x:xs <- vm.stack -> do
          put vm { stack = xs }
          pure x
      | otherwise -> throwM $ RuntimeErrorStackUnderflow ?term
 
-int :: Running m t v => ValueF t v -> m Integer
+effect :: (Running m t, MonadState (VM m' t) m) => EffectF t -> m ()
+effect e = state \vm -> ((), vm { effects = e : vm.effects })
+
+int :: Running m t => ValueF t -> m Integer
 int (ValueInteger i) = pure i
 int v = throwM $ RuntimeErrorSortMismatch ?term ValueSortInteger (valueSort v)
 
-double :: Running m t v => ValueF t v -> m Double
+double :: Running m t => ValueF t -> m Double
 double (ValueDouble d) = pure d
 double v = throwM $ RuntimeErrorSortMismatch ?term ValueSortDouble (valueSort v)
 
-string :: Running m t v => ValueF t v -> m Text
+string :: Running m t => ValueF t -> m Text
 string (ValueString s) = pure s
 string v = throwM $ RuntimeErrorSortMismatch ?term ValueSortString (valueSort v)
 
-program :: Running m t v => ValueF t v -> m (Syn.ProgramF t)
+program :: Running m t => ValueF t -> m (Syn.ProgramF t)
 program (ValueProgram p) = pure p
 program v = throwM $ RuntimeErrorSortMismatch ?term ValueSortProgram (valueSort v)
 
-array :: Running m t v => ValueF t v -> m [v]
+array :: Running m t => ValueF t -> m [ValueF t]
 array (ValueArray a) = pure a
 array v = throwM $ RuntimeErrorSortMismatch ?term ValueSortProgram (valueSort v)
 
 -- * Stack operations
-stackops :: RunningTop m t v => Builtins m t v
-stackops t = let ?term = t in Map.fromList
+stackOps :: RunningTop m t => Builtins m t
+stackOps t = let ?term = t in Map.fromList
   [ ( "dup", stateful [BTypeVariable "a"] [BTypeVariable "a", BTypeVariable "a"] do
         x <- pop
         push x
@@ -65,41 +69,86 @@ stackops t = let ?term = t in Map.fromList
   ]
 
 -- * Arithmetic builtins
-add :: Running m t v => Builtin m t v
+add :: Running m t => Builtin m t
 add = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
   y <- int =<< pop
   x <- int =<< pop
   push . ValueInteger $ x + y
 
-mul :: Running m t v => Builtin m t v
+mul :: Running m t => Builtin m t
 mul = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
   y <- int =<< pop
   x <- int =<< pop
   push . ValueInteger $ x * y
 
-sub :: Running m t v => Builtin m t v
+sub :: Running m t => Builtin m t
 sub = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
   y <- int =<< pop
   x <- int =<< pop
   push . ValueInteger $ x - y
 
-div :: Running m t v => Builtin m t v
+div :: Running m t => Builtin m t
 div = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
   y <- int =<< pop
   x <- int =<< pop
   push . ValueInteger $ quot x y
 
-arithmetic :: RunningTop m t v => Builtins m t v
-arithmetic t = let ?term = t in Map.fromList
+arithmeticOps :: RunningTop m t => Builtins m t
+arithmeticOps t = let ?term = t in Map.fromList
   [ ("+", add)
   , ("*", mul)
   , ("-", sub)
   , ("/", div)
   ]
 
+-- * String builtins
+stringOps :: RunningTop m t => Builtins m t
+stringOps t = let ?term = t in Map.fromList
+  [ ( "s-append", stateful [BTypeString, BTypeString] [BTypeString] do
+        y <- string =<< pop
+        x <- string =<< pop
+        push . ValueString $ x <> y
+    )
+  , ( "s-split", stateful [BTypeString, BTypeString] [BTypeArray BTypeString] do
+        sep <- string =<< pop
+        s <- string =<< pop
+        push . ValueArray $ ValueString <$> Text.splitOn sep s
+    )
+  ]
+
+-- * Array builtins
+arrayOps :: RunningTop m t => Builtins m t
+arrayOps t = let ?term = t in Map.fromList
+  [ ( "a-append", stateful [BTypeArray (BTypeVariable "a"), BTypeArray (BTypeVariable "a")] [BTypeArray (BTypeVariable "a")] do
+        y <- array =<< pop
+        x <- array =<< pop
+        push . ValueArray $ x <> y
+    )
+  ]
+
+-- * Side effects
+sideeffectOps :: RunningTop m t => Builtins m t
+sideeffectOps t = let ?term = t in Map.fromList
+  [ ( "print", stateful [BTypeVariable "a"] [] do
+        x <- pop
+        effect $ EffectPrint x
+    )
+  , ( "soundboard", stateful [BTypeString] [] do
+        x <- pop
+        effect $ EffectSoundboard x
+    )
+  , ( "toggle", stateful [BTypeString] [] do
+        x <- pop
+        effect $ EffectModelToggle x
+    )
+  ]
+
 -- * All builtins
-builtins :: RunningTop m t v => Builtins m t v
+builtins :: RunningTop m t => Builtins m t
 builtins t = Map.unions @[]
-  [ stackops t
-  , arithmetic t
+  [ stackOps t
+  , arithmeticOps t
+  , stringOps t
+  , arrayOps t
+  , sideeffectOps t
   ]
diff --git a/fig-bless/src/Fig/Bless/Runtime.hs b/fig-bless/src/Fig/Bless/Runtime.hs
index cbef849..c1170f3 100644
--- a/fig-bless/src/Fig/Bless/Runtime.hs
+++ b/fig-bless/src/Fig/Bless/Runtime.hs
@@ -1,7 +1,8 @@
 {-# Language ImplicitParams #-}
 
 module Fig.Bless.Runtime
-  ( ValueF(..), Value
+  ( ValueF(..)
+  , EffectF(..)
   , ValueSort(..), valueSort
   , RuntimeError(..)
   , RunningTop, Running
@@ -24,25 +25,37 @@ import qualified Data.Aeson as Aeson
 import Fig.Bless.Types
 import qualified Fig.Bless.Syntax as Syn
 
-data ValueF t v
+data ValueF t
   = ValueInteger Integer
   | ValueDouble Double
   | ValueString Text
   | ValueProgram (Syn.ProgramF t)
-  | ValueArray [v]
+  | ValueArray [ValueF t]
   deriving (Show, Eq, Ord, Generic)
-instance (Aeson.ToJSON t, Aeson.ToJSON v) => Aeson.ToJSON (ValueF t v)
-instance (Pretty t, Pretty v) => Pretty (ValueF t v) where
+instance Aeson.ToJSON t => Aeson.ToJSON (ValueF t)
+instance Pretty t => Pretty (ValueF t) where
   pretty (ValueInteger i) = tshow i
   pretty (ValueDouble d) = tshow d
   pretty (ValueString s) = tshow s
   pretty (ValueProgram p) = pretty p
   pretty (ValueArray vs) = mconcat
-    [ "["
-    , Text.intercalate ", " $ pretty <$> vs
-    , "]"
+    [ "{"
+    , unwords $ pretty <$> vs
+    , "}"
     ]
-type Value = ValueF (Fix Syn.TermF) (Fix (ValueF (Fix Syn.TermF)))
+
+data EffectF t
+  = EffectPrint (ValueF t)
+  | EffectPrintBackwards (ValueF t)
+  | EffectSoundboard (ValueF t)
+  | EffectModelToggle (ValueF t)
+  deriving (Show, Eq, Ord, Generic)
+instance Aeson.ToJSON t => Aeson.ToJSON (EffectF t)
+instance Pretty t => Pretty (EffectF t) where
+  pretty (EffectPrint x) =  "(print " <> pretty x <> ")"
+  pretty (EffectPrintBackwards x) =  "(print-backwards " <> pretty x <> ")"
+  pretty (EffectSoundboard x) =  "(soundboard " <> pretty x <> ")"
+  pretty (EffectModelToggle x) =  "(moddle-toggle " <> pretty x <> ")"
 
 data ValueSort
   = ValueSortInteger
@@ -60,7 +73,7 @@ instance Pretty ValueSort where
   pretty ValueSortWord = "word"
   pretty ValueSortProgram = "program"
   pretty ValueSortArray = "list"
-valueSort :: ValueF t v -> ValueSort
+valueSort :: ValueF t -> ValueSort
 valueSort (ValueInteger _) = ValueSortInteger
 valueSort (ValueDouble _) = ValueSortDouble
 valueSort (ValueString _) = ValueSortString
@@ -100,24 +113,26 @@ instance Pretty t => Pretty (RuntimeError t) where
     , "actual: ", pretty actual
     ]
 
-type RunningTop m t v = (MonadThrow m, Typeable t, Show t)
-type Running m t v = (RunningTop m t v, ?term :: Maybe t)
-type BuiltinProgram m t v = VM m t v -> m (VM m t v)
-type Builtin m t v = (BuiltinProgram m t v, BProgType)
-type Builtins m t v = Maybe t -> Map Syn.Word (Builtin m t v)
-data VM m t v = VM
+type RunningTop m t = (MonadThrow m, Typeable t, Show t)
+type Running m t = (RunningTop m t, ?term :: Maybe t)
+type BuiltinProgram m t = VM m t -> m (VM m t)
+type Builtin m t = (BuiltinProgram m t, BProgType)
+type Builtins m t = Maybe t -> Map Syn.Word (Builtin m t)
+data VM m t = VM
   { fuel :: Maybe Integer
   , bindings :: Syn.DictionaryF t
-  , builtins :: Builtins m t v
-  , stack :: [ValueF t v]
+  , builtins :: Builtins m t
+  , stack :: [ValueF t]
+  , effects :: [EffectF t]
   }
 
-initialize :: Running m t v => Maybe Integer -> Syn.DictionaryF t -> Builtins m t v -> VM m t v
+initialize :: Running m t => Maybe Integer -> Syn.DictionaryF t -> Builtins m t -> VM m t
 initialize fuel bindings builtins = VM{..}
   where
     stack = []
+    effects = []
 
-checkFuel :: Running m t v => VM m t v -> m (VM m t v)
+checkFuel :: Running m t => VM m t -> m (VM m t)
 checkFuel vm
   | Just f <- vm.fuel
   = if f <= 0
@@ -125,24 +140,28 @@ checkFuel vm
     else pure vm { fuel = Just $ f - 1 }
 checkFuel vm = pure vm
 
-push :: Running m t v => ValueF t v -> VM m t v -> VM m t v
+push :: Running m t => ValueF t -> VM m t -> VM m t
 push v vm = vm
   { stack = v : vm.stack
   }
 
-runProgram :: Running m t v => Syn.Extractor m t -> Syn.ProgramF t -> VM m t v -> m (VM m t v)
+runProgram :: Running m t => Syn.Extractor m t -> Syn.ProgramF t -> VM m t -> m (VM m t)
 runProgram f (Syn.Program p) vm = foldM (flip (run f)) vm p
 
-runWord :: Running m t v => Syn.Extractor m t -> Syn.Word -> VM m t v -> m (VM m t v)
+runWord :: Running m t => Syn.Extractor m t -> Syn.Word -> VM m t -> m (VM m t)
 runWord _ w vm | Just (b, _) <- Map.lookup w $ vm.builtins ?term = b vm
 runWord f w vm | Just p <- lookup w vm.bindings.defs = runProgram f p vm
 runWord _ w _ = throwM $ RuntimeErrorWordNotFound ?term w
 
-run :: Running m t v => Syn.Extractor m t -> t -> VM m t v -> m (VM m t v)
+literalValue :: Syn.Literal -> ValueF t
+literalValue (Syn.LiteralInteger i) = ValueInteger i
+literalValue (Syn.LiteralDouble i) = ValueDouble i
+literalValue (Syn.LiteralString i) = ValueString i
+literalValue (Syn.LiteralArray xs) = ValueArray $ literalValue <$> xs
+
+run :: Running m t => Syn.Extractor m t -> t -> VM m t -> m (VM m t)
 run f v vm =
   let ?term = Just v in f v >>= \case
-    Syn.TermLiteral (Syn.LiteralInteger i) -> push (ValueInteger i) <$> checkFuel vm
-    Syn.TermLiteral (Syn.LiteralDouble i) -> push (ValueDouble i) <$> checkFuel vm
-    Syn.TermLiteral (Syn.LiteralString i) -> push (ValueString i) <$> checkFuel vm
+    Syn.TermLiteral l -> push (literalValue l) <$> checkFuel vm
     Syn.TermQuote p -> push (ValueProgram p) <$> checkFuel vm
     Syn.TermWord w -> runWord f w =<< checkFuel vm
diff --git a/fig-bless/src/Fig/Bless/Syntax.hs b/fig-bless/src/Fig/Bless/Syntax.hs
index fc43917..f4dea0a 100644
--- a/fig-bless/src/Fig/Bless/Syntax.hs
+++ b/fig-bless/src/Fig/Bless/Syntax.hs
@@ -20,7 +20,6 @@ import Fig.Prelude
 
 import Data.Char (isSpace)
 import Data.Functor ((<&>))
-import Data.Text (unlines)
 import Data.String (IsString(..))
 
 import qualified Text.Megaparsec as P
@@ -41,12 +40,14 @@ data Literal
   = LiteralInteger Integer
   | LiteralDouble Double
   | LiteralString Text
+  | LiteralArray [Literal]
   deriving (Show, Eq, Ord, Generic)
 instance Aeson.ToJSON Literal
 instance Pretty Literal where
   pretty (LiteralInteger i) = tshow i
   pretty (LiteralDouble d) = tshow d
   pretty (LiteralString s) = tshow s
+  pretty (LiteralArray xs) = "{" <> unwords (pretty <$> xs) <> "}"
 
 newtype ProgramF t = Program [t]
   deriving (Show, Eq, Ord, Generic, Functor)
@@ -98,8 +99,7 @@ literal =
   P.try ( (LiteralDouble <$> P.C.L.signed (pure ()) P.C.L.float)
     P.<?> "floating-point literal"
   ) P.<|>
-  (
-    ( LiteralInteger <$>
+  ( (LiteralInteger <$>
       P.C.L.signed (pure ())
       ( (P.C.string' "0x" *> P.C.L.hexadecimal) P.<|>
         (P.C.string' "0o" *> P.C.L.octal) P.<|>
@@ -110,6 +110,9 @@ literal =
   ) P.<|>
   ( (LiteralString . pack <$> (P.C.char '"' *> P.manyTill P.C.L.charLiteral (P.C.char '"')))
     P.<?> "string literal"
+  ) P.<|>
+  ( (LiteralArray <$> (P.C.char '{' *> P.many (ws *> literal <* ws) <* P.C.char '}'))
+    P.<?> "array literal"
   )
 
 programF :: Parser t -> Parser (ProgramF t)
@@ -157,8 +160,7 @@ data Spanning = Spanning
   { t :: TermF Spanning
   , start :: P.SourcePos
   , end :: P.SourcePos
-  }
-  deriving (Show, Eq, Ord, Generic)
+  } deriving (Show, Eq, Ord, Generic)
 instance Aeson.ToJSON Spanning where
   toJSON s = Aeson.object
     [ "term" Aeson..= Aeson.toJSON s.t
diff --git a/fig-bless/src/Fig/Bless/TypeChecker.hs b/fig-bless/src/Fig/Bless/TypeChecker.hs
index 0ee8eaf..272d98c 100644
--- a/fig-bless/src/Fig/Bless/TypeChecker.hs
+++ b/fig-bless/src/Fig/Bless/TypeChecker.hs
@@ -25,6 +25,7 @@ data TypeError t
   = TypeErrorWordNotFound (Maybe t) Word
   | TypeErrorMismatch (Maybe t) BType BType
   | TypeErrorArityMismatch (Maybe t) BProgType BProgType
+  | TypeErrorMixedArray (Maybe t)
   deriving (Show, Eq, Ord, Generic)
 instance (Show t, Typeable t) => Exception (TypeError t)
 instance Aeson.ToJSON t => Aeson.ToJSON (TypeError t)
@@ -51,8 +52,12 @@ instance Pretty t => Pretty (TypeError t) where
     , "expected: ", pretty expected, "\n"
     , "actual: ", pretty actual
     ]
+  pretty (TypeErrorMixedArray t) = mconcat
+    [ typeErrorPrefix t
+    , "array literal has mixed types"
+    ]
 
-type Typing m t = (MonadThrow m, Typeable t, Show t, ?term :: Maybe t)
+type Typing m t = (MonadIO m, MonadThrow m, Typeable t, Show t, ?term :: Maybe t)
 
 completeSubstitution :: [(BType, BType)] -> Either ((BType, BType), [(BType, BType)]) (Map Text BType)
 completeSubstitution = go Map.empty
@@ -66,6 +71,8 @@ completeSubstitution = go Map.empty
 unifyTypes :: forall m t. Typing m t => [(BType, BType)] -> m (Map Text BType)
 unifyTypes subst = case completeSubstitution subst of
   Right f -> pure f
+  Left ((BTypeArray t0, BTypeArray t1), xs) -- decompose arrays
+    -> unifyTypes ((t0, t1):xs)
   Left ((BTypeProgram p0, BTypeProgram p1), xs) -- decompose programs
     | length p0.inp == length p1.inp
       && length p0.out == length p1.out
@@ -89,7 +96,7 @@ combineProgTypes f s = do
     ( \(l, d) t -> case l of
         x:xs
           | x == t -> pure (xs, d)
-          | otherwise -> throwM $ TypeErrorMismatch ?term x t
+          | otherwise -> throwM $ TypeErrorMismatch ?term t x
         [] -> pure (l, d <> [t])
     )
     (fout, [])
@@ -99,6 +106,16 @@ combineProgTypes f s = do
     , out = sout <> leftover
     }
 
+typeOfLiteral :: Typing m t => Literal -> m BType
+typeOfLiteral LiteralInteger{} = pure BTypeInteger
+typeOfLiteral LiteralDouble{} = pure BTypeDouble
+typeOfLiteral LiteralString{} = pure BTypeString
+typeOfLiteral (LiteralArray xs) = mapM typeOfLiteral xs >>= \case
+  [] -> pure $ BTypeArray (BTypeVariable "a")
+  ts@(t:_)
+    | length (Set.fromList ts) == 1 -> pure $ BTypeArray t
+    | otherwise -> throwM $ TypeErrorMixedArray ?term
+
 typeOfProgram :: Typing m t => Env m t -> ProgramF t -> m BProgType
 typeOfProgram e (Program p) = case p of
   ft:ts -> do
@@ -113,15 +130,12 @@ typeOf e wt = do
     TermWord w -> case lookup w e.defs of
       Nothing -> throwM $ TypeErrorWordNotFound ?term w
       Just p -> pure p
-    TermLiteral l -> pure BProgType
-      { inp = []
-      , out =
-        [ case l of
-            LiteralInteger _ -> BTypeInteger
-            LiteralDouble _ -> BTypeDouble
-            LiteralString _ -> BTypeString
-        ]
-      }
+    TermLiteral l -> do
+      out <- typeOfLiteral l
+      pure BProgType
+        { inp = []
+        , out = [out]
+        }
     TermQuote p -> do
       ty <- typeOfProgram e p
       pure BProgType
@@ -129,7 +143,7 @@ typeOf e wt = do
         , out = [BTypeProgram ty]
         }
 
-initializeEnv :: Extractor m t -> Builtins m t v -> Env m t
+initializeEnv :: Extractor m t -> Builtins m t -> Env m t
 initializeEnv ext bs = Env
   { ext = ext
   , defs = (\(w, (_, p)) -> (w, p)) <$> Map.toList (bs Nothing)
diff --git a/fig-bless/src/Fig/Bless/Types.hs b/fig-bless/src/Fig/Bless/Types.hs
index ae8d9d4..c2e5d41 100644
--- a/fig-bless/src/Fig/Bless/Types.hs
+++ b/fig-bless/src/Fig/Bless/Types.hs
@@ -15,6 +15,7 @@ data BType
   | BTypeDouble
   | BTypeString
   | BTypeProgram BProgType
+  | BTypeArray BType
   deriving (Show, Eq, Ord, Generic)
 instance Aeson.ToJSON BType
 instance Pretty BType where
@@ -23,6 +24,7 @@ instance Pretty BType where
   pretty BTypeDouble = "double"
   pretty BTypeString = "string"
   pretty (BTypeProgram p) = "(" <> pretty p <> ")"
+  pretty (BTypeArray p) = "Array<" <> pretty p <> ">"
 
 data BProgType = BProgType
   { inp :: [BType]
@@ -35,6 +37,7 @@ instance Pretty BProgType where
 
 renameVars :: (Text -> Text) -> BType -> BType
 renameVars f (BTypeVariable v) = BTypeVariable $ f v
+renameVars f (BTypeArray t) = BTypeArray $ renameVars f t
 renameVars f (BTypeProgram p) = BTypeProgram BProgType
   { inp = renameVars f <$> p.inp
   , out = renameVars f <$> p.out
@@ -43,6 +46,7 @@ renameVars _ x = x
 
 substitute :: Text -> BType -> BType -> BType
 substitute n v (BTypeVariable n') | n == n' = v
+substitute n v (BTypeArray t) = BTypeArray $ substitute n v t
 substitute n v (BTypeProgram p) = BTypeProgram BProgType
   { inp = substitute n v <$> p.inp
   , out = substitute n v <$> p.out
@@ -53,6 +57,7 @@ applySubstitution :: Map Text BType -> BType -> BType
 applySubstitution s (BTypeVariable v)
   | Just x <- Map.lookup v s = x
   | otherwise = BTypeVariable v
+applySubstitution s (BTypeArray t) = BTypeArray $ applySubstitution s t
 applySubstitution s (BTypeProgram p) = BTypeProgram BProgType
   { inp = applySubstitution s <$> p.inp
   , out = applySubstitution s <$> p.out
@@ -61,5 +66,6 @@ applySubstitution _ x = x
 
 typeVariables :: BType -> Set Text
 typeVariables (BTypeVariable v) = Set.singleton v
+typeVariables (BTypeArray t) = typeVariables t
 typeVariables (BTypeProgram p) = Set.unions $ (typeVariables <$> p.inp) <> (typeVariables <$> p.out)
 typeVariables _ = Set.empty
diff --git a/flake.nix b/flake.nix
index 8c0f84f..dabef91 100644
--- a/flake.nix
+++ b/flake.nix
@@ -22,9 +22,9 @@
       haskellPackages = pkgs.haskell.packages.ghc94.override {
         inherit overrides;
       };
-      haskellPackagesStatic = pkgs.pkgsStatic.haskell.packages.ghc94.override {
-        inherit overrides;
-      };
+      # haskellPackagesStatic = pkgs.pkgsStatic.haskell.packages.ghc94.override {
+      #   inherit overrides;
+      # };
       figBusModule = { config, lib, ... }:
         let
           cfg = config.colonq.services.fig-bus;
@@ -243,7 +243,7 @@
         figMonitorBullfrog = haskellPackages.fig-monitor-bullfrog;
         figBridgeIRCDiscord = haskellPackages.fig-bridge-irc-discord;
         figBless = haskellPackages.fig-bless;
-        figBlessStatic = haskellPackagesStatic.fig-bless;
+        # figBlessStatic = haskellPackagesStatic.fig-bless;
         figFrontend = haskellPackages.fig-frontend;
       };
       apps.x86_64-linux.default = {