{-# 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


-- | The Context provides a persistent information and collection over a set of
-- demangling calls.  This allows for additional efficiency in memory storage.

-- Note that it can be observed that the stored data here is identifiers, and
-- therefore there are 64 initial characters ('A-Za-z0-9_' + 1 bucket for all
-- others).  This might lead to the use of an Array of Seq or an IntMap of Seq.
-- Both of these were tested in both single and batched mode against
-- approximately 13,000 demanglings: there was no significant different between
-- those more complicated forms and this simple Seq in either time, memory
-- consumption, or garbage collection, so this simplest form is sufficient.

data Context = Context (Seq.Seq Text)

-- | Return an initial Context useable for calls to 'demangle'.

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"