Skip to content

Commit bbdc82a

Browse files
daniel-j-hdaniel-j-h
committed
Adds Haskell Bindings
https://www.meetup.com/Berlin-Functional-Programming-Group/events/241451747/
1 parent 0a326fa commit bbdc82a

File tree

10 files changed

+349
-0
lines changed

10 files changed

+349
-0
lines changed

‎.travis.yml

+16
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,10 @@ language: generic
22
sudo: required
33
dist: trusty
44

5+
cache:
6+
directories:
7+
- $HOME/.stack
8+
59
matrix:
610
fast_finish: true
711

@@ -48,6 +52,10 @@ before_install:
4852
- export CC=${CCOMPILER} CXX=${CXXCOMPILER}
4953
- if [[ "${TRAVIS_OS_NAME}" == "linux" ]]; then sudo update-alternatives --install /usr/bin/node node /usr/bin/nodejs 10; fi
5054
- if [[ "${TRAVIS_OS_NAME}" == "osx" ]]; then brew update && brew install python3; fi
55+
- mkdir -p ~/.local/bin
56+
- export PATH=$HOME/.local/bin:$PATH
57+
- if [[ "${TRAVIS_OS_NAME}" == "linux" ]]; then travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; fi
58+
- if [[ "${TRAVIS_OS_NAME}" == "osx" ]]; then travis_retry curl -L https://www.stackage.org/stack/osx-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; fi
5159

5260
install:
5361
# Make sure building libsweep works
@@ -67,6 +75,10 @@ install:
6775
- sudo python2 setup.py install
6876
- sudo python3 setup.py install
6977
- popd
78+
# Build Haskell bindings
79+
- pushd sweephs
80+
- stack --no-terminal --install-ghc build
81+
- popd
7082

7183
script:
7284
# Test libsweep examples against the dummy library
@@ -87,3 +99,7 @@ script:
8799
- pushd sweepjs
88100
- npm install
89101
- popd
102+
# Test Haskell bindings against dummy library
103+
- pushd sweephs
104+
- stack --no-terminal exec -- sweephs-exe
105+
- popd

‎sweephs/.gitignore

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
.stack-work

‎sweephs/LICENSE

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright Daniel J. Hofmann (c) 2017
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of Daniel J. Hofmann nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎sweephs/README.md

+39
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
# SweepHs
2+
3+
Haskell Scanse Sweep LiDAR library.
4+
5+
Requires `libsweep.so` to be installed.
6+
7+
### Todo
8+
9+
- [ ] Look into `ForeignPtr` vs `Ptr`
10+
- [ ] Look into `bracket` and `CondT`
11+
- [ ] Level up: `resourceT`
12+
- [ ] Level up: `conduit`
13+
14+
### Installation
15+
16+
```bash
17+
stack setup
18+
stack build
19+
```
20+
21+
### Example for testing
22+
23+
```bash
24+
stack exec -- sweephs-exe
25+
```
26+
27+
### Example for testing
28+
29+
In the following, replace `/dev/ttyUSB0` with your device's port name. This executes [`__main__.py`](sweeppy/__main__.py) (also works without the installation step).
30+
31+
```bash
32+
python -m sweeppy /dev/ttyUSB0
33+
```
34+
35+
### License
36+
37+
Copyright © 2017 Daniel J. Hofmann
38+
39+
Distributed under the MIT License (MIT).

‎sweephs/Setup.hs

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

‎sweephs/app/Main.hs

+37
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
module Main where
2+
3+
import Lib
4+
import Control.Monad
5+
import Foreign.C.String
6+
7+
main :: IO ()
8+
main = do
9+
version <- getVersion
10+
print version
11+
12+
compatible <- isAbiCompatible
13+
print compatible
14+
15+
let errorPtr = noErrorPtr
16+
17+
device <- withCString "/dev/USB0" $ flip deviceConstructSimple errorPtr
18+
19+
checkError errorPtr >>= print
20+
21+
startScanning device errorPtr
22+
checkError errorPtr >>= print
23+
24+
scan <- getScan device errorPtr
25+
checkError errorPtr >>= print
26+
27+
samples <- getSamples scan
28+
print samples
29+
30+
void $ scanDestruct scan
31+
32+
stopScanning device errorPtr
33+
checkError errorPtr >>= print
34+
35+
void $ deviceDestruct device
36+
37+
return ()

