Add anoma nockma tests

.github/workflows/ci.yml

@@ -119,6 +119,49 @@ jobs:
           path: main
           submodules: true
 
+      - name: Add ~/.local/bin to PATH
+        run: |
+          mkdir -p "$HOME/.local/bin"
+          echo "$HOME/.local/bin" >> $GITHUB_PATH
+
+      - name: Set up Elixir
+        id: beam
+        uses: erlef/[email protected]
+        with:
+          elixir-version: "1.17.3"
+          otp-version: "27.1"
+
+      - name: Install protoc
+        run: |
+          sudo apt install -y protobuf-compiler
+          protoc --version
+
+      - name: Cache anoma
+        id: cache-anoma
+        uses: actions/cache@v3
+        with:
+          path: |
+            ${{ env.HOME }}/anoma
+          key: "${{ runner.os }}-anoma"
+
+      - name: Build anoma
+        if: steps.cache-anoma.outputs.cache-hit != 'true'
+        run: |
+          cd $HOME
+          git clone https://github.com/anoma/anoma.git
+          cd anoma
+          git checkout 98e3660b91cd55f1d9424dcff9420425ae98f5f8
+          mix local.hex --force
+          mix escript.install hex protobuf --force
+          echo "$HOME/.mix/escripts" >> $GITHUB_PATH
+          mix deps.get
+          mix compile
+          mix do --app anoma_client escript.build
+
+      - name: Install grpcurl
+        run: |
+          curl -sSL "https://github.com/fullstorydev/grpcurl/releases/download/v1.9.1/grpcurl_1.9.1_linux_x86_64.tar.gz" | tar -xz -C ~/.local/bin --no-wildcards grpcurl
+
       - name: Cache LLVM and Clang
         id: cache-llvm
         uses: actions/cache@v3
@@ -146,10 +189,9 @@ jobs:
         run: |
           echo "WASI_SYSROOT_PATH=$GITHUB_WORKSPACE/wasi-sysroot" >> $GITHUB_ENV
 
-      - name: Add ~/.local/bin to PATH
+      - name: Set ANOMA_PATH
         run: |
-          mkdir -p "$HOME/.local/bin"
-          echo "$HOME/.local/bin" >> $GITHUB_PATH
+          echo "ANOMA_PATH=$HOME/anoma" >> $GITHUB_ENV
 
       - run: echo "HOME=$HOME" >> $GITHUB_ENV
         shell: bash

app/Commands/Dev/Anoma/Node.hs

@@ -11,4 +11,5 @@ runCommand opts = runAppError @SimpleError
   $ do
     anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath)
     runAnoma anomaDir $ do
-      void noHalt
+      p <- getAnomaProcesses
+      void (waitForProcess (p ^. anomaNodeHandle))

src/Anoma/Effect/Base.hs

