obd-0.1.0.0: app/Terminal.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where

import Control.Exception (bracket)
import Control.Monad (join)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, ask)
import Control.Monad.Trans.Class (lift)
import Data.List (isSuffixOf)
import qualified Data.ByteString.Char8 as Char8

import Options.Applicative (Parser, execParser,
                            flag, strOption,
                            help, long, value,
                            info, progDesc,
                            (<>))
import Options.Applicative.Extra (helper)

import System.Console.Haskeline (InputT, MonadException, RunIO(..),
                                 controlIO, runInputT,
                                 defaultSettings, getInputLine)

import System.Hardware.ELM327.Connection (Con, recv, sendString)
import System.Hardware.ELM327.Simulator (defaultSimulator)
import System.Hardware.ELM327.Simulator.OBDBus.VWPolo2007 (stoppedCarBus)
import qualified System.Hardware.ELM327.Connection as Connection
import qualified System.Hardware.ELM327 as ELM327
import qualified System.Hardware.ELM327.Simulator as Simulator


newtype Term a = Term { runTerm :: ReaderT Con IO a }
                      deriving (Functor, Applicative, Monad, MonadIO, MonadReader Con)

instance MonadException Term where
    controlIO f = join . liftIO $ f (RunIO return)

data ConnectionType = ConnectionTypeActualDevice FilePath
                    | ConnectionTypeSimulator

connectionType :: Parser ConnectionType
connectionType = flag ConnectionTypeActualDevice (const ConnectionTypeSimulator) m <*> serialPort
    where m = long "simulator" <> help "Connect to the simulator instead of a serial port"

serialPort :: Parser FilePath
serialPort = strOption m
    where m = long "port" <> value "/dev/ttyUSB0" <> help "The serial port to connect to"

main :: IO ()
main = execParser i >>= runTerminal
    where i = info p $ progDesc "Connect a terminal to an ELM327 device or simulator."
          p = helper <*> connectionType

connect :: ConnectionType -> IO Con
connect ConnectionTypeSimulator          = Simulator.connect $ defaultSimulator stoppedCarBus
connect (ConnectionTypeActualDevice dev) = ELM327.connect dev

runTerminal :: ConnectionType -> IO ()
runTerminal ct = bracket (connect ct)
                         (\c -> putStrLn "Closing connection..." >> Connection.close c)
                         (liftIO . runTerminalWithConnection)

runTerminalWithConnection :: Con -> IO ()
runTerminalWithConnection = runReaderT (runTerm readEvalPrint)

readEvalPrint :: Term ()
readEvalPrint = runInputT defaultSettings loop
  where
    loop :: InputT Term ()
    loop = do
        maybeLine <- getInputLine "% "
        case maybeLine of Nothing -> return ()
                          Just ":exit" -> return ()
                          Just x -> handleLine x >> loop

handleLine :: String -> InputT Term ()
handleLine cmd = do
    con <- lift ask
    liftIO $ sendString con $ cmd ++ "\r"
    printAll

printAll :: InputT Term ()
printAll = do
    maybeBS <- lift ask >>= liftIO . recv
    case maybeBS of Nothing -> return ()
                    Just b -> liftIO . putStrLn $ convertResponse b
  where
    convertResponse = stripPrompt . filter (/= '\0') . Char8.unpack
    stripPrompt :: String -> String
    stripPrompt x = if "\n>" `isSuffixOf` x then take (length x - 1) x else x