‎sweephs/src/Lib.hs

+111
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
{-# LANGUAGE ForeignFunctionInterface #-}
2+
{-# LANGUAGE DeriveAnyClass #-}
3+
4+
module Lib
5+
( getVersion
6+
, isAbiCompatible
7+
, Error
8+
, noErrorPtr
9+
, checkError
10+
, errorDestruct
11+
, Device
12+
, deviceConstructSimple
13+
, deviceDestruct
14+
, startScanning
15+
, stopScanning
16+
, getScan
17+
, scanDestruct
18+
, getSamples
19+
) where
20+
21+
import Foreign.C
22+
import Foreign.Ptr
23+
import Foreign.Storable
24+
25+
26+
-- ABI
27+
28+
foreign import ccall unsafe "sweep_get_version"
29+
getVersion :: IO CInt
30+
31+
foreign import ccall unsafe "sweep_is_abi_compatible"
32+
isAbiCompatible :: IO CInt
33+
34+
-- Errors
35+
--
36+
37+
newtype Error = Error (Ptr Error)
38+
deriving (Storable)
39+
40+
foreign import ccall unsafe "sweep_error_message"
41+
errorMessage :: Error -> IO CString
42+
43+
foreign import ccall unsafe "sweep_error_destruct"
44+
errorDestruct :: Error -> IO ()
45+
46+
noErrorPtr :: Ptr Error
47+
noErrorPtr = nullPtr
48+
49+
checkError :: Ptr Error -> IO (Maybe String)
50+
checkError errorPtr = do
51+
if errorPtr == noErrorPtr then
52+
pure $ Nothing
53+
else
54+
fmap Just (peek errorPtr >>= errorMessage >>= peekCString)
55+
56+
57+
-- Device
58+
59+
newtype Device = Device (Ptr Device)
60+
61+
foreign import ccall unsafe "sweep_device_construct_simple"
62+
deviceConstructSimple :: CString -> Ptr Error -> IO Device
63+
64+
foreign import ccall unsafe "sweep_device_destruct"
65+
deviceDestruct :: Device -> IO ()
66+
67+
foreign import ccall unsafe "sweep_device_start_scanning"
68+
startScanning :: Device -> Ptr Error -> IO ()
69+
70+
foreign import ccall unsafe "sweep_device_stop_scanning"
71+
stopScanning :: Device -> Ptr Error -> IO ()
72+
73+
foreign import ccall unsafe "sweep_device_get_scan"
74+
getScan :: Device -> Ptr Error -> IO Scan
75+
76+
-- Scan
77+
78+
newtype Scan = Scan (Ptr Scan)
79+
80+
data Sample = Sample
81+
{ sampleAngle :: Int
82+
, sampleDistance :: Int }
83+
deriving(Show, Eq)
84+
85+
foreign import ccall unsafe "sweep_scan_destruct"
86+
scanDestruct :: Scan -> IO ()
87+
88+
foreign import ccall unsafe "sweep_scan_get_number_of_samples"
89+
getNumberOfSamples :: Scan -> IO CInt
90+
91+
foreign import ccall unsafe "sweep_scan_get_angle"
92+
getAngle :: Scan -> CInt -> IO CInt
93+
94+
foreign import ccall unsafe "sweep_scan_get_distance"
95+
getDistance :: Scan -> CInt -> IO CInt
96+
97+
getSamples :: Scan -> IO [Sample]
98+
getSamples scan = do
99+
n <- getNumberOfSamples scan
100+
101+
let samples = [0..n-1]
102+
103+
sequence $ flip fmap samples (\ v -> do
104+
let convert = fromInteger . toInteger
105+
106+
angle <- getAngle scan v
107+
distance <- getDistance scan v
108+
109+
pure $ Sample { sampleAngle = convert angle
110+
, sampleDistance = convert distance })
111+

‎sweephs/stack.yaml

+66
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
# This file was automatically generated by 'stack init'
2+
#
3+
# Some commonly used options have been documented as comments in this file.
4+
# For advanced use and comprehensive documentation of the format, please see:
5+
# http://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+
# A snapshot resolver dictates the compiler version and the set of packages
9+
# to be used for project dependencies. For example:
10+
#
11+
# resolver: lts-3.5
12+
# resolver: nightly-2015-09-21
13+
# resolver: ghc-7.10.2
14+
# resolver: ghcjs-0.1.0_ghc-7.10.2
15+
# resolver:
16+
# name: custom-snapshot
17+
# location: "./custom-snapshot.yaml"
18+
resolver: lts-8.22
19+
20+
# User packages to be built.
21+
# Various formats can be used as shown in the example below.
22+
#
23+
# packages:
24+
# - some-directory
25+
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
26+
# - location:
27+
# git: https://github.com/commercialhaskell/stack.git
28+
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
29+
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
30+
# extra-dep: true
31+
# subdirs:
32+
# - auto-update
33+
# - wai
34+
#
35+
# A package marked 'extra-dep: true' will only be built if demanded by a
36+
# non-dependency (i.e. a user package), and its test suites and benchmarks
37+
# will not be run. This is useful for tweaking upstream packages.
38+
packages:
39+
- '.'
40+
# Dependency packages to be pulled from upstream that are not in the resolver
41+
# (e.g., acme-missiles-0.3)
42+
extra-deps: []
43+
44+
# Override default flag values for local packages and extra-deps
45+
flags: {}
46+
47+
# Extra package databases containing global packages
48+
extra-package-dbs: []
49+
50+
# Control whether we use the GHC we find on the path
51+
# system-ghc: true
52+
#
53+
# Require a specific version of stack, using version ranges
54+
# require-stack-version: -any # Default
55+
# require-stack-version: ">=1.3"
56+
#
57+
# Override the architecture used by stack, especially useful on Windows
58+
# arch: i386
59+
# arch: x86_64
60+
#
61+
# Extra directories used by stack for building
62+
# extra-include-dirs: [/path/to/dir]
63+
# extra-lib-dirs: [/path/to/dir]
64+
#
65+
# Allow a newer minor version of GHC than the snapshot specifies
66+
# compiler-check: newer-minor

‎sweephs/sweephs.cabal

+45
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
name: sweephs
2+
version: 0.1.0.0
3+
synopsis: Haskell bindings for the Sweep LiDAR
4+
description: Haskell bindings for the Sweep LiDAR low-level libsweep: <https://github.com/scanse/sweep-sdk>
5+
homepage: https://github.com/daniel-j-h/sweephs#readme
6+
license: BSD3
7+
license-file: LICENSE
8+
author: Daniel J. Hofmann
9+
maintainer: [email protected]
10+
copyright: Daniel J. Hofmann
11+
category: Hardware
12+
build-type: Simple
13+
extra-source-files: README.md
14+
cabal-version: >=1.10
15+
extra-source-files:
16+
README.md
17+
18+
library
19+
hs-source-dirs: src
20+
exposed-modules: Lib
21+
build-depends: base >= 4.7 && < 5
22+
default-language: Haskell2010
23+
ghc-options: -Wall
24+
extra-libraries: sweep
25+
26+
executable sweephs-exe
27+
hs-source-dirs: app
28+
main-is: Main.hs
29+
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
30+
build-depends: base
31+
, sweephs
32+
default-language: Haskell2010
33+
34+
test-suite sweephs-test
35+
type: exitcode-stdio-1.0
36+
hs-source-dirs: test
37+
main-is: Spec.hs
38+
build-depends: base
39+
, sweephs
40+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
41+
default-language: Haskell2010
42+
43+
source-repository head
44+
type: git
45+
location: https://github.com/daniel-j-h/sweephs

‎sweephs/test/Spec.hs

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
main :: IO ()
2+
main = putStrLn "Test suite not yet implemented"

0 commit comments

Comments
 (0)