{-# LANGUAGE TemplateHaskell #-}
module Demangler.Context
(
Context
, Coord
, newDemangling
, contextFindOrAdd
, contextStr
, WithContext
, addContext
, withContext
, contextData
, withContextForTemplateArg
, isTemplateArgContext
, sayableConstraints
)
where
import Data.Sequence ( (|>) )
import qualified Data.Sequence as Seq
import Data.Text ( Text )
import qualified Language.Haskell.TH as TH
import Text.Sayable
data Context = Context (Seq.Seq Text)
newDemangling :: Context
newDemangling :: Context
newDemangling = Seq Text -> Context
Context Seq Text
forall a. Monoid a => a
mempty
type Coord = Int
contextFindOrAdd :: Text -> Context -> (Coord, Context)
contextFindOrAdd :: Text -> Context -> (Coord, Context)
contextFindOrAdd Text
s c :: Context
c@(Context Seq Text
l) =
case Text -> Seq Text -> Maybe Coord
forall a. Eq a => a -> Seq a -> Maybe Coord
Seq.elemIndexL Text
s Seq Text
l of
Just Coord
n -> (Coord
n, Context
c)
Maybe Coord
Nothing -> (Seq Text -> Coord
forall a. Seq a -> Coord
Seq.length Seq Text
l, Seq Text -> Context
Context (Seq Text -> Context) -> Seq Text -> Context
forall a b. (a -> b) -> a -> b
$ Seq Text
l Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
|> Text
s)
contextStr :: WithContext a -> Coord -> Text
contextStr :: forall a. WithContext a -> Coord -> Text
contextStr (WC SayingElement
_ a
_ (Context Seq Text
l)) Coord
i = Seq Text
l Seq Text -> Coord -> Text
forall a. Seq a -> Coord -> a
`Seq.index` Coord
i
data SayingElement = DefaultSay | SayingTemplateArg
data WithContext a = WC SayingElement a Context
addContext :: a -> Context -> WithContext a
addContext :: forall a. a -> Context -> WithContext a
addContext = SayingElement -> a -> Context -> WithContext a
forall a. SayingElement -> a -> Context -> WithContext a
WC SayingElement
DefaultSay
withContext :: WithContext a -> b -> WithContext b
withContext :: forall a b. WithContext a -> b -> WithContext b
withContext (WC SayingElement
s a
_ Context
c) b
d = SayingElement -> b -> Context -> WithContext b
forall a. SayingElement -> a -> Context -> WithContext a
WC SayingElement
s b
d Context
c
withContextForTemplateArg :: WithContext a -> b -> WithContext b
withContextForTemplateArg :: forall a b. WithContext a -> b -> WithContext b
withContextForTemplateArg (WC SayingElement
_ a
_ Context
c) b
d = SayingElement -> b -> Context -> WithContext b
forall a. SayingElement -> a -> Context -> WithContext a
WC SayingElement
SayingTemplateArg b
d Context
c
isTemplateArgContext :: WithContext a -> Bool
isTemplateArgContext :: forall a. WithContext a -> Bool
isTemplateArgContext (WC SayingElement
SayingTemplateArg a
_ Context
_) = Bool
True
isTemplateArgContext WithContext a
_ = Bool
False
contextData :: WithContext a -> a
contextData :: forall a. WithContext a -> a
contextData (WC SayingElement
_ a
d Context
_) = a
d
sayableConstraints :: TH.Name -> TH.PredQ
sayableConstraints :: Name -> PredQ
sayableConstraints Name
forTy = do
let rTy :: Type
rTy = Name -> Type
TH.ConT Name
forTy
Type
wctxt <- [t|WithContext|]
ConstrM () -> PredQ
sayableSubConstraints (ConstrM () -> PredQ) -> ConstrM () -> PredQ
forall a b. (a -> b) -> a -> b
$ do Name -> ConstrM ()
ofType Name
forTy
Type -> ConstrM ()
paramTH Type
rTy
(Name -> Bool) -> ConstrM ()
subElemFilter (Bool -> Bool
not
(Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"Context"
, String
"Bool"
, String
"Natural"
, String
"Float"
])
(String -> Bool) -> (Name -> String) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
TH.nameBase)
Type -> ConstrM ()
subWrapper Type
wctxt
String -> ConstrM ()
tagVar String
"saytag"