@@ -4,9 +4,12 @@
 -- 2. grpcurl
 module Anoma.Effect.Base
   ( Anoma,
-    noHalt,
+    getAnomaProcesses,
     anomaRpc,
     AnomaPath (..),
+    AnomaProcesses (..),
+    anomaNodeHandle,
+    anomaClientHandle,
     anomaPath,
     runAnoma,
     module Anoma.Rpc.Base,
@@ -23,13 +26,21 @@ import Juvix.Extra.Paths (anomaStartExs)
 import Juvix.Prelude
 import Juvix.Prelude.Aeson (Value, eitherDecodeStrict, encode)
 
+data AnomaProcesses = AnomaProcesses
+  { _anomaNodeHandle :: ProcessHandle,
+    _anomaClientHandle :: ProcessHandle
+  }
+
+newtype ListenPort = ListenPort Int
+
 data Anoma :: Effect where
   -- | Keep the node and client running
-  NoHalt :: Anoma m ExitCode
+  GetAnomaProcesses :: Anoma m AnomaProcesses
   -- | grpc call
   AnomaRpc :: GrpcMethodUrl -> Value -> Anoma m Value
 
 makeSem ''Anoma
+makeLenses ''AnomaProcesses
 
 newtype AnomaPath = AnomaPath {_anomaPath :: Path Abs Dir}
 
@@ -38,28 +49,26 @@ newtype GrpcPort = GrpcPort {_grpcPort :: Int}
 makeLenses ''AnomaPath
 makeLenses ''GrpcPort
 
-listenPort :: Int
-listenPort = 50051
-
 relativeToAnomaDir :: (Members '[Reader AnomaPath] r) => Path Rel x -> Sem r (Path Abs x)
 relativeToAnomaDir p = do
   anoma <- asks (^. anomaPath)
   return (anoma <//> p)
 
 withSpawnAnomaClient ::
   (Members '[Process, Logger, EmbedIO, Reader AnomaPath, Reader GrpcPort, Error SimpleError] r) =>
-  (ProcessHandle -> Sem r a) ->
+  (Int -> ProcessHandle -> Sem r a) ->
   Sem r a
 withSpawnAnomaClient body = do
   cprocess <- mkProcess
   withCreateProcess cprocess $ \_stdin mstdout _stderr procHandle -> do
     let out = fromJust mstdout
     txt <- hGetLine out
-    case takeWhile (/= '.') (unpack txt) of
-      "Connected to node" -> do
+    case span (/= '.') (unpack txt) of
+      ("Connected to node", rest) -> do
+        let port = readJust (last (nonEmpty' (words rest)))
         logInfo "Anoma client successfully started"
-        logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty listenPort)))
-        body procHandle
+        logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty port)))
+        body port procHandle
       _ -> throw (SimpleError (mkAnsiText @Text "Something went wrong when starting the anoma client"))
   where
     mkProcess :: (Members '[Reader AnomaPath, Reader GrpcPort] r') => Sem r' CreateProcess
