ATS is an incredibly apt systems programming language; as it compiles to C it enjoys all the versatility that C does. In particular, this means that we get some flexibility from the ability to import from high-level languages as well as export to them.

This method is particularly appealing when writing ATS, as ATS has a sparse library support. For a complex task such as making an interpreter for Dhall, writing an entire ATS library is simply infeasible. While the approach contained here is somewhat clumsy in places, it's guaranteed to be correct and up-to-date even for complex tasks.

Tooling

Once again we'll be using pi and atspkg for our builds. You can look at the post here for more details on installing them.

We'll initialize a project with

pi git vmchale/ats-haskell aeson-demo cd aeson

Configuration

Configuration for this build will be pretty simple due to using the template. We just have to add a couple dependencies to our .cabal file. Open up hs/aeson-demo.cabal. You should see the following:

name: aeson-demo version: 0.1.0.0 cabal-version: >= 1.2 build-type: Simple

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

Edit the build-depends field so that it contains the following:

build-depends: base < 5 , ats-storable , aeson , bytestring

Haskell

The Haskell side of things will contain most of the boilerplate. This is unfortunate, but for simple cases it's manageable. For the sake of our tutorial, the example will be fairly simple. JSON only has product types, so all the heavy lifting can be done by generics.

Open up hs/AesonDemo.hs; you should see the following:

{-# LANGUAGE ForeignFunctionInterface #-}

module AesonDemo where

hello_world :: IO () hello_world = putStrLn "Hello from Haskell!"

foreign export ccall hello_world :: IO ()

We'll change the templated file to the following:

{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE IncoherentInstances #-}

module AesonDemo where

import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Maybe (fromJust) import Foreign.C.String import Foreign.Ptr import Foreign.Storable.ATS import GHC.Generics

data Person a b = Person { name :: a , age :: b } deriving (Generic, ToJSON, FromJSON, ATSStorable)

type YoungEnglishSpeakingPerson = (Person CString Int)

decodeFail :: String -> Person String Int decodeFail = fromJust . decode . BSL.pack

strToCStr :: Person String a -> IO (Person CString a) strToCStr (Person s x) = Person <$> newCString s <*> pure x

decode_json :: CString -> IO (Ptr YoungEnglishSpeakingPerson) decode_json cstr = g =<< peekCString cstr where g = writePtr <=< strToCStr . decodeFail

foreign export ccall decode_json :: CString -> IO (Ptr YoungEnglishSpeakingPerson)

This is all a bit dense. Let's start by examining the extensions.

{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE IncoherentInstances #-}

Most of this is pretty familiar - ForeignFunctionInterface to allow us to export Haskell functions, and various Derive extensions allow us to derive ATSStorable for YoungEnglishSpeakingPerson.

The presence of IncoherentInstances may be unsettling however. There's not really a sufficient reason behind this, other than that the author of ats-storable used some inadvisable instances to get things working. It will suit our case just fine.

data Person a b = Person { name :: a , age :: b } deriving (Generic, ToJSON, FromJSON, ATSStorable)

type YoungEnglishSpeakingPerson = (Person CString Int)

Next are our data types. We create one (general) type that will suit both marshaling to foreign values and decoding from JSON. Note the use of CString for our second type - this will enable sharing of strings between Haskell and ATS.

decodeFail :: String -> Person String Int decodeFail = fromJust . decode . BSL.pack

strToCStr :: Person String a -> IO (Person CString a) strToCStr (Person s x) = Person <$> newCString s <*> pure x

decode_json :: CString -> IO (Ptr YoungEnglishSpeakingPerson) decode_json cstr = g =<< peekCString cstr where g = writePtr <=< strToCStr . decodeFail

foreign export ccall decode_json :: CString -> IO (Ptr YoungEnglishSpeakingPerson)

Finally, we get a small bit of boilerplate. Some of this is predictable (a foreign export declaration), but there are also a few regrettable conversions between string types.

Note that ATSStorable provides the writePtr function - this allows us to directly write a value to some pointer, which will then be passed to ATS.

ATS

Open up src/aeson-demo.dats. You should see the following:

%{^ #define STUB_H "hs/AesonDemo_stub.h" #define STG_INIT __stginit_AesonDemo %}

#include "$PATSHOMELOCS/hs-bind-0.4.1/runtime.dats"

extern fun hs_hello_world() : void = "mac#hello_world"

implement main0(argc, argv) = { val _ = hs_init(argc, argv) val _ = hs_hello_world() val _ = hs_exit() }

The ATS will have been (partly) generated by atspkg for us; we will replace the ATS side of things with the following:

%{^ #define STUB_H "hs/AesonDemo_stub.h" #define STG_INIT __stginit_AesonDemo %}

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

staload UN = "prelude/SATS/unsafe.sats" staload ".atspkg/hs2ats/gen.sats"

fun free_yesp(x: young_english_speaking_person) : void = strptr_free(x.name)

fun print_p(j : !young_english_speaking_person) : void = { val _ = println!(j.name) val _ = println!(j.age) }

extern fun hs_decode_json(string) : ptr = "mac#decode_json"

implement main0 (argc, argv) = { val _ = hs_init(argc, argv) val p = hs_decode_json("{ \"name\": \"Joe\", \"age\": 12 }") val _ = hs_exit() val j = $UN.ptr0_get(p) val _ = print_p(j) val _ = free_yesp(j) }

This is also a bit dense. Let's begin by examining the spliced C and corresponding includes.

%{^ #define STUB_H "hs/AesonDemo_stub.h" #define STG_INIT __stginit_AesonDemo

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

This defines two C macros that are used by the hs_bind package to initialize the Haskell runtime. We then have a bit of ATS boilerplate:

fun free_yesp(x : young_english_speaking_person) : void = strptr_free(x.name)

fun print_p(j : !young_english_speaking_person) : void = { val _ = println!(j.name) val _ = println!(j.age) }

The free_yesp function is necessary as atspkg generates only viewtypes by default and hence converted out Haskell String to ATS' Strptr1 (this is necessary for memory-safe programs as running two garbage collectors at once is inadvisable). You can examine .atspkg/hs2ats/gen.sats if you want to know exactly what the type definitions are.

Next is the external function declaration (we exported this function in the Haskell module earlier):

extern fun hs_decode_json(string) : ptr = "mac#decode_json"

Finally, the main0 function:

implement main0 (argc, argv) = { val _ = hs_init(argc, argv) val p = hs_decode_json("{ \"name\": \"Joe\", \"age\": 12 }") val _ = hs_exit() val j = $UN.ptr0_get(p) val _ = print_p(j) val _ = free_yesp(j) }

As Haskell functions require the Haskell runtime to work at all, we call hs_init() before doing anything. We only keep the Haskell runtime active long enough to call hs_decode_json(), after which we can call hs_exit(), read the value at the pointer, and print it out as in a normal ATS program.

We can now build the project with

atspkg build

If all goes well, you can the run the demo with

./target/aeson-demo

Coda

This is not the same as actual library support. But crucially, it's easier than writing an entire library in ATS; one of the strengths of ATS is its ability to interface with foreign code written in a language that has features that it doesn't (in this case, generic data types). As writing ATS can be difficult at times, this is a welcome technique.