Introduce more Lua APIs

Makefile

@@ -20,6 +20,9 @@ style: ## Run the code styler (fourmolu and cabal-fmt)
 	@cabal-fmt -i *.cabal
 	@fourmolu -q --mode inplace test src
 
+tags: ## Generate ctags for the project with `ghc-tags`
+	@ghc-tags -c
+
 help: ## Display this help message
 	@grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | awk 'BEGIN {FS = ":.* ?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}'
 

confer.cabal

@@ -51,7 +51,7 @@ common ghc-options
     ghc-options:
       -flate-specialise -funbox-strict-fields
       -finline-generics-aggressively -fexpose-all-unfoldings
-      -Werror=extended-warnings -Wunused-packages 
+      -Werror=extended-warnings -Wunused-packages
 
 common rts-options
   ghc-options: -rtsopts -threaded "-with-rtsopts=-N -T"
@@ -62,28 +62,33 @@ library
 
   -- cabal-fmt: expand src/
   exposed-modules:
+    Confer.API.Host
+    Confer.API.User
     Confer.Cmd.Check
     Confer.Config.Evaluator
     Confer.Config.Types
     Confer.Effect.Symlink
 
   build-depends:
+    , aeson
     , base
+    , directory
     , effectful
     , effectful-core
+    , filepath
+    , hostname
     , hslua-aeson
     , hslua-core
     , hslua-marshalling
-    , directory
-    , aeson
-    , filepath
+    , hslua-module-system
+    , hslua-packaging
     , placeholder
     , text
+    , text-display
     , vector
 
   if !flag(release)
-    build-depends:
-      placeholder
+    build-depends: placeholder
 
   hs-source-dirs:  src
 
@@ -100,8 +105,7 @@ executable confer
     , optparse-applicative
 
   if !flag(release)
-    build-depends:
-      placeholder
+    build-depends: placeholder
 
   hs-source-dirs: app
 
@@ -112,7 +116,6 @@ test-suite confer-test
   type:           exitcode-stdio-1.0
   hs-source-dirs: test
   main-is:        Main.hs
-
   other-modules:
   build-depends:
     , base

doc/MANUAL.md

@@ -36,9 +36,9 @@ Display the help message.
 ### Configuration overrides
 
 #### `--arch=<arch>`
-  Override the detected architecturein the configuration file.
+Override the detected architecturein the configuration file.
 
-  With `arch` as:
+With `arch` as:
 
 * aarch64
 * x86_64
@@ -55,6 +55,36 @@ With `os` as:
 #### `--hostname=<hostname>`
 Override the host name detected in the configuration file.
 
+### CONFIGURATION
+
+The configuration is written in a Lua file with facts and deployement rules.
+
+To express a symbolic link of your `.gitconfig` file within your home directory, write:
+
+```lua
+local git_deployment = confer.fact({
+  -- The name of this fact.
+  name = "git",
+  -- The file or directory that you want to link.
+  source = ".gitconfig",
+  -- The directory in which the link will be made.
+  destination = "~/"
+})
+```
+Then we add a rule that holds potential conditions for this deployment to occur:
+The name of the host has to be `my-laptop`. If this condition is not met,
+the deployment will be ignored.
+
+```lua
+local laptop = confer.deploy({
+  hostname = "my-laptop",
+  facts = {
+    git_deployment,
+    },
+})
+
+```
+
 ### EXAMPLES
 
 #### Example configuration
