diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/emhell.cabal b/emhell.cabal --- a/emhell.cabal +++ b/emhell.cabal @@ -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 @@ -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 diff --git a/emhell/Main.hs b/emhell/Main.hs --- a/emhell/Main.hs +++ b/emhell/Main.hs @@ -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 = diff --git a/hgdb/Main.hs b/hgdb/Main.hs --- a/hgdb/Main.hs +++ b/hgdb/Main.hs @@ -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 diff --git a/hocd/Main.hs b/hocd/Main.hs --- a/hocd/Main.hs +++ b/hocd/Main.hs @@ -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") diff --git a/src/EmHell/SVD/Completion.hs b/src/EmHell/SVD/Completion.hs --- a/src/EmHell/SVD/Completion.hs +++ b/src/EmHell/SVD/Completion.hs @@ -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 diff --git a/src/EmHell/SVD/Manipulation.hs b/src/EmHell/SVD/Manipulation.hs new file mode 100644 --- /dev/null +++ b/src/EmHell/SVD/Manipulation.hs @@ -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" diff --git a/src/EmHell/SVD/Query.hs b/src/EmHell/SVD/Query.hs new file mode 100644 --- /dev/null +++ b/src/EmHell/SVD/Query.hs @@ -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" diff --git a/src/EmHell/SVD/Selector.hs b/src/EmHell/SVD/Selector.hs --- a/src/EmHell/SVD/Selector.hs +++ b/src/EmHell/SVD/Selector.hs @@ -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