module Debugger.Statement
  ( Line
  , Location(..)
  , Var
  , Expr
  , ShellCommand
  , Id(..)
  , Selection(..)
  , Port
  , TargetConfig(..)
  , InfoOptions(..)
  , Statement(..)
  , Script
  ) where

import Data.Text (Text)

type Var = Text  -- TODO different type?

type Expr = Text  -- TODO different type?

type ShellCommand = Text

-- | Datatype representing a ID of a breakpoint.
newtype Id = Id Text
  deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)

type Line = Int

-- | Helper datatype for a selection of 1 or more (breakpoints)
data Selection
  = Single Id
  | Many [Id]
  | All
  deriving (Selection -> Selection -> Bool
(Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool) -> Eq Selection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c== :: Selection -> Selection -> Bool
Eq, Int -> Selection -> ShowS
[Selection] -> ShowS
Selection -> String
(Int -> Selection -> ShowS)
-> (Selection -> String)
-> ([Selection] -> ShowS)
-> Show Selection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection] -> ShowS
$cshowList :: [Selection] -> ShowS
show :: Selection -> String
$cshow :: Selection -> String
showsPrec :: Int -> Selection -> ShowS
$cshowsPrec :: Int -> Selection -> ShowS
Show)

type Port = Int

-- TODO: add other variants
-- | Datatype for configuring the GDB target.
data TargetConfig
  = Remote Port  -- assumes tcp as protocol, and localhost as host for now
  deriving (TargetConfig -> TargetConfig -> Bool
(TargetConfig -> TargetConfig -> Bool)
-> (TargetConfig -> TargetConfig -> Bool) -> Eq TargetConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetConfig -> TargetConfig -> Bool
$c/= :: TargetConfig -> TargetConfig -> Bool
== :: TargetConfig -> TargetConfig -> Bool
$c== :: TargetConfig -> TargetConfig -> Bool
Eq, Int -> TargetConfig -> ShowS
[TargetConfig] -> ShowS
TargetConfig -> String
(Int -> TargetConfig -> ShowS)
-> (TargetConfig -> String)
-> ([TargetConfig] -> ShowS)
-> Show TargetConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetConfig] -> ShowS
$cshowList :: [TargetConfig] -> ShowS
show :: TargetConfig -> String
$cshow :: TargetConfig -> String
showsPrec :: Int -> TargetConfig -> ShowS
$cshowsPrec :: Int -> TargetConfig -> ShowS
Show)

-- | Enumeration of all things info can be requested about.
data InfoOptions
  = Breakpoints
  deriving (InfoOptions -> InfoOptions -> Bool
(InfoOptions -> InfoOptions -> Bool)
-> (InfoOptions -> InfoOptions -> Bool) -> Eq InfoOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoOptions -> InfoOptions -> Bool
$c/= :: InfoOptions -> InfoOptions -> Bool
== :: InfoOptions -> InfoOptions -> Bool
$c== :: InfoOptions -> InfoOptions -> Bool
Eq, Int -> InfoOptions -> ShowS
[InfoOptions] -> ShowS
InfoOptions -> String
(Int -> InfoOptions -> ShowS)
-> (InfoOptions -> String)
-> ([InfoOptions] -> ShowS)
-> Show InfoOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InfoOptions] -> ShowS
$cshowList :: [InfoOptions] -> ShowS
show :: InfoOptions -> String
$cshow :: InfoOptions -> String
showsPrec :: Int -> InfoOptions -> ShowS
$cshowsPrec :: Int -> InfoOptions -> ShowS
Show)

-- | A place to set a breakpoint at.
data Location
  = Function Text
  | File FilePath Line
  deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show)

-- | Main AST data type used to build a script with.
data Statement
  = Break Location
  | Command Id [Statement]
  | Continue
  | Step (Maybe Int)
  | Next (Maybe Int)
  | Run
  | Reset
  | Delete Selection
  | Enable Selection
  | Disable Selection
  | Shell ShellCommand
  | Source FilePath
  | Print Expr
  | Set Var Expr
  | Call Expr
  | Target TargetConfig
  | Info InfoOptions
  deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)

-- | A script is a collection of statements.
type Script = [Statement]

  {-
TODO
data Statement
  = Break Location -- hbreak? conditional breakpoints?
  | Printf Text [Expr]
  | If Expr [Statement]
  -- set logging on (opts), ...
-}