add minimal radicle CI configuration

3 files changed, 135 insertions, 0 deletions

diff --git a/.radicle/native.yaml b/.radicle/native.yaml
new file mode 100644
index 0000000..4d4c0fe
--- /dev/null
+++ b/.radicle/native.yaml
@@ -0,0 +1,13 @@
+shell: |
+  # set PATH to use GHCUP installed GHC
+  export PATH=~/.cabal/bin:~/.ghcup/bin:$PATH
+  export PATH=~/.radicle/bin:$PATH
+
+  USER=$(id -un)
+  HOME=$(getent passwd "$USER" | cut -d: -f6)
+
+  ghc --version
+  cabal --version
+
+  cd lambda-calcul/haskell
+  cabal test all
diff --git a/build.hs b/build.hs
new file mode 100755
index 0000000..a27535b
--- /dev/null
+++ b/build.hs
@@ -0,0 +1,82 @@
+#!/usr/bin/env cabal
+{- cabal:
+build-depends: base
+             , directory
+             , filepath
+             , shake
+             , unix
+-}
+
+import Control.Exception (throw)
+import Control.Monad (forM_, unless)
+import Data.Functor
+import Data.Maybe
+import Development.Shake
+import System.Directory (getCurrentDirectory, setCurrentDirectory)
+import System.Environment (getArgs, lookupEnv, withArgs)
+import System.FilePath
+import System.Posix.User (getRealUserID)
+
+-- | Id of current user
+type UID = String
+
+options =
+    shakeOptions
+        { -- Generate a report that can be opened in a browser to analyze build
+          shakeReport = ["report.html"]
+        , -- Use all CPUs provided by the platform
+          shakeThreads = 0
+        , -- Put Shake's database in directory '_build'
+          shakeFiles = "_build"
+        , shakeVerbosity = Diagnostic
+        }
+
+install :: IO ()
+install = do
+    setCurrentDirectory "lambda-calcul/haskell"
+    pwd <- getCurrentDirectory
+    uid <- show . toInteger <$> getRealUserID
+    putStrLn $ "Building mli in directory " <> pwd <> " as user " <> uid
+    args <- getArgs
+    withArgs args $ runShake pwd uid
+
+runShake :: FilePath -> UID -> IO ()
+runShake pwd uid = shakeArgs options $ do
+    let needHaskellSources = do
+            needDirectoryFiles
+                "."
+                [ "src//*.hs"
+                , "test//*.hs"
+                , "data//*.*"
+                , "app//*.hs"
+                ]
+            need ["minilang.cabal"]
+
+    want ["bin/mli"]
+
+    "bin/mli" %> \bin -> do
+        needHaskellSources
+        cmd_ "cabal" ["build", "all"]
+        cmd_ "cabal" ["test", "all"]
+        Stdout exePath <- cmd "cabal" ["list-bin", "mli"]
+        dirExists <- doesDirectoryExist "bin"
+        unless dirExists $ cmd_ "mkdir" ["bin"]
+        cmd_ "cp" [head (lines exePath), bin]
+
+    -- "ui/dist/index.html" %> \_ -> do
+    --     needDirectoryFiles
+    --         "ui"
+    --         [ "src//*.js"
+    --         , "src//*.html"
+    --         , "src//*.css"
+    --         , "package.json"
+    --         , "webpack.config.js"
+    --         , ".babelrc"
+    --         ]
+    --     cmd_ (Cwd "ui") "npm" ["i"]
+    --     cmd (Cwd "ui") "npm" ["run", "all"]
+
+needDirectoryFiles dir patterns =
+    need =<< getDirectoryFiles "" ((dir </>) <$> patterns)
+
+main = install
diff --git a/lambda-calcul/haskell/src/Minilang/IO.hs b/lambda-calcul/haskell/src/Minilang/IO.hs
new file mode 100644
index 0000000..bfcb125
--- /dev/null
+++ b/lambda-calcul/haskell/src/Minilang/IO.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC "-fno-warn-orphans" #-}
+
+module Minilang.IO where
+
+import qualified Data.ByteString as BS
+import Data.Text.Encoding
+  ( decodeUtf8With,
+    encodeUtf8,
+  )
+import Data.Text.Encoding.Error (lenientDecode)
+import Minilang.Lambda.Eval hiding (rho)
+import Minilang.Parser
+import Minilang.Type
+import Prettyprinter
+import Prettyprinter.Render.Text
+import System.IO (Handle)
+
+-- | Read an `AST` from @hin@ handle, evaluate it and dump the result
+-- on @hout@.
+runEval :: Handle -> Handle -> IO ()
+runEval hin hout = do
+  programText <- decodeUtf8With lenientDecode <$> BS.hGetContents hin
+  let ast = parseProgram False programText
+      ρ = EmptyEnv
+      γ = EmptyContext
+  (ρ', _) <- loadProgram ast ρ γ
+  let val = eval ast ρ'
+
+  BS.hPut
+    hout
+    ( encodeUtf8
+        ( renderStrict $ layoutPretty defaultLayoutOptions $ pretty val
+        )
+        <> "\n"
+    )