From c96628b4848fa6ad654f675ad8469e2ce635a054 Mon Sep 17 00:00:00 2001 From: "Daniel J. Hofmann" Date: Sat, 15 Jul 2017 01:18:42 +0200 Subject: [PATCH] Adds Haskell Bindings https://www.meetup.com/Berlin-Functional-Programming-Group/events/241451747/ --- .travis.yml | 16 ++++++ sweephs/.gitignore | 1 + sweephs/LICENSE | 30 ++++++++++++ sweephs/README.md | 39 +++++++++++++++ sweephs/Setup.hs | 2 + sweephs/app/Main.hs | 42 ++++++++++++++++ sweephs/src/Lib.hs | 111 ++++++++++++++++++++++++++++++++++++++++++ sweephs/stack.yaml | 66 +++++++++++++++++++++++++ sweephs/sweephs.cabal | 45 +++++++++++++++++ sweephs/test/Spec.hs | 2 + 10 files changed, 354 insertions(+) create mode 100644 sweephs/.gitignore create mode 100644 sweephs/LICENSE create mode 100644 sweephs/README.md create mode 100644 sweephs/Setup.hs create mode 100644 sweephs/app/Main.hs create mode 100644 sweephs/src/Lib.hs create mode 100644 sweephs/stack.yaml create mode 100644 sweephs/sweephs.cabal create mode 100644 sweephs/test/Spec.hs diff --git a/.travis.yml b/.travis.yml index 0ff7425..994decf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,6 +2,10 @@ language: generic sudo: required dist: trusty +cache: + directories: + - $HOME/.stack + matrix: fast_finish: true @@ -48,6 +52,10 @@ before_install: - export CC=${CCOMPILER} CXX=${CXXCOMPILER} - if [[ "${TRAVIS_OS_NAME}" == "linux" ]]; then sudo update-alternatives --install /usr/bin/node node /usr/bin/nodejs 10; fi - if [[ "${TRAVIS_OS_NAME}" == "osx" ]]; then brew update && brew install python3; fi + - mkdir -p ~/.local/bin + - export PATH=$HOME/.local/bin:$PATH + - 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 + - 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 install: # Make sure building libsweep works @@ -67,6 +75,10 @@ install: - sudo python2 setup.py install - sudo python3 setup.py install - popd + # Build Haskell bindings + - pushd sweephs + - stack --no-terminal --install-ghc build + - popd script: # Test libsweep examples against the dummy library @@ -87,3 +99,7 @@ script: - pushd sweepjs - npm install - popd + # Test Haskell bindings against dummy library + - pushd sweephs + - stack --no-terminal exec -- sweephs-exe "/dev/ttyUSB0" + - popd diff --git a/sweephs/.gitignore b/sweephs/.gitignore new file mode 100644 index 0000000..8ee1bf9 --- /dev/null +++ b/sweephs/.gitignore @@ -0,0 +1 @@ +.stack-work diff --git a/sweephs/LICENSE b/sweephs/LICENSE new file mode 100644 index 0000000..9da64a8 --- /dev/null +++ b/sweephs/LICENSE @@ -0,0 +1,30 @@ +Copyright Daniel J. Hofmann (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Daniel J. Hofmann nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/sweephs/README.md b/sweephs/README.md new file mode 100644 index 0000000..9ba2037 --- /dev/null +++ b/sweephs/README.md @@ -0,0 +1,39 @@ +# SweepHs + +Haskell Scanse Sweep LiDAR library. + +Requires `libsweep.so` to be installed. + +### Todo + +- [ ] Look into `ForeignPtr` vs `Ptr` +- [ ] Look into `bracket` and `CondT` +- [ ] Level up: `resourceT` +- [ ] Level up: `conduit` + +### Installation + +```bash +stack setup +stack build +``` + +### Example for testing + +```bash +stack exec -- sweephs-exe +``` + +### Example for testing + +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). + +```bash +python -m sweeppy /dev/ttyUSB0 +``` + +### License + +Copyright © 2017 Daniel J. Hofmann + +Distributed under the MIT License (MIT). diff --git a/sweephs/Setup.hs b/sweephs/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/sweephs/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/sweephs/app/Main.hs b/sweephs/app/Main.hs new file mode 100644 index 0000000..55d2257 --- /dev/null +++ b/sweephs/app/Main.hs @@ -0,0 +1,42 @@ +module Main where + +import Lib +import Control.Monad +import System.Environment +import Foreign.C.String + +main :: IO () +main = do + args <- getArgs + guard $ not $ null args + let dev = head args + + version <- getVersion + print version + + compatible <- isAbiCompatible + print compatible + + let errorPtr = noErrorPtr + + device <- withCString dev $ flip deviceConstructSimple errorPtr + + checkError errorPtr >>= print + + startScanning device errorPtr + checkError errorPtr >>= print + + scan <- getScan device errorPtr + checkError errorPtr >>= print + + samples <- getSamples scan + print samples + + void $ scanDestruct scan + + stopScanning device errorPtr + checkError errorPtr >>= print + + void $ deviceDestruct device + + return () diff --git a/sweephs/src/Lib.hs b/sweephs/src/Lib.hs new file mode 100644 index 0000000..c871926 --- /dev/null +++ b/sweephs/src/Lib.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Lib + ( getVersion + , isAbiCompatible + , Error + , noErrorPtr + , checkError + , errorDestruct + , Device + , deviceConstructSimple + , deviceDestruct + , startScanning + , stopScanning + , getScan + , scanDestruct + , getSamples + ) where + +import Foreign.C +import Foreign.Ptr +import Foreign.Storable + + +-- ABI + +foreign import ccall unsafe "sweep_get_version" + getVersion :: IO CInt + +foreign import ccall unsafe "sweep_is_abi_compatible" + isAbiCompatible :: IO CInt + +-- Errors +-- + +newtype Error = Error (Ptr Error) + deriving (Storable) + +foreign import ccall unsafe "sweep_error_message" + errorMessage :: Error -> IO CString + +foreign import ccall unsafe "sweep_error_destruct" + errorDestruct :: Error -> IO () + +noErrorPtr :: Ptr Error +noErrorPtr = nullPtr + +checkError :: Ptr Error -> IO (Maybe String) +checkError errorPtr = do + if errorPtr == noErrorPtr then + pure $ Nothing + else + fmap Just (peek errorPtr >>= errorMessage >>= peekCString) + + +-- Device + +newtype Device = Device (Ptr Device) + +foreign import ccall unsafe "sweep_device_construct_simple" + deviceConstructSimple :: CString -> Ptr Error -> IO Device + +foreign import ccall unsafe "sweep_device_destruct" + deviceDestruct :: Device -> IO () + +foreign import ccall unsafe "sweep_device_start_scanning" + startScanning :: Device -> Ptr Error -> IO () + +foreign import ccall unsafe "sweep_device_stop_scanning" + stopScanning :: Device -> Ptr Error -> IO () + +foreign import ccall unsafe "sweep_device_get_scan" + getScan :: Device -> Ptr Error -> IO Scan + +-- Scan + +newtype Scan = Scan (Ptr Scan) + +data Sample = Sample + { sampleAngle :: Int + , sampleDistance :: Int } + deriving(Show, Eq) + +foreign import ccall unsafe "sweep_scan_destruct" + scanDestruct :: Scan -> IO () + +foreign import ccall unsafe "sweep_scan_get_number_of_samples" + getNumberOfSamples :: Scan -> IO CInt + +foreign import ccall unsafe "sweep_scan_get_angle" + getAngle :: Scan -> CInt -> IO CInt + +foreign import ccall unsafe "sweep_scan_get_distance" + getDistance :: Scan -> CInt -> IO CInt + +getSamples :: Scan -> IO [Sample] +getSamples scan = do + n <- getNumberOfSamples scan + + let samples = [0..n-1] + + sequence $ flip fmap samples (\ v -> do + let convert = fromInteger . toInteger + + angle <- getAngle scan v + distance <- getDistance scan v + + pure $ Sample { sampleAngle = convert angle + , sampleDistance = convert distance }) + diff --git a/sweephs/stack.yaml b/sweephs/stack.yaml new file mode 100644 index 0000000..7adcd7f --- /dev/null +++ b/sweephs/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-8.22 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.3" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/sweephs/sweephs.cabal b/sweephs/sweephs.cabal new file mode 100644 index 0000000..d301299 --- /dev/null +++ b/sweephs/sweephs.cabal @@ -0,0 +1,45 @@ +name: sweephs +version: 0.1.0.0 +synopsis: Haskell bindings for the Sweep LiDAR +description: Haskell bindings for the Sweep LiDAR low-level libsweep: +homepage: https://github.com/daniel-j-h/sweephs#readme +license: BSD3 +license-file: LICENSE +author: Daniel J. Hofmann +maintainer: daniel@trvx.org +copyright: Daniel J. Hofmann +category: Hardware +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 +extra-source-files: + README.md + +library + hs-source-dirs: src + exposed-modules: Lib + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + ghc-options: -Wall + extra-libraries: sweep + +executable sweephs-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , sweephs + default-language: Haskell2010 + +test-suite sweephs-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , sweephs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/daniel-j-h/sweephs diff --git a/sweephs/test/Spec.hs b/sweephs/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/sweephs/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"