@@ -70,7 +79,7 @@ withSpawnAnomaClient body = do
         ( proc
             (toFilePath anomaClient)
             [ "--listen-port",
-              show listenPort,
+              "0",
               "--node-host",
               "localhost",
               "--node-port",
@@ -106,7 +115,11 @@ withSpawnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do
             cwd = Just (toFilePath anomapath)
           }
 
-anomaRpc' :: (Members '[Reader AnomaPath, Process, EmbedIO, Error SimpleError] r) => GrpcMethodUrl -> Value -> Sem r Value
+anomaRpc' ::
+  (Members '[Reader ListenPort, Reader AnomaPath, Process, EmbedIO, Error SimpleError] r) =>
+  GrpcMethodUrl ->
+  Value ->
+  Sem r Value
 anomaRpc' method payload = do
   cproc <- grpcCliProcess method
   withCreateProcess cproc $ \mstdin mstdout _stderr _procHandle -> do
@@ -120,9 +133,10 @@ anomaRpc' method payload = do
       Right r -> return r
       Left err -> throw (SimpleError (mkAnsiText err))
 
-grpcCliProcess :: (Members '[Reader AnomaPath] r) => GrpcMethodUrl -> Sem r CreateProcess
+grpcCliProcess :: (Members '[Reader ListenPort, Reader AnomaPath] r) => GrpcMethodUrl -> Sem r CreateProcess
 grpcCliProcess method = do
   importPath <- relativeToAnomaDir relProtoDir
+  ListenPort listenPort <- ask
   return
     ( proc
         "grpcurl"
@@ -141,11 +155,22 @@ grpcCliProcess method = do
         std_out = CreatePipe
       }
 
+-- | Assumes the node and client are already running
+-- runAnomaTest :: forall r a. (Members '[Reader ListenPort, Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a
+-- runAnomaTest anomapath body = runReader anomapath . runProcess $
+--   (`interpret` inject body) $ \case
+--     GetAnomaProcesses -> error "unsupported"
+--     AnomaRpc method i -> anomaRpc' method i
 runAnoma :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a
-runAnoma anomapath body = runReader anomapath . runConcurrent . runProcess $
+runAnoma anomapath body = runReader anomapath . runProcess $
   withSpawnAnomaNode $ \grpcport _nodeOut nodeH ->
     runReader (GrpcPort grpcport) $
-      withSpawnAnomaClient $ \_clientH -> do
+      withSpawnAnomaClient $ \listenPort clientH -> runReader (ListenPort listenPort) $ do
         (`interpret` inject body) $ \case
-          NoHalt -> waitForProcess nodeH
+          GetAnomaProcesses ->
+            return
+              AnomaProcesses
+                { _anomaNodeHandle = nodeH,
+                  _anomaClientHandle = clientH
+                }
           AnomaRpc method i -> anomaRpc' method i

src/Juvix/Compiler/Nockma/Translation/FromTree.hs

@@ -885,9 +885,8 @@ callAnomaLib fun args = do
   let ref = AnomaLibFunction fun
       fPath = anomaLibPath ref
       getFunCode = opAddress "callStdlibFunCode" stdpath >># fPath
-  argsPath <- stackPath ArgsTuple
   let adjustArgs = case nonEmpty args of
-        Just args' -> opReplace "callStdlib-args" argsPath ((opAddress "stdlibR" [R]) >># foldTerms args') (opAddress "stdlibL" [L])
+        Just args' -> opReplace "callStdlib-args" [R, L] ((opAddress "stdlibR" [R]) >># foldTerms args') (opAddress "stdlibL" [L])
         Nothing -> opAddress "adjustArgsNothing" [L]
       callFn = opCall "callStdlib" (closurePath FunCode) adjustArgs
       meta =

src/Juvix/Data/Error/GenericError.hs

@@ -120,3 +120,10 @@ runErrorIO' ::
   Sem (Error a ': r) b ->
   Sem r b
 runErrorIO' = runReader defaultGenericOptions . runErrorIO . raiseUnder
+
+runSimpleErrorIO :: (Members '[EmbedIO] r) => Sem (Error SimpleError ': r) a -> Sem r a
+runSimpleErrorIO m = do
+  res <- runError m
+  case res of
+    Left (SimpleError msg) -> hRenderIO True stderr msg >> exitFailure
+    Right r -> return r

src/Juvix/Prelude/Base/Foundation.hs

@@ -146,6 +146,7 @@ import Data.Int
 import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IntMap
 import Data.IntSet (IntSet)
+import Data.IntSet qualified as IntSet
 import Data.Kind qualified as GHC
 import Data.List.Extra hiding (allSame, foldr1, groupSortOn, head, last, mconcatMap, replicate, unzip)
 import Data.List.Extra qualified as List
@@ -729,6 +730,9 @@ uncurryF g input_ = uncurry g <$> input_
 intMapToList :: IntMap a -> [Indexed a]
 intMapToList = map (uncurry Indexed) . IntMap.toList
 
+intSet :: (Foldable f) => f (Int) -> IntSet
+intSet = IntSet.fromList . toList
+
 intMap :: (Foldable f) => f (Int, a) -> IntMap a
 intMap = IntMap.fromList . toList
 

src/Juvix/Prelude/Env.hs

@@ -7,22 +7,28 @@ import System.Environment
 -- | Environment variables relevant to Juvix
 data EnvVar
   = EnvWasiSysrootPath
+  | EnvAnomaPath
   deriving stock (Show, Eq)
 
 envVarString :: EnvVar -> String
 envVarString = \case
   EnvWasiSysrootPath -> "WASI_SYSROOT_PATH"
+  EnvAnomaPath -> "ANOMA_PATH"
 
 envVarHint :: EnvVar -> Maybe String
 envVarHint = \case
-  EnvWasiSysrootPath -> Just "Set to the location of the wasi-clib sysroot"
+  EnvWasiSysrootPath -> Just "It should point to the location of the wasi-clib sysroot"
+  EnvAnomaPath -> Just "It should point to the location of the Anoma repository"
 
 getEnvVar :: (MonadIO m) => EnvVar -> m String
 getEnvVar var = fromMaybeM (error (pack msg)) (liftIO (lookupEnv (envVarString var)))
   where
     msg :: String
     msg = "Missing environment variable " <> envVarString var <> maybe "" (". " <>) (envVarHint var)
 
+getAnomaPathAbs :: (MonadIO m) => m (Path Abs Dir)
+getAnomaPathAbs = absDir <$> getEnvVar EnvAnomaPath
+
 getWasiSysrootPathStr :: (MonadIO m) => m String
 getWasiSysrootPathStr = getEnvVar EnvWasiSysrootPath