mirror of
https://github.com/github/semantic.git
synced 2024-12-14 08:25:32 +03:00
Define a String effect.
Co-Authored-By: Ayman Nadeem <aymannadeem@gmail.com>
This commit is contained in:
parent
937728d858
commit
88d77a9843
@ -28,6 +28,7 @@ module Control.Abstract.Value
|
|||||||
, Unit(..)
|
, Unit(..)
|
||||||
, runUnit
|
, runUnit
|
||||||
, UnitC(..)
|
, UnitC(..)
|
||||||
|
, String(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
@ -40,6 +41,7 @@ import Data.Abstract.Name
|
|||||||
import Data.Abstract.Number as Number
|
import Data.Abstract.Number as Number
|
||||||
import Data.Scientific (Scientific)
|
import Data.Scientific (Scientific)
|
||||||
import Data.Span
|
import Data.Span
|
||||||
|
import Prelude hiding (String)
|
||||||
import Prologue hiding (TypeError)
|
import Prologue hiding (TypeError)
|
||||||
|
|
||||||
-- | This datum is passed into liftComparison to handle the fact that Ruby and PHP
|
-- | This datum is passed into liftComparison to handle the fact that Ruby and PHP
|
||||||
@ -212,6 +214,19 @@ runUnit :: Carrier (Unit value :+: sig) (UnitC value (Eff m))
|
|||||||
-> Evaluator term address value m a
|
-> Evaluator term address value m a
|
||||||
runUnit = raiseHandler $ runUnitC . interpret
|
runUnit = raiseHandler $ runUnitC . interpret
|
||||||
|
|
||||||
|
data String value (m :: * -> *) k
|
||||||
|
= String Text (value -> k)
|
||||||
|
| AsString value (Text -> k)
|
||||||
|
deriving (Functor)
|
||||||
|
|
||||||
|
instance HFunctor (String value) where
|
||||||
|
hmap _ = coerce
|
||||||
|
{-# INLINE hmap #-}
|
||||||
|
|
||||||
|
instance Effect (String value) where
|
||||||
|
handle state handler (String text k) = String text (handler . (<$ state) . k)
|
||||||
|
handle state handler (AsString v k) = AsString v (handler . (<$ state) . k)
|
||||||
|
|
||||||
|
|
||||||
class Show value => AbstractIntro value where
|
class Show value => AbstractIntro value where
|
||||||
-- | Construct an abstract string value.
|
-- | Construct an abstract string value.
|
||||||
|
Loading…
Reference in New Issue
Block a user