emhell (empty) → 0.1
raw patch · 14 files changed
+1085/−0 lines, 14 filesdep +attoparsecdep +basedep +data-default-class
Dependencies added: attoparsec, base, data-default-class, data-svd, directory, emhell, haskeline, hgdbmi, hocd, optparse-applicative, repline, text, transformers, unix
Files
- CHANGELOG.md +10/−0
- LICENSE +30/−0
- README.md +99/−0
- emhell.cabal +98/−0
- emhell/Main.hs +112/−0
- hgdb/Main.hs +233/−0
- hgdb/Options.hs +71/−0
- hocd/Main.hs +160/−0
- src/EmHell.hs +1/−0
- src/EmHell/Options.hs +12/−0
- src/EmHell/Parsers.hs +32/−0
- src/EmHell/SVD/Completion.hs +165/−0
- src/EmHell/SVD/Selector.hs +33/−0
- src/EmHell/SigintHandler.hs +29/−0
+ CHANGELOG.md view
@@ -0,0 +1,10 @@+# Version [0.1.0.0](https://github.com/DistRap/emhell/compare/d236297...0.1.0.0) (2023-12-27)++* Initial release++---++`emhell` uses [PVP Versioning][1].++[1]: https://pvp.haskell.org+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright sorki (c) 2020++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 Author name here 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.
+ README.md view
@@ -0,0 +1,99 @@+[](https://github.com/DistRap/emhell/actions/workflows/ci.yaml)+[](https://hackage.haskell.org/package/emhell)+[](https://packdeps.haskellers.com/feed?needle=emhell)++# emhell++Embedded development could be hell without a good tooling!++## Applications++### `emhell`++`emhell` is a SVD (System View Description) register browser++### `hocd`++`hocd` is a register viewer utilizing OpenOCD as a backend+using [`hocd`](https://github.com/DistRap/hocd)++### `hgdb`++`hgdb` is a register viewer and a `GDB` frontend,+built on top [`hgdbmi`](https://github.com/DistRap/hgdbmi)++#### Inspecting registers++To use `arm-none-eabi-gdb` with [BlackMagicProbe](https://github.com/blacksphere/blackmagic)+available via `/dev/bmp` launch `hgdb` in following manner++```+hgdb --arm --bmp /dev/bmp --svd stm32f407.svd+```++You can then inspect registers via REPL using their names+(tab completion available) delimited by comma, e.g.++```+λ> scb.scr+Register SCR+- System Control Register+- Address 0xE000ED10 (including offset 0x10)++0000000004+0x00000004+0b00000000000000000000000000000100+0b0000 0000 0000 0000 0000 0000 0000 0000 0100+Bit 2 SLEEPDEEP++++-------+---------+-+---------+-----------+-++|◦[26:0]|SEVONPEND|◦|SLEEPDEEP|SLEEPONEXIT|◦|++-------+---------+-+---------+-----------+-++| 0 | 0 |0| 1 | 0 |0|++-------+---------+-+---------+-----------+-++```++#### Command line options++* `-e | --ex` behaves like `gdb --ex`+* `--svd` specifies SVD file to load on start+* `--file` can be used to load image to Gdb on start+* `-a | --arm` to use `arm-none-eabi-gdb`+* `--bmp DEV` for use with BlackMagicProbe over UART+* `--bmphosted HOST:PORT` for use with PC hosted BlackMagicProbe (`blackmagic_stlinkv2` binary)+* `--remotegdb HOST:PORT` for use with remotely running GDB server over TCP (could be OpenOCD provided one)++For full list refer to `hgdb --help`++#### Internal commands++* `:svd` - load SVD file, can be used instead of `--svd` arguments or to change current SVD file+* `:file` - load file to Gdb++All other REPL commands are forwarded to GDB as CLI input.++## Build++### Using Cabal++```bash+git clone https://github.com/DistRap/emhell+cabal build+```++### Using Nix++```bash+nix-build+```++## Notes++The interface is not final and will probably change. With more recent Gdb than+currently available on distributions we could also do completion for function names+and variables (requires `-symbol-list-functions` and `-symbol-list-variables`).++## Demo++[](https://asciinema.org/a/300226)
+ emhell.cabal view
@@ -0,0 +1,98 @@+cabal-version: 2.2+name: emhell+Synopsis: Embedded shell+Description: Tooling for register exploration using SVD files and GDB-MI or OpenOCD backends+category: Embedded+version: 0.1+license: BSD-3-Clause+license-file: LICENSE+author: sorki <srk@48.io>+maintainer: sorki <srk@48.io>+stability: provisional+homepage: https://github.com/DistRap/emhell+bug-reports: https://github.com/DistRap/emhell/issues+copyright: (c) 2020 sorki <srk@48.io>+build-type: Simple+extra-source-files:+ LICENSE+ README.md++extra-doc-files:+ CHANGELOG.md++source-repository head+ type: git+ location: git://github.com/DistRap/emhell.git++flag hgdb+ default:+ False+ description:+ Build hgdb++library+ build-depends: base >= 4 && < 5+ , attoparsec+ , data-svd+ , haskeline+ , optparse-applicative+ , text+ , unix+ exposed-modules: EmHell+ , EmHell.Options+ , EmHell.Parsers+ , EmHell.SigintHandler+ , EmHell.SVD.Completion+ , EmHell.SVD.Selector++ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010++-- to ghci use cabal new-repl exe:emhell+executable emhell+ ghc-options: -Wall -Wunused-packages+ hs-source-dirs: emhell+ main-is: Main.hs+ build-depends: base >= 4 && < 5+ , emhell+ , repline >= 0.4.0.0 && < 0.5+ , data-svd >= 0.1.1+ , optparse-applicative+ , transformers+ default-language: Haskell2010++-- to ghci use cabal new-repl exe:hgdb+executable hgdb+ if !flag(hgdb)+ buildable: False+ ghc-options: -Wall -Wunused-packages+ hs-source-dirs: hgdb+ main-is: Main.hs+ other-modules: Options++ build-depends: base >= 4 && < 5+ , emhell+ , hgdbmi >= 0.3+ , repline >= 0.4.0.0 && < 0.5+ , data-default-class+ , data-svd+ , directory+ , optparse-applicative+ , transformers+ default-language: Haskell2010++-- to ghci use cabal new-repl exe:hocd+executable hocd+ ghc-options: -Wall -Wunused-packages+ hs-source-dirs: hocd+ main-is: Main.hs+ build-depends: base >= 4 && < 5+ , emhell+ , hocd >= 0.1.1.1+ , repline >= 0.4.0.0 && < 0.5+ , data-default-class+ , data-svd+ , optparse-applicative+ , transformers+ default-language: Haskell2010
+ emhell/Main.hs view
@@ -0,0 +1,112 @@+{-# 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")
+ hgdb/Main.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE LambdaCase #-}++module Main where++import Control.Exception (SomeException)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.State.Strict (StateT, runStateT, get, put)+import Data.Default.Class (Default(def))+import Data.SVD.Types (Device)+import Data.Word (Word32)+import EmHell.SVD.Selector (Selector(..))+import Gdb (Config(..), GDBT)+import System.Console.Repline+ ( CompletionFunc+ , HaskelineT+ , MultiLine(..)+ , CompleterStyle(Prefix)+ , ExitDecision(Exit)+ )++import qualified Control.Concurrent+import qualified Control.Exception+import qualified Control.Monad+import qualified Data.SVD.IO+import qualified Data.SVD.Pretty.Explore+import qualified Data.SVD.Util+import qualified EmHell.SigintHandler+import qualified EmHell.SVD.Completion+import qualified EmHell.SVD.Selector+import qualified Gdb+import qualified System.Console.Repline+import qualified System.Directory++import Options++type Repl a =+ HaskelineT+ (StateT (Maybe Device)+ (GDBT IO)+ ) a++main :: IO ()+main = do+ opts <- runOpts++ let gdbConfig =+ if optsArm opts+ then Gdb.armConfig+ else def+ cfg =+ case gdbConfig of+ c@Config {} ->+ c { confLogfile = optsMILog opts }+ c@ConfigTCP {} ->+ c { confTCPLogfile = optsMILog opts }++ case optsCwd opts of+ Nothing -> pure ()+ Just pth ->+ System.Directory.setCurrentDirectory pth++ dev <- case optsSVD opts of+ Nothing -> pure Nothing+ Just fp -> do+ liftIO+ $ putStrLn+ $ "Loading SVD file " <> fp++ x <- Data.SVD.IO.parseSVD fp+ case x of+ Left err ->+ putStrLn err >> pure Nothing+ Right dev ->+ pure $ pure dev++ _ <- Gdb.runGDBConfig cfg $ do+ maybe (pure ()) Gdb.file (optsFile opts)+ maybe (pure ()) Gdb.extRemote (optsProg opts)+ -- execute extra --ex cli commands+ Control.Monad.forM_ (optsEx opts) Gdb.cli++ Gdb.break++ -- to avoid printing prompt during gdb log output+ liftIO+ $ Control.Concurrent.threadDelay 1000000+ Control.Monad.void+ $ (`runStateT` dev)+ $ runRepl++ pure ()++runRepl :: StateT (Maybe Device) (GDBT IO) ()+runRepl = do+ System.Console.Repline.evalRepl+ banner'+ (replCmd)+ options+ (Just ':')+ (Just "paste")+ (Prefix+ (\x ->+ ( EmHell.SVD.Completion.compFunc+ svdCompleterMay+ )+ x+ )+ defaultMatcher+ )+ greeter+ finalizer+ where+ banner' =+ pure+ . \case+ SingleLine -> "hgdb> "+ MultiLine -> "| "++ greeter =+ liftIO+ $ putStrLn "Welcome to hgdb"++ finalizer = pure Exit++ svdCompleterMay+ :: Monad m+ => String+ -> StateT (Maybe Device) m [String]+ svdCompleterMay x = do+ s <- get+ case s of+ Nothing -> pure mempty+ Just dev ->+ EmHell.SVD.Completion.svdCompleter dev x++replCmd :: String -> Repl ()+replCmd input = lift $ do+ svdMay <- get+ case svdMay of+ Nothing -> lift $ Gdb.cli input+ Just dev -> do+ case EmHell.SVD.Selector.parseSelector input of+ Left _e -> do+ lift $ Gdb.cli input+ Right sel -> do+ case Data.SVD.Util.getPeriphRegAddr (selPeriph sel) (selReg sel) dev of+ Left e -> lift $ Gdb.echo e+ Right regAddr -> do+ res <- lift $ Gdb.readMem regAddr 4+ case res of+ Nothing -> error "Failed to read memory via GDB"+ Just x -> do+ case+ Data.SVD.Util.getPeriphReg+ (selPeriph sel)+ (selReg sel)+ dev+ of+ Left _e -> error "Absurd"+ Right reg ->+ liftIO+ $ Data.SVD.Pretty.Explore.exploreRegister+ (x :: Word32)+ regAddr+ reg++wait :: String -> Repl ()+wait _args = liftGdb $ Gdb.waitStop >>= Gdb.showStops++-- Repl command, that loads SVD+-- and puts @Device@ into repl state+loadSVD :: String -> Repl ()+loadSVD fp = do+ liftIO+ $ putStrLn+ $ "Loading SVD file " <> fp++ x <-+ liftIO+ $ Data.SVD.IO.parseSVD fp++ case x of+ Left err -> liftIO $ putStrLn err+ Right d -> lift $ put $ Just d++-- does make sense only when GDB is running, add continue >> act??+interruptible+ :: Show b+ => GDBT IO b+ -> a+ -> Repl ()+interruptible act _args = do+ ctx <- liftGdb Gdb.getContext+ x <-+ liftIO+ $ Control.Exception.try+ $ EmHell.SigintHandler.sigintHandler+ $ Gdb.runGDBT ctx act+ _ <- case x of+ Left e -> do+ -- if user hits Ctr-C we propagate it to GDB and wait for stops response+ liftGdb Gdb.break+ -- this used to be, but why+ -- wait []+ pure $ Left $ show (e :: SomeException)+ Right r -> pure $ Right r++ pure ()++defaultMatcher :: [(String, CompletionFunc (StateT (Maybe Device) (GDBT IO)))]+defaultMatcher =+ [ (":svd", System.Console.Repline.fileCompleter)+ , (":file", System.Console.Repline.fileCompleter)+ ]++liftGdb+ :: ( MonadTrans t1+ , MonadTrans t2+ , Monad m+ , Monad (t2 m)+ )+ => m a+ -> t1 (t2 m) a+liftGdb fn = lift . lift $ fn++options :: [(String, String -> Repl ())]+options = [+ ("svd", loadSVD)+ , ("file", liftGdb . Gdb.file)+ , ("wait", wait)+ , ("c", interruptible $ Gdb.continue >> Gdb.waitStop)+ ]
+ hgdb/Options.hs view
@@ -0,0 +1,71 @@+module Options where++import Gdb (Programmer(..))+import Options.Applicative+import qualified EmHell.Options+import qualified EmHell.Parsers++data Options = Options {+ optsProg :: Maybe Programmer+ , optsFile :: Maybe FilePath+ , optsMILog :: Maybe FilePath+ , optsSVD :: Maybe FilePath+ , optsCwd :: Maybe FilePath+ , optsArm :: Bool+ , optsEx :: [String]+ } deriving Show++parseProgrammer :: Parser Programmer+parseProgrammer =+ (BMP <$> strOption+ ( long "bmp"+ <> metavar "DEV"+ <> help "Use BlackMagic Probe at DEV"+ )+ )+ <|>+ (uncurry BMPHosted <$> option (EmHell.Parsers.hostPort)+ ( long "bmphosted"+ <> metavar "HOST:PORT"+ <> help "Use hosted BlackMagic Probe at HOST:PORT"+ )+ )+ <|>+ (uncurry RemoteGDB <$> option (EmHell.Parsers.hostPort)+ ( long "remotegdb"+ <> metavar "HOST:PORT"+ <> help "Use remote GDB server at HOST:PORT"+ )+ )++parseOptions :: Parser Options+parseOptions = Options <$>+ optional parseProgrammer+ <*> optional (strOption $+ long "file"+ <> metavar "FILE"+ <> help "Load FILE to Gdb")+ <*> optional (strOption $+ long "milog"+ <> metavar "FILE"+ <> help "Log Gdb/MI session to FILE")+ <*> optional EmHell.Options.parseSVD+ <*> optional (strOption $+ long "cwd"+ <> metavar "DIR"+ <> help "Change directory prior any operations")+ <*> switch (+ long "arm"+ <> short 'a'+ <> help "Use arm-none-eabi-gdb")+ <*> many (strOption $+ long "ex"+ <> short 'e'+ <> help "Execute")++runOpts :: IO Options+runOpts =+ execParser+ $ info+ (parseOptions <**> helper)+ (fullDesc <> progDesc "hgdb")
+ hocd/Main.hs view
@@ -0,0 +1,160 @@+{-# 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.Default.Class (Default(def))+import Data.SVD.Types (Device)+import EmHell.SVD.Selector (Selector(..))+import HOCD (OCDT, OCDConfig(..))+import System.Console.Repline+ ( HaskelineT+ , MultiLine(..)+ , CompleterStyle(Prefix)+ , ExitDecision(Exit)+ )++import qualified Control.Monad+import qualified Data.Maybe+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 HOCD+import qualified System.Console.Repline++import Options.Applicative++type Repl a =+ HaskelineT+ (ReaderT Device+ (OCDT IO)+ ) a++main :: IO ()+main = do+ opts <- runOpts++ liftIO+ $ putStrLn+ $ "Loading SVD file " <> optsSVD opts++ x <- Data.SVD.IO.parseSVD+ (optsSVD opts)+ dev <- case x of+ Left err -> error err+ Right dev -> pure dev++ let ocdConfig =+ def+ { ocdHost =+ Data.Maybe.fromMaybe+ (ocdHost def)+ (optsHost opts)+ , ocdPort =+ Data.Maybe.fromMaybe+ (ocdPort def)+ (optsPort opts)+ }++ _ <- HOCD.runOCDConfig ocdConfig $ do+ Control.Monad.void+ $ (`runReaderT` dev)+ $ runRepl+ pure ()++runRepl :: ReaderT Device (OCDT 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) -> do+ regVal <- lift+ . HOCD.readMem32+ . HOCD.memAddr+ $ fromIntegral regAddr+ liftIO+ $ Data.SVD.Pretty.Explore.exploreRegister+ regVal+ regAddr+ reg+ _ -> error "Absurd"++data Options = Options+ { optsSVD :: FilePath+ , optsHost :: Maybe String+ , optsPort :: Maybe Int+ } deriving Show++parseOptions :: Parser Options+parseOptions = Options <$>+ EmHell.Options.parseSVD+ <*> optional (strOption $+ long "host"+ <> metavar "HOST"+ <> help "Host where OpenOCD is listening")+ <*> optional+ (+ read+ <$> strOption+ ( long "port"+ <> help "OpenOCD RPC port"+ <> showDefault+ <> value "6666"+ )+ )++runOpts :: IO Options+runOpts =+ execParser+ $ info+ (parseOptions <**> helper)+ (fullDesc <> progDesc "emhell")
+ src/EmHell.hs view
@@ -0,0 +1,1 @@+module EmHell where
+ src/EmHell/Options.hs view
@@ -0,0 +1,12 @@+module EmHell.Options+ ( parseSVD+ ) where++import Options.Applicative++parseSVD :: Parser FilePath+parseSVD =+ strOption+ $ long "svd"+ <> metavar "XML"+ <> help "Load software vendor description XML file"
+ src/EmHell/Parsers.hs view
@@ -0,0 +1,32 @@+module EmHell.Parsers+ ( hostPort+ ) where++import Data.Attoparsec.Text (Parser)+import Options.Applicative (ReadM)+import qualified Data.Attoparsec.Text+import qualified Data.Text+import qualified Options.Applicative++attoReadM :: Parser a -> ReadM a+attoReadM p =+ Options.Applicative.eitherReader+ $ Data.Attoparsec.Text.parseOnly p+ . Data.Text.pack++parseAddress :: Parser String+parseAddress =+ Data.Text.unpack+ <$> Data.Attoparsec.Text.takeWhile (/=':')++parsePort :: Parser Int+parsePort = do+ _ <- Data.Attoparsec.Text.char ':'+ d <- Data.Attoparsec.Text.decimal+ return d++hostPortP :: Parser (String, Int)+hostPortP = (,) <$> parseAddress <*> parsePort++hostPort :: ReadM (String, Int)+hostPort = attoReadM hostPortP
+ src/EmHell/SVD/Completion.hs view
@@ -0,0 +1,165 @@+module EmHell.SVD.Completion+ ( svdCompleter+ , svdCompleterFields+ , compFunc+ ) where++import Control.Applicative (optional)+import Data.Attoparsec.Text (Parser)+import Data.SVD+ ( Device(..)+ , Field(..)+ , Peripheral(..)+ , Register(..)+ )+import Data.Text (Text)+import System.Console.Haskeline.Completion+ ( Completion(..)+ , CompletionFunc+ )++import qualified Data.Attoparsec.Text+import qualified Data.Char+import qualified Data.Either+import qualified Data.List+import qualified Data.Maybe+import qualified Data.SVD+import qualified Data.Text+import qualified System.Console.Haskeline.Completion++parsePart :: Parser Text+parsePart =+ Data.Attoparsec.Text.takeWhile1 (/='.')+ <* (optional $ Data.Attoparsec.Text.char '.')++compFunc+ :: Monad m+ => (String -> m [String])+ -> CompletionFunc m+compFunc f =+ System.Console.Haskeline.Completion.completeWord+ (Just '\\')+ " \t()[]"+ $ \x ->+ map+ ( notFinished+ . System.Console.Haskeline.Completion.simpleCompletion+ )+ <$> f x+ where+ notFinished :: Completion -> Completion+ notFinished x = x { isFinished = False }++svdCompleter'+ :: Monad m+ => Bool -- ^ Complete fields+ -> Device+ -> String+ -> m [String]+svdCompleter' completeFields dev x =+ nestedCompleter+ (map+ (periphName)+ $ devicePeripherals dev+ ) x+ $ \(complete, leftover) -> do+ let f = Data.Either.fromRight mempty+ $ Data.SVD.getPeriphRegs complete dev+ nestedCompleter+ (map regName f)+ leftover+ $ if not completeFields+ then \_ -> pure mempty+ else+ \(complete2, leftover2) -> do+ let f' = Data.Either.fromRight mempty+ $ Data.SVD.getPeriphRegFields+ complete+ complete2+ dev+ nestedCompleter+ (map fieldName f')+ leftover2+ $ \_ -> pure mempty++svdCompleter+ :: Monad m+ => Device+ -> String+ -> m [String]+svdCompleter = svdCompleter' False++svdCompleterFields+ :: Monad m+ => Device+ -> String+ -> m [String]+svdCompleterFields = svdCompleter' True++nestedCompleter+ :: Monad m+ => [String]+ -> String+ -> ((String, String) -> m [String])+ -> m [String]+nestedCompleter names input nest =+ nestedCompleter'+ (\x ->+ (Data.List.isPrefixOf x)+ . map Data.Char.toLower)+ (map+ (map Data.Char.toLower) names)+ input+ nest++nestedCompleter'+ :: Monad m+ => (String -> String -> Bool)+ -> [String]+ -> String+ -> ((String, String) -> m [String])+ -> m [String]+nestedCompleter' matchFn names input nest = do+ let xinput =+ if input == "."+ then ""+ else if "." `Data.List.isPrefixOf` input+ then drop 1 input+ else input++ -- To debug+ -- import Debug.Trace+ -- let z = trace (show ("zz", xinput)) (pure ())+ -- z++ case+ Data.Text.unpack+ <$> Data.Attoparsec.Text.parseOnly+ parsePart+ (Data.Text.pack xinput)+ of+ Left _e -> pure names++ Right x | complete x -> do+ res <-+ nest+ ( x+ , Data.Maybe.fromJust+ $ x `Data.List.stripPrefix` xinput)+ pure $ map (prefix x) res++ Right x | otherwise ->+ pure $ filter (matchFn x) names++ where+ complete x =+ not+ . null+ $ filter (==x) names++ prefix with x =+ concat+ [ with+ , "."+ , x+ ]
+ src/EmHell/SVD/Selector.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveFunctor #-}+module EmHell.SVD.Selector where++import Control.Applicative+import Data.Attoparsec.Text+import qualified Data.Text+import qualified Data.Char++data Selector a = Selector {+ selPeriph :: a+ , selReg :: a+ , selField :: Maybe a+ }+ deriving (Eq, Ord, Show, Functor)++-- | Parse Periph.Reg.Field selector+selectorParser :: Parser (Selector String)+selectorParser = do+ p <- takeWhile1 (/='.')+ _ <- char '.'+ r <- takeWhile1 (/='.')+ f <- optional (char '.' *> takeWhile1 (pure True) <* endOfInput)+ pure+ $ map Data.Char.toLower+ . Data.Text.unpack+ <$> Selector p r f++parseSelector+ :: String+ -> Either String (Selector String)+parseSelector =+ parseOnly selectorParser+ . Data.Text.pack
+ src/EmHell/SigintHandler.hs view
@@ -0,0 +1,29 @@+module EmHell.SigintHandler + ( sigintHandler+ ) where++import System.Posix.Signals (Handler(Catch))+import qualified Control.Concurrent+import qualified Control.Exception+import qualified System.Posix.Signals++sigintHandler :: IO b -> IO b+sigintHandler ofWhat = do+ tid <- Control.Concurrent.myThreadId+ Control.Exception.bracket+ (System.Posix.Signals.installHandler+ System.Posix.Signals.sigINT+ (Catch+ $ Control.Exception.throwTo+ tid+ Control.Exception.UserInterrupt+ )+ Nothing+ )+ (\old ->+ System.Posix.Signals.installHandler+ System.Posix.Signals.sigINT+ old+ Nothing+ )+ $ pure ofWhat