emhell-0.1: emhell/Main.hs

{-# LANGUAGE LambdaCase #-}

module Main where

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
import Data.SVD.Types (Device)
import Data.Word (Word32)
import EmHell.SVD.Selector (Selector(..))
import System.Console.Repline
  ( HaskelineT
  , MultiLine(..)
  , CompleterStyle(Prefix)
  , ExitDecision(Exit)
  )

import qualified Control.Monad
import qualified Data.SVD.IO
import qualified Data.SVD.Pretty.Explore
import qualified Data.SVD.Util
import qualified EmHell.Options
import qualified EmHell.SVD.Completion
import qualified EmHell.SVD.Selector
import qualified System.Console.Repline

import Options.Applicative

type Repl a =
  HaskelineT
    (ReaderT Device IO) a

main :: IO ()
main = do
  fp <- runOpts

  liftIO
    $ putStrLn
    $ "Loading SVD file " <> fp

  x <- Data.SVD.IO.parseSVD fp
  dev <- case x of
    Left err -> error err
    Right dev -> pure dev

  Control.Monad.void
    $ (`runReaderT` dev)
    $ runRepl

runRepl :: ReaderT Device IO ()
runRepl = do
  System.Console.Repline.evalRepl
    banner'
    (replCmd)
    mempty
    (Just ':')
    (Just "paste")
    (Prefix
      (\x ->
        ( EmHell.SVD.Completion.compFunc
          (\i -> ask >>= \dev -> EmHell.SVD.Completion.svdCompleter dev i)
        )
        x
      )
      mempty
    )
    greeter
    finalizer
  where
    banner' =
        pure
      . \case
          SingleLine -> "emhell> "
          MultiLine -> "| "

    greeter =
      liftIO
      $ putStrLn "Welcome to emhell"

    finalizer = pure Exit

replCmd :: String -> Repl ()
replCmd input = lift $ do
  dev <- ask
  case EmHell.SVD.Selector.parseSelector input of
    Left _e -> pure ()
    Right sel ->
      case
        ( Data.SVD.Util.getPeriphRegAddr
            (selPeriph sel)
            (selReg sel)
            dev
        , Data.SVD.Util.getPeriphReg
            (selPeriph sel)
            (selReg sel)
            dev
        )
        of
          (Right regAddr, Right reg) ->
            liftIO
              $ Data.SVD.Pretty.Explore.exploreRegister
                  (0 :: Word32)
                  regAddr
                  reg
          _ -> error "Absurd"

runOpts :: IO FilePath
runOpts =
  execParser
  $ info
      (EmHell.Options.parseSVD <**> helper)
      (fullDesc <> progDesc "emhell")