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<young\_english\_speaking\_person>(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<young\_english\_speaking\_person>(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.
