Source

NXT / tests / Robotics / NXT / Basic.hs

Full commit
module Robotics.NXT.Basic where

import Control.Applicative
import Control.Monad.State hiding (state, runState)
import qualified Data.ByteString.Lazy as B
import Data.IORef
import Data.Maybe
import Data.Time.Clock.POSIX
import System.FilePath
import System.IO
import Test.HUnit

import Robotics.NXT
import Robotics.NXT.Remote
import Robotics.NXT.Sensor.Ultrasonic

basicTests :: IORef NXTInternals -> [Test]
basicTests ref = map (\x -> x ref) [
    testDeviceInfo,
    testProgramUpload,
    testDeviceInit,
    testOutputState,
    testInputMode,
    testUltrasonicSensor
  ]

keepAliveAfter :: Int
keepAliveAfter = 4 * 60 -- 4 minutes (in seconds)

-- Maybe sends a keep alive packet - if more than keepAliveAfter seconds passed from a previous one
maybeKeepAlive :: NXT ()
maybeKeepAlive = do
  lka <- getLastKeepAliveTime
  let lka' = fromMaybe 0 lka
  current <- liftIO getPOSIXTime
  if current - lka' > fromIntegral keepAliveAfter
    then keepAlive
    else return () -- it is not yet time to send a keep alive packet

testNXT :: IORef NXTInternals -> NXT a -> IO a
testNXT ref t = do
  let t' = do r <- t
              maybeKeepAlive
              return r
  nxt <- readIORef ref
  (res, nxt') <- runNXT t' nxt
  writeIORef ref nxt'
  return res

testDeviceInfo :: IORef NXTInternals -> Test
testDeviceInfo ref = TestLabel "testDeviceInfo" $ TestCase $ do
  (DeviceInfo name address _ _) <- testNXT ref getDeviceInfo
  assertBool "name" (not . null $ name)
  putStrLn $ "NXT Name: " ++ name
  assertBool "address" (not . null $ address)
  putStrLn $ "NXT Address: " ++ address

remoteProgramFilename :: String
remoteProgramFilename = "remote/remote.nxc"

testProgramUpload :: IORef NXTInternals -> Test
testProgramUpload ref = TestLabel "testProgramUpload" $ TestCase $ do
  testNXT ref $ do
    stopProgramConfirm
    h <- liftIO $ openBinaryFile remoteProgramFilename ReadMode
    size <- liftIO $ hFileSize h
    content <- liftIO $ B.unpack <$> B.hGetContents h
    let filename = takeFileName remoteProgramFilename
    deleteConfirm filename
    h' <- openWrite filename (fromIntegral size)
    mapM_ (write h') $ chunk 61 content
    close h'
  where chunk _ [] = [[]]
        chunk n xs = y1 : chunk n y2
          where (y1, y2) = splitAt n xs

testDeviceInit :: IORef NXTInternals -> Test
testDeviceInit ref = TestLabel "testDeviceInit" $ TestCase $ do
  testNXT ref $ do
    startRemoteProgram
    mapM_ resetInputScaledValue [One ..]
    mapM_ (`resetMotorPosition` AbsolutePosition) [A ..]
    mapM_ (`resetMotorPosition` RelativePosition) [A ..]
    mapM_ (`resetMotorPosition` InternalPosition) [A ..]
    setOutputStateConfirm A 0 [MotorOn, Brake] RegulationModeIdle 0 MotorRunStateRunning 0
    setOutputStateConfirm B 0 [MotorOn, Brake] RegulationModeIdle 0 MotorRunStateRunning 0
    setOutputStateConfirm C 0 [MotorOn, Brake] RegulationModeIdle 0 MotorRunStateRunning 0

waitfor :: NXT (Bool, Int) -> NXT Bool
waitfor cond = waitfor' []
  where window        = 6
        allowed       = 10
        waitfor' prev = do
          (c, r) <- cond
          let prev'  = take window $ (abs r):prev
              prev'' = derive $ prev'
              speed  = (sum prev'') `div` (length prev'')
          if c
            then return True
            else if length prev' < window
                   then waitfor' prev'
                   else if speed < allowed -- speed should not fall under allowed threshold
                          then return False
                          else waitfor' prev'
          where derive xs = zipWith (-) xs (tail xs) -- xs is a reversed list

testOutputState :: IORef NXTInternals -> Test
testOutputState ref = TestLabel "testOutputState" $ TestCase $ do
  testNXT ref $ do
    setOutputStateConfirm A 75 [MotorOn, Brake, Regulated] RegulationModeMotorSpeed 0 MotorRunStateRunning 1000
    successful <- waitfor $ do
      OutputState _ _ _ _ _ state _ _ tachoCount _ <- getOutputState A
      return (state == MotorRunStateIdle, fromIntegral tachoCount)
    setOutputStateConfirm A 0 [MotorOn, Brake] RegulationModeIdle 0 MotorRunStateRunning 0
    liftIO $ assertBool "not successful waitfor" successful
    OutputState outputPort outputPower outputMode regulationMode turnRatio runState tachoLimit tachoCount _ _ <- getOutputState A
    liftIO $ do
      assertEqual "outputPort" A outputPort
      assertEqual "outputPower" 0 outputPower
      assertEqual "outputMode" [MotorOn, Brake] outputMode
      assertEqual "regulationMode" RegulationModeIdle regulationMode
      assertEqual "turnRatio" 0 turnRatio
      assertEqual "runState" MotorRunStateRunning runState
      assertEqual "tachoLimit" 0 tachoLimit
      assertBool ("tachoCount !~ 1000: " ++ show tachoCount) (tachoCount > 700 && tachoCount < 1300)

testInputMode :: IORef NXTInternals -> Test
testInputMode ref = TestLabel "testInputMode" $ TestCase $ do
  InputValue inputPort valid _ sensorType sensorMode _ normalizedADValue scaledValue _ <- testNXT ref $ do
    setInputModeConfirm One Switch BooleanMode
    getInputValues One
  assertEqual "inputPort" One inputPort
  assertBool "not valid" valid
  assertEqual "sensorType" Switch sensorType
  assertEqual "sensorMode" BooleanMode sensorMode
  assertBool ("normalizedADValue not in range [0, 1023]: " ++ show normalizedADValue) (normalizedADValue >= 0 && normalizedADValue <= 1023)
  assertEqual "scaledValue" 0 scaledValue

testUltrasonicSensor :: IORef NXTInternals -> Test
testUltrasonicSensor ref = TestLabel "testUltrasonicSensor" $ TestCase $ do
  measurement <- testNXT ref $ do
    usInit Two
    version <- usGetVersion Two
    liftIO $ assertEqual "version" "V1.0" version
    vendor <- usGetVendorID Two
    liftIO $ assertEqual "vendor" "LEGO" vendor
    device <- usGetDeviceID Two
    liftIO $ assertEqual "device" "Sonar" device
    units <- usGetMeasurementUnits Two
    liftIO $ assertEqual "units" "10E-2m" units
    usSetMode Two ContinuousMeasurement
    mode <- usGetMode Two
    liftIO $ assertEqual "mode" ContinuousMeasurement mode
    usSetMode Two SingleShot
    measurement <- usGetMeasurement Two 0
    usSetMode Two Off
    mode' <- usGetMode Two
    liftIO $ assertEqual "mode" Off mode'
    return measurement
  putStrLn $ "Ultrasonic sensor measurement: " ++ (show measurement)