As astute followers of this blog will know, I have been working on several ATS packages for Haskell; here I would like to present the fruits of these labors: the ability to use Haskell's Dhall library in ATS.

Motivation: Dhall in ATS

There are two reasons one would want to write Dhall bindings for ATS. The first is that ATS is a relatively obscure language and thus has relatively few libraries available. Bindings C libraries is a common way to write ATS, but as ATS is an effective systems programming language on its own, we can really bind to anything we want.

The second is that ATS has a relatively advanced type system. In practice, any type expressible in Haskell will be expressible in ATS (though not conversely). This is not the case with Rust, which does not have universally quantified types. It is well worth exploring what systems programming looks like with modern techniques, in particular passing algebraic data types between programs.

Example

Our example will not provide the full generality library bindings would. However, as ATS does not have generics, it will end up suiting our needs quite well (with the minor downside of a polyglot project).

We will proceed as follows:

This is no doubt less pleasant than using a library in a language such as Rust, but those familiar with ATS will note that this is pretty standard; offloading the hard work to generics requires us to use an entirely different language. Moreover, neither Rust nor Scala bindings for Dhall are complete, so this is in fact unique to the ATS ecosystem.

Let's first examine the Dhall expression to be parsed:

let Option = < Some : { _1 : { first : Integer, second : Integer } } | None : {} >
in
let None = < Some : { _1 : { first : Integer, second : Integer } } | None = {=} >
in
let Some = λ(x : { first : Integer, second : Integer }) → < Some = { _1 = x } | None : {} >
in
let p = { first = 1, second = 6 }
in

Some p

This is a bit abstruse, but it becomes a little clearer when we look at the Haskell:

data Option a = Some a
              | None
              deriving (Generic, Interpret, Functor, ATSStorable, Data)

data Pair a b = Pair { first :: a, second :: b }
    deriving (Generic, Interpret, ATSStorable, Data)

The Haskell is pleasantly compact, though mostly trivial:

{-# LANGUAGE DeriveAnyClass           #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE DeriveFunctor            #-}
{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings        #-}

module Foreign where

import           Data.Bifunctor
import           Data.Data
import qualified Data.Text.Lazy       as TL
import           Dhall
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Ptr
import           Foreign.Storable.ATS

data Option a = Some a
              | None
              deriving (Generic, Interpret, Functor, ATSStorable, Data)

data Pair a b = Pair { first :: a, second :: b }
    deriving (Generic, Interpret, ATSStorable, Data)

instance Bifunctor Pair where
    bimap f g (Pair x y) = Pair (f x) (g y)

type Product = Pair CInt CInt

readDhall :: FilePath -> IO (Option Product)
readDhall p = fmap (bimap g g) <$> input auto (TL.pack p)
    where g :: Integer -> CInt
          g = fromIntegral

read_dhall :: CString -> IO (Ptr (Option Product))
read_dhall cStr = do
    str <- peekCString cStr
    x <- readDhall str
    writePtr x

foreign export ccall read_dhall :: CString -> IO (Ptr (Option Product))

On the ATS side of things, we get the following generated code (from hs2ats):

datavtype option(a: vt@ype) =
  | Some of a
  | None

vtypedef pair(a: vt@ype, b: vt@ype) = @{ first = a, second = b }
vtypedef product = pair(int, int)

This will be our handwritten code:

%{^
#define STUB_H "hs/Foreign_stub.h"
#define STG_INIT __stginit_Foreign
%}

#include "$PATSHOMELOCS/hs-bind-0.4.1/runtime.dats"
#include "share/atspre_staload.hats"
#include "share/atspre_staload_libats_ML.hats"

staload "libats/ML/SATS/string.sats"
staload UN = "prelude/SATS/unsafe.sats"
staload "gen/types.sats"

fun free_option(x : option(pair(int,int))) : void =
  case+ x of
    | ~Some (x) => ()
    | ~None() => ()

fun tostring_option_pair(x : !option(pair(int,int))) : string =
  case+ x of
    | None() => "None"
    | Some (x) => let
      var f = x.first
      var s = x.second
    in
      string_append5( "Some (Pair { first = "
                    , tostring_int(f)
                    , ", second = "
                    , tostring_int(s)
                    , " })"
                    )
    end

extern
fun hs_read(string) : ptr =
  "mac#read_dhall"

implement main0 (argc, argv) =
  {
    val _ = hs_init(argc, argv)
    var x = $UN.ptr0_get<option(pair(int,int))>(hs_read("./example.dhall"))
    val s = tostring_option_pair(x)
    val _ = println!(s)
    val _ = free_option(x)
    val _ = hs_exit()
  }

And finally our configuration (first in Dhall for atspkg, then a .cabal file):

let pkg = https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/default.dhall
in
let dbin = https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/default-bin.dhall

in pkg //
  { test =
    [
      dbin //
      { src = "src/dhall-ats.dats"
      , target = "target/dhall-ats"
      , hsDeps = [ { cabalFile = "hs/foreign.cabal", objectFile = "hs/Foreign.o", projectFile = ([] : Optional Text ) } ]
      , hs2ats = [ { hs = "hs/Foreign.hs", ats = "gen/types.sats", cpphs = False } ]
      }
    ]
    , dependencies = [ "hs-bind" ]
    , ccompiler = "ghc"
    , cflags = ["hs/Foreign"]
  }
name: foreign
version: 0.1.0.0
cabal-version: >= 1.2
build-type: Simple

library
  build-depends: base < 5
               , dhall
               , filepath
               , ats-storable
               , text
  exposed-modules: Foreign
  hs-source-dirs: .
  ghc-options: -Wall -Werror -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat

This of course assumes you name your Haskell source file Foreign.hs and your ATS source src/dhall-ats.dats. You can see here for the source code if you have any trouble getting this up and running.

You should be able to now run

atspkg test

and see the result! If all went well, you should see

Some (Pair { first = 1, second = 6 })

indicating that our FFI is working correctly.

According to polyglot, our project contents are as follows:

-------------------------------------------------------------------------------
 Language             Files       Lines         Code     Comments       Blanks
-------------------------------------------------------------------------------
 ATS                      1          45           40            0            5
 Cabal                    1          14           13            0            1
 Dhall                    1          18           17            0            1
 Haskell                  1          44           35            0            9
-------------------------------------------------------------------------------
 Total                    4         121          105            0           16
-------------------------------------------------------------------------------

which is certainly less pleasant than the few lines of Haskell, but nonetheless unburdensome compared to other solutions in ATS.