@@ -105,8 +135,9 @@ return {
 
 Confer provides its own utilities to be used in Lua:
 
+### Host API
 
-#### `confer.os`:
+#### `host.os`:
 The operating system identifier of the host.
 It is either inferred from your host, or overriden by the `--os` command-line option.
 
@@ -115,19 +146,25 @@ Possible values:
 * freebsd
 * linux
 * windows
-    
-#### `confer.arch`:
+
+#### `host.arch`:
 The architecture identifier of the host.
 It is either inferred from your host, or overriden by the `--arch` command-line option.
 
 Possible values:
 * aarch64
 * x86_64
 
-#### `confer.hostname`
+#### `host.hostname`
 The hostname of the host.
 It is either inferred from your host, or overriden by the `--hostname` command-line option.
 
+### User API
+
+#### `user.home`
+The home directory of the current user.
+
+### Confer API
 
 #### `confer.deploy`
 A dictionary called `Deployment` that takes the following constructors:

doc/confer_example.lua

@@ -1,19 +1,25 @@
+local confer = require("confer");
+local user = require("user");
+
 local git_deployment = confer.fact({
   name = "git",
-  source = "./git",
-  destination = "~/"
+  source = ".gitconfig",
+  destination = user.home
 })
 
+print(confer)
+print(user)
+
 local zsh_deployment = confer.fact({
   name = "zsh",
-  source = "zsh",
-  destination = "~/"
+  source = ".zsh",
+  destination = user.home
 })
 
 local kitty_deployment = confer.fact({
   name = "kitty",
   source = "./kitty",
-  destination = "~/.config/"
+  destination = user.home .. "/.config",
 })
 
 local laptop = confer.deploy({

src/Confer/API/Host.hs

@@ -0,0 +1,38 @@
+module Confer.API.Host where
+
+import Effectful
+import HsLua.Core (Exception)
+import HsLua.Core qualified as Lua
+import HsLua.Marshalling
+import HsLua.Module.System (arch, os)
+import HsLua.Packaging
+import Network.HostName
+
+mkHostModule :: (IOE :> es) => Eff es (Module Exception)
+mkHostModule = do
+  hostname <- mkHostname
+  pure Module
+    { moduleName = "host"
+    , moduleFields = 
+          [ arch
+          , os
+          , hostname
+          ]
+    , moduleFunctions = []
+    , moduleOperations = []
+    , moduleTypeInitializers = []
+    , moduleDescription =
+        "Access to the system's information and file functionality."
+    }
+
+-- | Module field containing the machine's hostname.
+mkHostname :: (IOE :> es) => Eff es (Field Exception)
+mkHostname = do
+  hostnameString <- liftIO getHostName
+  pure Field
+    { fieldName = "hostname"
+    , fieldType = "string"
+    , fieldDescription =
+        "The machine's hostname."
+    , fieldPushValue = pushString hostnameString
+    }

src/Confer/API/User.hs

@@ -0,0 +1,36 @@
+module Confer.API.User where
+
+import Effectful
+import Effectful.FileSystem qualified as FileSystem
+import Effectful.FileSystem (FileSystem)
+import HsLua.Core (Exception)
+import HsLua.Core qualified as Lua
+import HsLua.Marshalling
+import HsLua.Packaging
+
+mkUserModule :: (FileSystem :> es) => Eff es (Module Exception)
+mkUserModule = do
+  home <- mkHome
+  pure  Module
+    { moduleName = "user"
+    , moduleFields = 
+          [ home
+          ]
+    , moduleFunctions = []
+    , moduleOperations = []
+    , moduleTypeInitializers = []
+    , moduleDescription =
+        "Access to the user's information"
+    }
+
+-- | Module field containing the machine's hostname.
+mkHome :: (FileSystem :> es) => Eff es (Field Exception)
+mkHome = do
+  homeDirectory <- FileSystem.getHomeDirectory
+  pure Field
+    { fieldName = "home"
+    , fieldType = "string"
+    , fieldDescription =
+        "The user's HOME directory"
+    , fieldPushValue = pushString homeDirectory
+    }

src/Confer/Cmd/Check.hs

@@ -1,10 +1,25 @@
 module Confer.Cmd.Check (check) where
 
+import Data.Foldable
+import Data.Text.Display
+import Data.Text.IO qualified as Text
 import Effectful
+import Effectful.FileSystem (FileSystem)
+import Effectful.FileSystem qualified as FileSystem
+import System.OsPath ((</>))
+import System.OsPath qualified as OsPath
 
-import Confer.Effect.Symlink
 import Confer.Config.Evaluator
+import Confer.Config.Types
 
-check :: (IOE :> es, Symlink :> es) => Eff es ()
+check :: (IOE :> es, FileSystem :> es) => Eff es ()
 check = do
-  loadConfiguration >>= liftIO . print
+  loadConfiguration >>= \case
+    Right deployments -> 
+      forM_ deployments $ \deployment -> 
+        forM_ deployment.facts $ \fact -> do
+          liftIO $ Text.putStrLn $ "[+] Checking " <> display fact
+          let osPath = (fact.destination </> fact.source)
+          filePath <- (liftIO $ OsPath.decodeFS osPath)
+          FileSystem.pathIsSymbolicLink filePath
+    Left e -> error e

src/Confer/Config/Evaluator.hs

@@ -7,51 +7,68 @@ import Data.Vector (Vector)
 import Data.Vector qualified as Vector
 import Debug.Trace
 import Effectful
+import Effectful.FileSystem (FileSystem)
 import HsLua.Core (Exception)
 import HsLua.Core qualified as Lua
 import HsLua.Marshalling (Result, Peeker)
 import HsLua.Marshalling qualified as Lua
-import System.IO (utf8)
+import HsLua.Module.System qualified as Lua.System
+import HsLua.Packaging.Module qualified as Lua
+import System.IO (utf8, utf16le)
 import System.OsPath (OsPath)
 import System.OsPath qualified as OsPath
 import System.OsPath.Encoding qualified as OsPath
 
 import Confer.Config.Types
+import Confer.API.Host qualified as API
+import Confer.API.User qualified as API
 
-loadConfiguration :: (IOE :> es) => Eff es (Result (Vector Deployment))
-loadConfiguration= liftIO $ Lua.run $ do
-  Lua.openlibs -- load the default Lua packages
-  apiLoadStatus <- Lua.dofile (Just "./runtime/lua/confer.lua")  -- load and run the program
-  liftIO $ putStrLn $ "[+] API loaded: " <> show apiLoadStatus
-  Lua.setglobal "confer"
-  configLoadStatus <- Lua.dofile (Just "./doc/confer_example.lua")  -- load and run the program
-  liftIO $ putStrLn $ "[+] Configuration file loaded: " <> show configLoadStatus
-  Lua.runPeeker peekConfig Lua.top
+loadConfiguration :: (IOE :> es, FileSystem :> es) => Eff es (Either String (Vector Deployment))
+loadConfiguration = do
+  userModule <- API.mkUserModule
+  hostModule <- API.mkHostModule
+  liftIO $ Lua.run $ do
+    Lua.openlibs -- load the default Lua packages
+    apiLoadStatus <- Lua.dofile (Just "./runtime/lua/confer.lua")  -- load and run the program
+    liftIO $ putStrLn $ "[+] API loaded: " <> show apiLoadStatus
+    Lua.registerModule Lua.System.documentedModule
+    Lua.registerModule userModule
+    Lua.registerModule hostModule
+    configLoadStatus <- Lua.dofile (Just "./doc/confer_example.lua")  -- load and run the program
+    liftIO $ putStrLn $ "[+] Configuration file loaded: " <> show configLoadStatus
+    Lua.resultToEither <$> Lua.runPeeker peekConfig Lua.top
 
 peekConfig :: Peeker Exception (Vector Deployment)
 peekConfig index = Lua.retrieving "config" $
   Vector.fromList <$> Lua.peekList peekDeployment index
 
 peekDeployment :: Peeker Exception Deployment
 peekDeployment index = Lua.retrieving "deployment" $ do
-  hostname <- Lua.peekFieldRaw (Lua.peekNilOr Lua.peekText) "hostname" index
-  architecture <- Lua.peekFieldRaw (Lua.peekNilOr Lua.peekText) "architecture" index
-  os <- Lua.peekFieldRaw (Lua.peekNilOr Lua.peekText) "os" index
-  facts <- Vector.fromList <$> Lua.peekFieldRaw (Lua.peekList peekFact) "facts" index
+  hostname <- Lua.retrieving "deployment.hostname" $
+    Lua.peekFieldRaw (Lua.peekNilOr Lua.peekText) "hostname" index
+  architecture <- Lua.retrieving "deployment.architecture" $
+    Lua.peekFieldRaw (Lua.peekNilOr Lua.peekText) "architecture" index
+  os <- Lua.retrieving "deployment.os" $
+    Lua.peekFieldRaw (Lua.peekNilOr Lua.peekText) "os" index
+  facts <- Lua.retrieving "deployment.facts" $
+    Vector.fromList <$> Lua.peekFieldRaw (Lua.peekList peekFact) "facts" index
   let deployment = Deployment{..}
   pure deployment
 
 peekFact :: Peeker Exception Fact
 peekFact index = Lua.retrieving "fact" $ do
-  name <- Lua.peekFieldRaw Lua.peekText "name" index
-  source <- Lua.peekFieldRaw peekOsPath "source" index
-  destination <- Lua.peekFieldRaw peekOsPath "destination" index
+  name <- Lua.retrieving "fact.name" $
+    Lua.peekFieldRaw Lua.peekText "name" index
+  source <- Lua.retrieving "fact.source" $
+    Lua.peekFieldRaw peekOsPath "source" index
+  destination <- Lua.retrieving "fact.destination" $
+    Lua.peekFieldRaw peekOsPath "destination" index
   let fact = Fact{..}
   pure fact
 
 peekOsPath :: Peeker Exception OsPath
 peekOsPath index = do
   result <- Lua.peekText index
-  case OsPath.encodeWith utf8 utf8 (Text.unpack result) of
+  case OsPath.encodeWith utf8 utf16le (Text.unpack result) of
     Right p -> pure p
     Left e -> fail $ OsPath.showEncodingException e