emhell 0.1 → 0.1.1.0
raw patch · 10 files changed
+582/−102 lines, 10 filesdep +bytestringdep +lensdep +prettyprinterdep ~hocd
Dependencies added: bytestring, lens, prettyprinter, prettyprinter-ansi-terminal
Dependency ranges changed: hocd
Files
- CHANGELOG.md +17/−0
- README.md +23/−3
- emhell.cabal +17/−2
- emhell/Main.hs +87/−21
- hgdb/Main.hs +152/−47
- hocd/Main.hs +133/−22
- src/EmHell/SVD/Completion.hs +4/−2
- src/EmHell/SVD/Manipulation.hs +83/−0
- src/EmHell/SVD/Query.hs +30/−0
- src/EmHell/SVD/Selector.hs +36/−5
CHANGELOG.md view
@@ -1,3 +1,20 @@+# Version [0.1.1.0](https://github.com/DistRap/emhell/compare/0.1.0.0...0.1.1.0) (2024-01-03)++## Additions+### All shells++* `:set` command for setting register field (all shells)++### hocd++Control commands:+* `:halt`+* `:reset`+* `:resume`+* `:step`++`:version` command to query OpenOCD version.+ # Version [0.1.0.0](https://github.com/DistRap/emhell/compare/d236297...0.1.0.0) (2023-12-27) * Initial release
README.md view
@@ -12,11 +12,30 @@ `emhell` is a SVD (System View Description) register browser +#### Commands++* `:set` - Set register field (for example `:set uart4.brr.div_mantissa = 0x123`).++ Since `emhell` has no backend, it simply renders the altered register.+ ### `hocd` `hocd` is a register viewer utilizing OpenOCD as a backend using [`hocd`](https://github.com/DistRap/hocd) +#### Commands++* `:set` - Set register field (for example `:set gpioa.odr.odr5 = 1`).++ Alters current register value with hexadecimal field value+ and writes new register value to memory.++* `:halt` - Halts target+* `:reset` - Resets target+* `:resume` - Resumes execution+* `:step` - Single-steps target+* `:version` - Print OpenOCD version+ ### `hgdb` `hgdb` is a register viewer and a `GDB` frontend,@@ -66,10 +85,11 @@ For full list refer to `hgdb --help` -#### Internal commands+#### Commands -* `:svd` - load SVD file, can be used instead of `--svd` arguments or to change current SVD file-* `:file` - load file to Gdb+* `:set` - Set register value (for example `:set gpioa.odr.odr5 = 1`).+* `: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.
emhell.cabal view
@@ -3,7 +3,7 @@ Synopsis: Embedded shell Description: Tooling for register exploration using SVD files and GDB-MI or OpenOCD backends category: Embedded-version: 0.1+version: 0.1.1.0 license: BSD-3-Clause license-file: LICENSE author: sorki <srk@48.io>@@ -35,7 +35,10 @@ , attoparsec , data-svd , haskeline+ , lens , optparse-applicative+ , prettyprinter+ , prettyprinter-ansi-terminal , text , unix exposed-modules: EmHell@@ -43,6 +46,8 @@ , EmHell.Parsers , EmHell.SigintHandler , EmHell.SVD.Completion+ , EmHell.SVD.Query+ , EmHell.SVD.Manipulation , EmHell.SVD.Selector hs-source-dirs: src@@ -59,6 +64,9 @@ , repline >= 0.4.0.0 && < 0.5 , data-svd >= 0.1.1 , optparse-applicative+ , prettyprinter+ , prettyprinter-ansi-terminal+ , text , transformers default-language: Haskell2010 @@ -79,6 +87,9 @@ , data-svd , directory , optparse-applicative+ , prettyprinter+ , prettyprinter-ansi-terminal+ , text , transformers default-language: Haskell2010 @@ -89,10 +100,14 @@ main-is: Main.hs build-depends: base >= 4 && < 5 , emhell- , hocd >= 0.1.1.1+ , bytestring+ , hocd >= 0.1.2.0 , repline >= 0.4.0.0 && < 0.5 , data-default-class , data-svd , optparse-applicative+ , prettyprinter+ , prettyprinter-ansi-terminal+ , text , transformers default-language: Haskell2010
emhell/Main.hs view
@@ -5,23 +5,29 @@ 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.SVD.Types (Device, Register(regResetValue)) import Data.Word (Word32) import EmHell.SVD.Selector (Selector(..)) import System.Console.Repline ( HaskelineT , MultiLine(..) , CompleterStyle(Prefix)+ , CompletionFunc , 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 Data.Text.IO import qualified EmHell.Options import qualified EmHell.SVD.Completion+import qualified EmHell.SVD.Query+import qualified EmHell.SVD.Manipulation import qualified EmHell.SVD.Selector+import qualified Prettyprinter+import qualified Prettyprinter.Render.Terminal import qualified System.Console.Repline import Options.Applicative@@ -52,18 +58,10 @@ System.Console.Repline.evalRepl banner' (replCmd)- mempty+ options (Just ':') (Just "paste")- (Prefix- (\x ->- ( EmHell.SVD.Completion.compFunc- (\i -> ask >>= \dev -> EmHell.SVD.Completion.svdCompleter dev i)- )- x- )- mempty- )+ completion greeter finalizer where@@ -73,6 +71,29 @@ SingleLine -> "emhell> " MultiLine -> "| " + options :: [(String, String -> Repl ())]+ options = [+ ("set", setReg)+ ]++ completion :: CompleterStyle (ReaderT Device IO)+ completion =+ Prefix+ ( EmHell.SVD.Completion.compFunc+ $ (ask >>=)+ . flip EmHell.SVD.Completion.svdCompleter+ )+ defaultMatcher++ defaultMatcher :: [(String, CompletionFunc (ReaderT Device IO))]+ defaultMatcher =+ [ ( ":set"+ , EmHell.SVD.Completion.compFunc+ $ (ask >>=)+ . flip EmHell.SVD.Completion.svdCompleterFields+ )+ ]+ greeter = liftIO $ putStrLn "Welcome to emhell"@@ -86,23 +107,68 @@ Left _e -> pure () Right sel -> case- ( Data.SVD.Util.getPeriphRegAddr- (selPeriph sel)- (selReg sel)- dev- , Data.SVD.Util.getPeriphReg+ EmHell.SVD.Query.getRegWithAddr (selPeriph sel) (selReg sel) dev- ) of- (Right regAddr, Right reg) ->+ Right (reg, regAddr) -> liftIO $ Data.SVD.Pretty.Explore.exploreRegister- (0 :: Word32)+ (resetValueOrZero reg) regAddr reg- _ -> error "Absurd"++ Left e -> liftIO $ putStrLn e++setReg :: String -> Repl ()+setReg input = lift $ do+ dev <- ask+ case EmHell.SVD.Selector.parseSelectorValue input of+ Left e ->+ liftIO+ $ putStrLn+ $ "No parse " <> e+ Right (sel, v) ->+ case+ EmHell.SVD.Query.getRegWithAddr+ (selPeriph sel)+ (selReg sel)+ dev+ of+ Right (reg, regAddr) -> do+ let eNewVal = case selField sel of+ Just f ->+ EmHell.SVD.Manipulation.setField+ reg+ (fromIntegral $ resetValueOrZero reg)+ f+ v+ Nothing ->+ pure v+ case eNewVal of+ Left e ->+ liftIO+ . Data.Text.IO.putStrLn+ . Prettyprinter.Render.Terminal.renderStrict+ $ Prettyprinter.layoutPretty+ Prettyprinter.defaultLayoutOptions+ e+ Right newVal ->+ liftIO+ $ Data.SVD.Pretty.Explore.exploreRegister+ (newVal :: Word32)+ regAddr+ reg++ Left e -> liftIO $ putStrLn e++resetValueOrZero+ :: Register+ -> Int+resetValueOrZero =+ Data.Maybe.fromMaybe 0+ . regResetValue runOpts :: IO FilePath runOpts =
hgdb/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} module Main where @@ -18,17 +19,24 @@ , CompleterStyle(Prefix) , ExitDecision(Exit) )+import Prettyprinter ((<+>), annotate, pretty)+import Prettyprinter.Render.Terminal (Color(..), bold, color) import qualified Control.Concurrent import qualified Control.Exception import qualified Control.Monad+import qualified Data.Bits.Pretty import qualified Data.SVD.IO import qualified Data.SVD.Pretty.Explore-import qualified Data.SVD.Util+import qualified Data.Text.IO import qualified EmHell.SigintHandler import qualified EmHell.SVD.Completion+import qualified EmHell.SVD.Query+import qualified EmHell.SVD.Manipulation import qualified EmHell.SVD.Selector import qualified Gdb+import qualified Prettyprinter+import qualified Prettyprinter.Render.Terminal import qualified System.Console.Repline import qualified System.Directory @@ -99,15 +107,7 @@ options (Just ':') (Just "paste")- (Prefix- (\x ->- ( EmHell.SVD.Completion.compFunc- svdCompleterMay- )- x- )- defaultMatcher- )+ completion greeter finalizer where@@ -117,11 +117,22 @@ SingleLine -> "hgdb> " MultiLine -> "| " - greeter =- liftIO- $ putStrLn "Welcome to hgdb"+ options :: [(String, String -> Repl ())]+ options = [+ ("set", setReg)+ , ("svd", loadSVD)+ , ("file", liftGdb . Gdb.file)+ , ("wait", wait)+ , ("c", interruptible $ Gdb.continue >> Gdb.waitStop)+ ] - finalizer = pure Exit+ completion :: CompleterStyle (StateT (Maybe Device) (GDBT IO))+ completion =+ Prefix+ (EmHell.SVD.Completion.compFunc+ svdCompleterMay+ )+ defaultMatcher svdCompleterMay :: Monad m@@ -134,6 +145,33 @@ Just dev -> EmHell.SVD.Completion.svdCompleter dev x + svdCompleterFieldsMay+ :: Monad m+ => String+ -> StateT (Maybe Device) m [String]+ svdCompleterFieldsMay x = do+ s <- get+ case s of+ Nothing -> pure mempty+ Just dev ->+ EmHell.SVD.Completion.svdCompleterFields dev x++ defaultMatcher :: [(String, CompletionFunc (StateT (Maybe Device) (GDBT IO)))]+ defaultMatcher =+ [ ( ":set"+ , EmHell.SVD.Completion.compFunc+ svdCompleterFieldsMay+ )+ , (":svd", System.Console.Repline.fileCompleter)+ , (":file", System.Console.Repline.fileCompleter)+ ]++ greeter =+ liftIO+ $ putStrLn "Welcome to hgdb"++ finalizer = pure Exit+ replCmd :: String -> Repl () replCmd input = lift $ do svdMay <- get@@ -144,26 +182,28 @@ 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+ case+ EmHell.SVD.Query.getRegWithAddr+ (selPeriph sel)+ (selReg sel)+ dev+ of+ Left e -> lift $ Gdb.echo e+ Right (reg, regAddr) -> do+ res <-+ lift+ . Gdb.readMem32+ . Gdb.memAddr+ $ fromIntegral regAddr+ case res of+ Nothing ->+ lift $ Gdb.echo "Failed to read memory via GDB"+ Just x -> do+ liftIO+ $ Data.SVD.Pretty.Explore.exploreRegister+ (x :: Word32)+ regAddr+ reg wait :: String -> Repl () wait _args = liftGdb $ Gdb.waitStop >>= Gdb.showStops@@ -208,12 +248,6 @@ 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@@ -224,10 +258,81 @@ -> 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)- ]+setReg :: String -> Repl ()+setReg input = lift $ do+ svdMay <- get+ case svdMay of+ Nothing -> liftIO $ putStrLn "No SVD loaded"+ Just dev -> do+ case EmHell.SVD.Selector.parseSelectorValue input of+ Left e ->+ liftIO+ $ putStrLn+ $ "No parse " <> e+ Right (sel, v) ->+ case+ EmHell.SVD.Query.getRegWithAddr+ (selPeriph sel)+ (selReg sel)+ dev+ of+ Right (reg, regAddr) -> do+ let regMemAddr =+ Gdb.memAddr+ $ fromIntegral regAddr++ mOrigRegVal <-+ lift $ Gdb.readMem32 regMemAddr++ case mOrigRegVal of+ Nothing -> liftIO $ putStrLn "Unable to read memory"+ Just origRegVal -> do+ let eNewVal = case selField sel of+ Just f ->+ EmHell.SVD.Manipulation.setField+ reg+ origRegVal+ f+ v+ Nothing ->+ pure v+ case eNewVal of+ Left e ->+ liftIO+ . Data.Text.IO.putStrLn+ . Prettyprinter.Render.Terminal.renderStrict+ $ Prettyprinter.layoutPretty+ Prettyprinter.defaultLayoutOptions+ e+ Right newVal -> do+ liftIO+ . Data.Text.IO.putStrLn+ . Prettyprinter.Render.Terminal.renderStrict+ $ Prettyprinter.layoutPretty+ Prettyprinter.defaultLayoutOptions+ (annotate+ (bold <> color Green)+ ( "Writing"+ <+> pretty (Data.Bits.Pretty.formatHex newVal)+ <+> "to"+ <+> pretty (selPeriph sel)+ <> "."+ <> pretty (selReg sel)+ )+ )+ lift+ $ Gdb.writeMem32+ regMemAddr+ [newVal]++ mNewRegVal <- lift $ Gdb.readMem32 regMemAddr+ case mNewRegVal of+ Nothing -> liftIO $ putStrLn "Unable to re-read memory"+ Just newRegVal ->+ liftIO+ $ Data.SVD.Pretty.Explore.exploreRegister+ newRegVal+ regAddr+ reg++ Left e -> liftIO $ putStrLn e
hocd/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} module Main where @@ -13,18 +14,27 @@ ( HaskelineT , MultiLine(..) , CompleterStyle(Prefix)+ , CompletionFunc , ExitDecision(Exit) )+import Prettyprinter ((<+>), annotate, pretty)+import Prettyprinter.Render.Terminal (Color(..), bold, color) import qualified Control.Monad+import qualified Data.Bits.Pretty+import qualified Data.ByteString.Char8 import qualified Data.Maybe import qualified Data.SVD.IO import qualified Data.SVD.Pretty.Explore-import qualified Data.SVD.Util+import qualified Data.Text.IO import qualified EmHell.Options import qualified EmHell.SVD.Completion+import qualified EmHell.SVD.Query+import qualified EmHell.SVD.Manipulation import qualified EmHell.SVD.Selector import qualified HOCD+import qualified Prettyprinter+import qualified Prettyprinter.Render.Terminal import qualified System.Console.Repline import Options.Applicative@@ -72,30 +82,50 @@ System.Console.Repline.evalRepl banner' (replCmd)- mempty+ options (Just ':') (Just "paste")- (Prefix- (\x ->- ( EmHell.SVD.Completion.compFunc- (\i -> ask >>= \dev -> EmHell.SVD.Completion.svdCompleter dev i)- )- x- )- mempty- )+ completion greeter finalizer where banner' = pure . \case- SingleLine -> "emhell> "+ SingleLine -> "hocd> " MultiLine -> "| " + options :: [(String, String -> Repl ())]+ options = [+ ("halt", halt)+ , ("reset", pure . lift $ HOCD.reset)+ , ("resume", pure . lift $ HOCD.resume)+ , ("set", setReg)+ , ("step", pure . lift $ HOCD.step)+ , ("version", version)+ ]++ completion :: CompleterStyle (ReaderT Device (OCDT IO))+ completion =+ Prefix+ ( EmHell.SVD.Completion.compFunc+ $ (ask >>=)+ . flip EmHell.SVD.Completion.svdCompleter+ )+ defaultMatcher++ defaultMatcher :: [(String, CompletionFunc (ReaderT Device (OCDT IO)))]+ defaultMatcher =+ [ ( ":set"+ , EmHell.SVD.Completion.compFunc+ $ (ask >>=)+ . flip EmHell.SVD.Completion.svdCompleterFields+ )+ ]+ greeter = liftIO- $ putStrLn "Welcome to emhell"+ $ putStrLn "Welcome to hocd" finalizer = pure Exit @@ -106,17 +136,12 @@ Left _e -> pure () Right sel -> case- ( Data.SVD.Util.getPeriphRegAddr- (selPeriph sel)- (selReg sel)- dev- , Data.SVD.Util.getPeriphReg+ EmHell.SVD.Query.getRegWithAddr (selPeriph sel) (selReg sel) dev- ) of- (Right regAddr, Right reg) -> do+ Right (reg, regAddr) -> do regVal <- lift . HOCD.readMem32 . HOCD.memAddr@@ -126,8 +151,94 @@ regVal regAddr reg- _ -> error "Absurd" + Left e -> liftIO $ putStrLn e++halt :: String -> Repl ()+halt _ = do+ out <- lift $ HOCD.halt+ case out of+ "" -> pure ()+ x ->+ liftIO+ $ Data.ByteString.Char8.putStr x++setReg :: String -> Repl ()+setReg input = lift $ do+ dev <- ask+ case EmHell.SVD.Selector.parseSelectorValue input of+ Left e ->+ liftIO+ $ putStrLn+ $ "No parse " <> e+ Right (sel, v) ->+ case+ EmHell.SVD.Query.getRegWithAddr+ (selPeriph sel)+ (selReg sel)+ dev+ of+ Right (reg, regAddr) -> do+ let regMemAddr =+ HOCD.memAddr+ $ fromIntegral regAddr++ origRegVal <-+ lift $ HOCD.readMem32 regMemAddr++ let eNewVal = case selField sel of+ Just f ->+ EmHell.SVD.Manipulation.setField+ reg+ origRegVal+ f+ v+ Nothing ->+ pure v+ case eNewVal of+ Left e ->+ liftIO+ . Data.Text.IO.putStrLn+ . Prettyprinter.Render.Terminal.renderStrict+ $ Prettyprinter.layoutPretty+ Prettyprinter.defaultLayoutOptions+ e+ Right newVal -> do+ liftIO+ . Data.Text.IO.putStrLn+ . Prettyprinter.Render.Terminal.renderStrict+ $ Prettyprinter.layoutPretty+ Prettyprinter.defaultLayoutOptions+ (annotate+ (bold <> color Green)+ ( "Writing"+ <+> pretty (Data.Bits.Pretty.formatHex newVal)+ <+> "to"+ <+> pretty (selPeriph sel)+ <> "."+ <> pretty (selReg sel)+ )+ )+ lift+ $ HOCD.writeMem32+ regMemAddr+ [newVal]++ newRegVal <- lift $ HOCD.readMem32 regMemAddr++ liftIO+ $ Data.SVD.Pretty.Explore.exploreRegister+ newRegVal+ regAddr+ reg++ Left e -> liftIO $ putStrLn e++version :: String -> Repl ()+version _ =+ lift $ HOCD.version+ >>= liftIO . Data.ByteString.Char8.putStrLn+ data Options = Options { optsSVD :: FilePath , optsHost :: Maybe String@@ -157,4 +268,4 @@ execParser $ info (parseOptions <**> helper)- (fullDesc <> progDesc "emhell")+ (fullDesc <> progDesc "hocd")
src/EmHell/SVD/Completion.hs view
@@ -129,8 +129,10 @@ -- To debug -- import Debug.Trace- -- let z = trace (show ("zz", xinput)) (pure ())- -- z+ -- traceShowM $+ -- [ ("Input:", xinput)+ -- , ("Names:", unwords names)+ -- ] case Data.Text.unpack
+ src/EmHell/SVD/Manipulation.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+module EmHell.SVD.Manipulation+ ( setField+ ) where++import Control.Lens ((^.), view)+import Data.Bits (Bits, (.|.), (.&.), complement, shiftL)+import Data.SVD+import Prettyprinter+import Prettyprinter.Render.Terminal (AnsiStyle, Color(..), bold, color)+import Text.Printf (PrintfArg)+import qualified Data.Bits.Pretty+import qualified Data.Char++-- | Set @Field@ of a @Register@ to new value+-- and return new value of a whole register+-- or Left if field is not found or value+-- is too large to fit+setField+ :: ( Integral a+ , Bits a+ , PrintfArg a+ , Pretty a+ )+ => Register+ -> a -- ^ Old register value+ -> String -- ^ Field name+ -> a -- ^ Field value+ -> Either (Doc AnsiStyle) a+setField r oldRegVal fName v =+ case filter ((==fName) . (map Data.Char.toLower) . view name) (r ^. fields) of+ [f] ->+ let maxVal = fromIntegral ((2 :: Int) ^ (f ^. bitWidth) - 1)+ in+ if | v > maxVal ->+ Left $ vsep+ [ annotate+ (color Red)+ ( "Value too large for field "+ <> annotate+ bold+ (pretty (f ^. name))+ <> " with bit width of "+ <> annotate+ bold+ (pretty (f ^. bitWidth))+ )+ , annotate+ (color Cyan)+ ( "HEX "+ <> pretty (Data.Bits.Pretty.formatHex v)+ <> " ∉ [0.."+ <> pretty (Data.Bits.Pretty.formatHex maxVal)+ <> "]"+ )+ , annotate+ (color Green)+ ( "DEC "+ <> pretty v+ <> " ∉ [0.."+ <> pretty maxVal+ <> "]"+ )+ ]+ | r ^. access `elem` [ReadOnly, ReadWriteOnce, WriteOnce] ->+ Left+ $ annotate+ (color Red)+ ( "Register is"+ <+> pretty (showAccessType (r ^. access))+ )+ | f ^. reserved ->+ Left+ $ annotate (color Red) "Field is reserved"+ | otherwise ->+ pure $+ let pos = f ^. bitOffset+ val = v `shiftL` pos+ fmax = 2 ^ (f ^. bitWidth) - 1+ mask = complement (fmax `shiftL` pos)+ in oldRegVal .&. mask .|. val+ _ -> Left "Field not found"
+ src/EmHell/SVD/Query.hs view
@@ -0,0 +1,30 @@+module EmHell.SVD.Query+ ( getRegWithAddr+ ) where++import Data.SVD (Device, Register)+import qualified Data.SVD.Util++-- | Get @Register@ and its address+-- based on peripheral name and device+getRegWithAddr+ :: String -- ^ Peripheral name+ -> String -- ^ Register name+ -> Device+ -> Either String (Register, Int)+getRegWithAddr pName rName dev =+ let+ reg =+ Data.SVD.Util.getPeriphReg+ pName+ rName+ dev+ regAddr =+ Data.SVD.Util.getPeriphRegAddr+ pName+ rName+ dev+ in+ case (reg, regAddr) of+ (Right r, Right ra) -> Right (r, ra)+ (_, _) -> Left "Register not found"
src/EmHell/SVD/Selector.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE DeriveFunctor #-}-module EmHell.SVD.Selector where+{-# LANGUAGE OverloadedStrings #-}+module EmHell.SVD.Selector+ ( Selector(..)+ , parseSelector+ , parseSelectorValue+ ) where +import Data.Bits (Bits) import Control.Applicative import Data.Attoparsec.Text import qualified Data.Text@@ -13,21 +19,46 @@ } deriving (Eq, Ord, Show, Functor) +nameParser :: Parser String+nameParser = many1 (letter <|> digit <> char '_')+ -- | Parse Periph.Reg.Field selector selectorParser :: Parser (Selector String) selectorParser = do- p <- takeWhile1 (/='.')+ p <- nameParser _ <- char '.'- r <- takeWhile1 (/='.')- f <- optional (char '.' *> takeWhile1 (pure True) <* endOfInput)+ r <- nameParser+ f <- optional (char '.' *> nameParser) pure $ map Data.Char.toLower- . Data.Text.unpack <$> Selector p r f +selectorValueParser+ :: ( Integral a+ , Bits a+ )+ => Parser (Selector String, a)+selectorValueParser = do+ s <- selectorParser+ skipSpace+ _ <- char '='+ skipSpace+ v <- optional "0x" *> hexadecimal+ pure (s, v)+ parseSelector :: String -> Either String (Selector String) parseSelector = parseOnly selectorParser+ . Data.Text.pack++parseSelectorValue+ :: ( Integral a+ , Bits a+ )+ => String+ -> Either String (Selector String, a)+parseSelectorValue =+ parseOnly selectorValueParser . Data.Text.pack