module Pinchot.Types where
import Pinchot.Intervals
import qualified Control.Lens as Lens
import Data.Data (Data)
import GHC.Generics (Generic)
import Data.Sequence (Seq)
import Data.Sequence.NonEmpty (NonEmptySeq)
import qualified Language.Haskell.TH as T
import Text.Show.Pretty (PrettyVal(prettyVal))
import qualified Text.Show.Pretty as Pretty
import Pinchot.Pretty
type RuleName = String
type BranchName = String
data Rule t = Rule
{ _ruleName :: RuleName
, _ruleDescription :: Maybe String
, _ruleType :: RuleType t
} deriving (Eq, Ord, Show, Data, Generic, PrettyVal)
ruleName :: Lens.Lens' (Rule t) RuleName
ruleName
= Lens.lens _ruleName (\r n -> r { _ruleName = n })
ruleDescription :: Lens.Lens' (Rule t) (Maybe String)
ruleDescription
= Lens.lens _ruleDescription (\r d -> r { _ruleDescription = d })
ruleType :: Lens.Lens' (Rule t) (RuleType t)
ruleType
= Lens.lens _ruleType (\r t -> r { _ruleType = t })
data Branch t = Branch
{ _branchName :: BranchName
, _branches :: Seq (Rule t)
} deriving (Eq, Ord, Show, Data)
branchName :: Lens.Lens' (Branch t) BranchName
branchName
= Lens.lens _branchName (\b n -> b { _branchName = n })
branches :: Lens.Lens' (Branch t) (Seq (Rule t))
branches
= Lens.lens _branches (\b s -> b { _branches = s})
instance PrettyVal t => PrettyVal (Branch t) where
prettyVal (Branch b1 bs) = Pretty.Rec "Branch"
[ ("_branchName", prettyVal b1)
, ("_branches", prettySeq prettyVal bs)
]
data RuleType t
= Terminal (Intervals t)
| NonTerminal (NonEmptySeq (Branch t))
| Wrap (Rule t)
| Record (Seq (Rule t))
| Opt (Rule t)
| Star (Rule t)
| Plus (Rule t)
deriving (Eq, Ord, Show, Data)
_Terminal :: Lens.Prism' (RuleType t) (Intervals t)
_Terminal = Lens.prism' (\i -> Terminal i)
(\r -> case r of { Terminal i -> Just i; _ -> Nothing })
_NonTerminal :: Lens.Prism' (RuleType t) (NonEmptySeq (Branch t))
_NonTerminal = Lens.prism' (\b -> NonTerminal b)
(\r -> case r of { NonTerminal b -> Just b; _ -> Nothing })
_Wrap :: Lens.Prism' (RuleType t) (Rule t)
_Wrap = Lens.prism' (\r -> Wrap r)
(\r -> case r of { Wrap x -> Just x; _ -> Nothing })
_Record :: Lens.Prism' (RuleType t) (Seq (Rule t))
_Record = Lens.prism' (\r -> Record r)
(\r -> case r of { Record x -> Just x; _ -> Nothing })
_Opt :: Lens.Prism' (RuleType t) (Rule t)
_Opt = Lens.prism' (\r -> Opt r)
(\r -> case r of { Opt x -> Just x; _ -> Nothing })
_Star :: Lens.Prism' (RuleType t) (Rule t)
_Star = Lens.prism' (\r -> Star r)
(\r -> case r of { Star x -> Just x; _ -> Nothing })
_Plus :: Lens.Prism' (RuleType t) (Rule t)
_Plus = Lens.prism' (\r -> Plus r)
(\r -> case r of { Plus x -> Just x; _ -> Nothing })
instance PrettyVal t => PrettyVal (RuleType t) where
prettyVal x = case x of
Terminal ivl -> Pretty.Con "Terminal" [(prettyVal ivl)]
NonTerminal ne -> Pretty.Con "NonTerminal"
[prettyNonEmptySeq prettyVal ne]
Wrap r -> Pretty.Con "Wrap" [prettyVal r]
Record rs -> Pretty.Con "Record" [prettySeq prettyVal rs]
Opt rs -> Pretty.Con "Opt" [prettyVal rs]
Star rs -> Pretty.Con "Star" [prettyVal rs]
Plus rs -> Pretty.Con "Plus" [prettyVal rs]
recordFieldName
:: Int
-> String
-> String
-> String
recordFieldName idx par inn = "r'" ++ par ++ "'" ++ show idx ++ "'" ++ inn
type Qualifier = String
quald
:: Qualifier
-> String
-> T.Name
quald qual suf
| null qual = T.mkName suf
| otherwise = T.mkName (qual ++ '.':suf)
data Loc = Loc
{ _line :: Int
, _col :: Int
, _pos :: Int
} deriving (Eq, Ord, Read, Show, Data, Generic, PrettyVal)
line :: Lens.Lens' Loc Int
line = Lens.lens _line (\r l -> r { _line = l })
col :: Lens.Lens' Loc Int
col = Lens.lens _col (\r l -> r { _col = l })
pos :: Lens.Lens' Loc Int
pos = Lens.lens _pos (\r l -> r { _pos = l })