I have a record type like this one:
data VehicleState f = VehicleState
{
orientation :: f (Quaternion Double),
orientationRate :: f (Quaternion Double),
acceleration :: f (V3 (Acceleration Double)),
velocity :: f (V3 (Velocity Double)),
location :: f (Coordinate),
elapsedTime :: f (Time Double)
}
deriving (Show)
This is cool, because I can have a VehicleState Signal where I have all sorts of metadata, I can have a VehicleState (Wire s e m ()) where I have the netwire semantics of each signal, or I can have a VehicleState Identity where I have actual values observed at a certain time.
Is there a good way to map back and forth between VehicleState Identity and VehicleState', defined by mapping runIdentity over each field?
data VehicleState' = VehicleState'
{
orientation :: Quaternion Double,
orientationRate :: Quaternion Double,
acceleration :: V3 (Acceleration Double),
velocity :: V3 (Velocity Double),
location :: Coordinate,
elapsedTime :: Time Double
}
deriving (Show)
Obviously it's trivial to write one, but I actually have several types like this in my real application and I keep adding or removing fields, so it is tedious.
I am writing some Template Haskell that does it, just wondering if I am reinventing the wheel.
If you're not opposed to type families and don't need too much type inference, you can actually get away with using a single datatype:
import Data.Singletons.Prelude
data Record f = Record
{ x :: Apply f Int
, y :: Apply f Bool
, z :: Apply f String
}
type Record' = Record IdSym0
test1 :: Record (TyCon1 Maybe)
test1 = Record (Just 3) Nothing (Just "foo")
test2 :: Record'
test2 = Record 2 False "bar"
The Apply type family is defined in the singletons package. It can be applied to
various type functions also defined in that package (and of course, you can define your
own). The IdSym0 has the property that Apply IdSym0 x reduces to plain x. And
TyCon1 has the property that Apply (TyCon1 f) x reduces to f x.
As demonstrated by
test1 and test2, this allows both versions of your datatype. However, you need
type annotations for most records now.
Related
I'd like to be able to derive Eq and Show for an ADT that contains multiple fields. One of them is a function field. When doing Show, I'd like it to display something bogus, like e.g. "<function>"; when doing Eq, I'd like it to ignore that field. How can I best do this without hand-writing a full instance for Show and Eq?
I don't want to wrap the function field inside a newtype and write my own Eq and Show for that - it would be too bothersome to use like that.
One way you can get proper Eq and Show instances is to, instead of hard-coding that function field, make it a type parameter and provide a function that just “erases” that field. I.e., if you have
data Foo = Foo
{ fooI :: Int
, fooF :: Int -> Int }
you change it to
data Foo' f = Foo
{ _fooI :: Int
, _fooF :: f }
deriving (Eq, Show)
type Foo = Foo' (Int -> Int)
eraseFn :: Foo -> Foo' ()
eraseFn foo = foo{ fooF = () }
Then, Foo will still not be Eq- or Showable (which after all it shouldn't be), but to make a Foo value showable you can just wrap it in eraseFn.
Typically what I do in this circumstance is exactly what you say you don’t want to do, namely, wrap the function in a newtype and provide a Show for that:
data T1
{ f :: X -> Y
, xs :: [String]
, ys :: [Bool]
}
data T2
{ f :: OpaqueFunction X Y
, xs :: [String]
, ys :: [Bool]
}
deriving (Show)
newtype OpaqueFunction a b = OpaqueFunction (a -> b)
instance Show (OpaqueFunction a b) where
show = const "<function>"
If you don’t want to do that, you can instead make the function a type parameter, and substitute it out when Showing the type:
data T3' a
{ f :: a
, xs :: [String]
, ys :: [Bool]
}
deriving (Functor, Show)
newtype T3 = T3 (T3' (X -> Y))
data Opaque = Opaque
instance Show Opaque where
show = const "..."
instance Show T3 where
show (T3 t) = show (Opaque <$ t)
Or I’ll refactor my data type to derive Show only for the parts I want to be Showable by default, and override the other parts:
data T4 = T4
{ f :: X -> Y
, xys :: T4' -- Move the other fields into another type.
}
instance Show T4 where
show (T4 f xys) = "T4 <function> " <> show xys
data T4' = T4'
{ xs :: [String]
, ys :: [Bool]
}
deriving (Show) -- Derive ‘Show’ for the showable fields.
Or if my type is small, I’ll use a newtype instead of data, and derive Show via something like OpaqueFunction:
{-# LANGUAGE DerivingVia #-}
newtype T5 = T5 (X -> Y, [String], [Bool])
deriving (Show) via (OpaqueFunction X Y, [String], [Bool])
You can use the iso-deriving package to do this for data types using lenses if you care about keeping the field names / record accessors.
As for Eq (or Ord), it’s not a good idea to have an instance that equates values that can be observably distinguished in some way, since some code will treat them as identical and other code will not, and now you’re forced to care about stability: in some circumstance where I have a == b, should I pick a or b? This is why substitutability is a law for Eq: forall x y f. (x == y) ==> (f x == f y) if f is a “public” function that upholds the invariants of the type of x and y (although floating-point also violates this). A better choice is something like T4 above, having equality only for the parts of a type that can satisfy the laws, or explicitly using comparison modulo some function at use sites, e.g., comparing someField.
The module Text.Show.Functions in base provides a show instance for functions that displays <function>. To use it, just:
import Text.Show.Functions
It just defines an instance something like:
instance Show (a -> b) where
show _ = "<function>"
Similarly, you can define your own Eq instance:
import Text.Show.Functions
instance Eq (a -> b) where
-- all functions are equal...
-- ...though some are more equal than others
_ == _ = True
data Foo = Foo Int Double (Int -> Int) deriving (Show, Eq)
main = do
print $ Foo 1 2.0 (+1)
print $ Foo 1 2.0 (+1) == Foo 1 2.0 (+2) -- is True
This will be an orphan instance, so you'll get a warning with -Wall.
Obviously, these instances will apply to all functions. You can write instances for a more specialized function type (e.g., only for Int -> String, if that's the type of the function field in your data type), but there is no way to simultaneously (1) use the built-in Eq and Show deriving mechanisms to derive instances for your datatype, (2) not introduce a newtype wrapper for the function field (or some other type polymorphism as mentioned in the other answers), and (3) only have the function instances apply to the function field of your data type and not other function values of the same type.
If you really want to limit applicability of the custom function instances without a newtype wrapper, you'd probably need to build your own generics-based solution, which wouldn't make much sense unless you wanted to do this for a lot of data types. If you go this route, then the Generics.Deriving.Show and Generics.Deriving.Eq modules in generic-deriving provide templates for these instances which could be modified to treat functions specially, allowing you to derive per-datatype instances using some stub instances something like:
instance Show Foo where showsPrec = myGenericShowsPrec
instance Eq Foo where (==) = myGenericEquality
I proposed an idea for adding annotations to fields via fields, that allows operating on behaviour of individual fields.
data A = A
{ a :: Int
, b :: Int
, c :: Int -> Int via Ignore (Int->Int)
}
deriving
stock GHC.Generic
deriving (Eq, Show)
via Generically A -- assuming Eq (Generically A)
-- Show (Generically A)
But this is already possible with the "microsurgery" library, but you might have to write some boilerplate to get it going. Another solution is to write separate behaviour in "sums-of-products style"
data A = A Int Int (Int->Int)
deriving
stock GHC.Generic
deriving
anyclass SOP.Generic
deriving (Eq, Show)
via A <-𝈖-> '[ '[ Int, Int, Ignore (Int->Int) ] ]
I have some data that have different representations based on a type parameter, a la Sandy Maguire's Higher Kinded Data. Here are two examples:
wholeMyData :: MyData Z
wholeMyData = MyData 1 'w'
deltaMyData :: MyData Delta
deltaMyData = MyData Nothing (Just $ Left 'b')
I give some of the implementation details below, but first the actual question.
I often want to get a field of the data, usually via a local definition like:
let x = either (Just . Left . myDataChar) myDataChar -- myDataChar a record of MyData
It happens so often I would like to make a standard combinator,
getSubDelta :: ( _ -> _ ) -> Either a b -> Maybe (Either c d)
getSubDelta f = either (Just . Left . f) f
but filling in that signature is problematic. The easy solution is to just supply the record selector function twice,
getSubDelta :: (a->c) -> (b->d) -> Either a b -> Maybe (Either c d)
getSubDelta f g = either (Just . Left . f) g
but that is unseemly. So my question. Is there a way I can fill in the signature above? I'm assuming there is probably a lens based solution, what would that look like? Would it help with deeply nested data? I can't rely on the data types always being single constructor, so prisms? Traversals? My lens game is weak, so I was hoping to get some advice before I proceed.
Thanks!
Some background. I defined a generic method of performing "deltas", via a mix of GHC.Generics and type families. The gist is to use a type family in the definition of the data type. Then, depending how the type is parameterized, the records will either represent whole data or a change to existing data.
For instance, I define the business data using DeltaPoints.
MyData f = MyData { myDataInt :: DeltaPoint f Int
, myDataChar :: DeltaPoint f Char} deriving Generic
The DeltaPoints are implemented in the library, and have different forms for Delta and Z states.
data DeltaState = Z | Delta deriving (Show,Eq,Read)
type family DeltaPoint (st :: DeltaState) a where
DeltaPoint Z a = a
DeltaPoint Delta a = Maybe (Either a (DeltaOf a))
So a DeltaPoint Z a is just the original data, a, and a DeltaPoint Delta a, may or may not be present, and if it is present will either be a replacement of the original (Left) or an update (DeltaOf a).
The runtime delta functionality is encapsulated in a type class.
class HasDelta a where
type DeltaOf a
delta :: a -> a -> Maybe (Either a (DeltaOf a))
applyDeltaOf :: a -> DeltaOf a -> Maybe a
And with the use of Generics, I can usually get the delta capabilities with something like:
instance HasDelta (MyData Z) where
type (DeltaOf (MyData Z)) = MyData Delta
I think you probably want:
{-# LANGUAGE RankNTypes #-}
getSubDelta :: (forall f . (dat f -> DeltaPoint f fld))
-> Either (dat Z) (dat Delta)
-> Maybe (Either (DeltaPoint Z fld) (DeltaOf fld))
getSubDelta sel = either (Just . Left . sel) sel
giving:
x :: Either (MyData Z) (MyData Delta)
-> Maybe (Either (DeltaPoint Z Char) (DeltaOf Char))
x = getSubDelta myDataChar
-- same as: x = either (Just . Left . myDataChar) myDataChar
I'm writing a simple ADT for grid axis. In my application grid may be either regular (with constant step between coordinates), or irregular (otherwise). Of course, the regular grid is just a special case of irregular one, but it may worth to differentiate between them in some situations (for example, to perform some optimizations). So, I declare my ADT as the following:
data GridAxis = RegularAxis (Float, Float) Float -- (min, max) delta
| IrregularAxis [Float] -- [xs]
But I don't want user to create malformed axes with max < min or with unordered xs list. So, I add "smarter" construction functions which perform some basic checks:
regularAxis :: (Float, Float) -> Float -> GridAxis
regularAxis (a, b) dx = RegularAxis (min a b, max a b) (abs dx)
irregularAxis :: [Float] -> GridAxis
irregularAxis xs = IrregularAxis (sort xs)
I don't want user to create grids directly, so I don't add GridAxis data constructors into module export list:
module GridAxis (
GridAxis,
regularAxis,
irregularAxis,
) where
But it turned out that after having this done I cannot use pattern matching on GridAxis anymore. Trying to use it
import qualified GridAxis as GA
test :: GA.GridAxis -> Bool
test axis = case axis of
GA.RegularAxis -> True
GA.IrregularAxis -> False
gives the following compiler error:
src/Physics/ImplicitEMC.hs:7:15:
Not in scope: data constructor `GA.RegularAxis'
src/Physics/ImplicitEMC.hs:8:15:
Not in scope: data constructor `GA.IrregularAxis'
Is there something to work this around?
You can define constructor pattern synonyms. This lets you use the same name for smart construction and "dumb" pattern matching.
{-# LANGUAGE PatternSynonyms #-}
module GridAxis (GridAxis, pattern RegularAxis, pattern IrregularAxis) where
import Data.List
data GridAxis = RegularAxis_ (Float, Float) Float -- (min, max) delta
| IrregularAxis_ [Float] -- [xs]
-- The line with "<-" defines the matching behavior
-- The line with "=" defines the constructor behavior
pattern RegularAxis minmax delta <- RegularAxis_ minmax delta where
RegularAxis (a, b) dx = RegularAxis_ (min a b, max a b) (abs dx)
pattern IrregularAxis xs <- IrregularAxis_ xs where
IrregularAxis xs = IrregularAxis_ (sort xs)
Now you can do:
module Foo
import GridAxis
foo :: GridAxis -> a
foo (RegularAxis (a, b) d) = ...
foo (IrregularAxis xs) = ...
And also use RegularAxis and IrregularAxis as smart constructors.
This looks as a use case for pattern synonyms.
Basically you don't export the real constructor, but only a "smart" one
{-# LANGUAGE PatternSynonyms #-}
module M(T(), SmartCons, smartCons) where
data T = RealCons Int
-- the users will construct T using this
smartCons :: Int -> T
smartCons n = if even n then RealCons n else error "wrong!"
-- ... and destruct T using this
pattern SmartCons n <- RealCons n
Another module importing M can then use
case someTvalue of
SmartCons n -> use n
and e.g.
let value = smartCons 23 in ...
but can not use the RealCons directly.
If you prefer to stay in basic Haskell, without extensions, you can use a "view type"
module M(T(), smartCons, Tview(..), toView) where
data T = RealCons Int
-- the users will construct T using this
smartCons :: Int -> T
smartCons n = if even n then RealCons n else error "wrong!"
-- ... and destruct T using this
data Tview = Tview Int
toView :: T -> Tview
toView (RealCons n) = Tview n
Here, users have full access to the view type, which can be constructed/destructed freely, but have only a restricted start constructor for the actual type T. Destructing the actual type T is possible by moving to the view type
case toView someTvalue of
Tview n -> use n
For nested patterns, things become more cumbersome, unless you enable other extensions such as ViewPatterns.
In some languages (#racket/typed, for example), the programmer can specify a union type without discriminating against it, for instance, the type (U Integer String) captures integers and strings, without tagging them (I Integer) (S String) in a data IntOrStringUnion = ... form or anything like that.
Is there a way to do the same in Haskell?
Either is what you're looking for... ish.
In Haskell terms, I'd describe what you're looking for as an anonymous sum type. By anonymous, I mean that it doesn't have a defined name (like something with a data declaration). By sum type, I mean a data type that can have one of several (distinguishable) types; a tagged union or such. (If you're not familiar with this terminology, try Wikipedia for starters.)
We have a well-known idiomatic anonymous product type, which is just a tuple. If you want to have both an Int and a String, you just smush them together with a comma: (Int, String). And tuples (seemingly) can go on forever--(Int, String, Double, Word), and you can pattern-match the same way. (There's a limit, but never mind.)
The well-known idiomatic anonymous sum type is Either, from Data.Either (and the Prelude):
data Either a b = Left a | Right b
deriving (Eq, Ord, Read, Show, Typeable)
It has some shortcomings, most prominently a Functor instance that favors Right in a way that's odd in this context. The problem is that chaining it introduces a lot of awkwardness: the type ends up like Either (Int (Either String (Either Double Word))). Pattern matching is even more awkward, as others have noted.
I just want to note that we can get closer to (what I understand to be) the Racket use case. From my extremely brief Googling, it looks like in Racket you can use functions like isNumber? to determine what type is actually in a given value of a union type. In Haskell, we usually do that with case analysis (pattern matching), but that's awkward with Either, and function using simple pattern-matching will likely end up hard-wired to a particular union type. We can do better.
IsNumber?
I'm going to write a function I think is an idiomatic Haskell stand-in for isNumber?. First, we don't like doing Boolean tests and then running functions that assume their result; instead, we tend to just convert to Maybe and go from there. So the function's type will end with -> Maybe Int. (Using Int as a stand-in for now.)
But what's on the left hand of the arrow? "Something that might be an Int -- or a String, or whatever other types we put in the union." Uh, okay. So it's going to be one of a number of types. That sounds like typeclass, so we'll put a constraint and a type variable on the left hand of the arrow: MightBeInt a => a -> Maybe Int. Okay, let's write out the class:
class MightBeInt a where
isInt :: a -> Maybe Int
fromInt :: Int -> a
Okay, now how do we write the instances? Well, we know if the first parameter to Either is Int, we're golden, so let's write that out. (Incidentally, if you want a nice exercise, only look at the instance ... where parts of these next three code blocks, and try to implement that class members yourself.)
instance MightBeInt (Either Int b) where
isInt (Left i) = Just i
isInt _ = Nothing
fromInt = Left
Fine. And ditto if Int is the second parameter:
instance MightBeInt (Either a Int) where
isInt (Right i) = Just i
isInt _ = Nothing
fromInt = Right
But what about Either String (Either Bool Int)? The trick is to recurse on the right hand type: if it's not Int, is it an instance of MightBeInt itself?
instance MightBeInt b => MightBeInt (Either a b) where
isInt (Right xs) = isInt xs
isInt _ = Nothing
fromInt = Right . fromInt
(Note that these all require FlexibleInstances and OverlappingInstances.) It took me a long time to get a feel for writing and reading these class instances; don't worry if this instance is surprising. The punch line is that we can now do this:
anInt1 :: Either Int String
anInt1 = fromInt 1
anInt2 :: Either String (Either Int Double)
anInt2 = fromInt 2
anInt3 :: Either String Int
anInt3 = fromInt 3
notAnInt :: Either String Int
notAnInt = Left "notint"
ghci> isInt anInt3
Just 3
ghci> isInt notAnInt
Nothing
Great!
Generalizing
Okay, but now do we need to write another type class for each type we want to look up? Nope! We can parameterize the class by the type we want to look up! It's a pretty mechanical translation; the only question is how to tell the compiler what type we're looking for, and that's where Proxy comes to the rescue. (If you don't want to install tagged or run base 4.7, just define data Proxy a = Proxy. It's nothing special, but you'll need PolyKinds.)
class MightBeA t a where
isA :: proxy t -> a -> Maybe t
fromA :: t -> a
instance MightBeA t t where
isA _ = Just
fromA = id
instance MightBeA t (Either t b) where
isA _ (Left i) = Just i
isA _ _ = Nothing
fromA = Left
instance MightBeA t b => MightBeA t (Either a b) where
isA p (Right xs) = isA p xs
isA _ _ = Nothing
fromA = Right . fromA
ghci> isA (Proxy :: Proxy Int) anInt3
Just 3
ghci> isA (Proxy :: Proxy String) notAnInt
Just "notint"
Now the usability situation is... better. The main thing we've lost, by the way, is the exhaustiveness checker.
Notational Parity With (U String Int Double)
For fun, in GHC 7.8 we can use DataKinds and TypeFamilies to eliminate the infix type constructors in favor of type-level lists. (In Haskell, you can't have one type constructor--like IO or Either--take a variable number of parameters, but a type-level list is just one parameter.) It's just a few lines, which I'm not really going to explain:
type family OneOf (as :: [*]) :: * where
OneOf '[] = Void
OneOf '[a] = a
OneOf (a ': as) = Either a (OneOf as)
Note that you'll need to import Data.Void. Now we can do this:
anInt4 :: OneOf '[Int, Double, Float, String]
anInt4 = fromInt 4
ghci> :kind! OneOf '[Int, Double, Float, String]
OneOf '[Int, Double, Float, String] :: *
= Either Int (Either Double (Either Float [Char]))
In other words, OneOf '[Int, Double, Float, String] is the same as Either Int (Either Double (Either Float [Char])).
You need some kind of tagging because you need to be able to check if a value is actually an Integer or a String to use it for anything. One way to alleviate having to create a custom ADT for every combination is to use a type such as
{-# LANGUAGE TypeOperators #-}
data a :+: b = L a | R b
infixr 6 :+:
returnsIntOrString :: Integer -> Integer :+: String
returnsIntOrString i
| i `rem` 2 == 0 = R "Even"
| otherwise = L (i * 2)
returnsOneOfThree :: Integer -> Integer :+: String :+: Bool
returnsOneOfThree i
| i `rem` 2 == 0 = (R . L) "Even"
| i `rem` 3 == 0 = (R . R) False
| otherwise = L (i * 2)
What is the simplest Haskell library that allows composition of stateful functions?
We can use the State monad to compute a stock's exponentially-weighted moving average as follows:
import Control.Monad.State.Lazy
import Data.Functor.Identity
type StockPrice = Double
type EWMAState = Double
type EWMAResult = Double
computeEWMA :: Double -> StockPrice -> State EWMAState EWMAResult
computeEWMA α price = do oldEWMA <- get
let newEWMA = α * oldEWMA + (1.0 - α) * price
put newEWMA
return newEWMA
However, it's complicated to write a function that calls other stateful functions.
For example, to find all data points where the stock's short-term average crosses its long-term average, we could write:
computeShortTermEWMA = computeEWMA 0.2
computeLongTermEWMA = computeEWMA 0.8
type CrossingState = Bool
type GoldenCrossState = (CrossingState, EWMAState, EWMAState)
checkIfGoldenCross :: StockPrice -> State GoldenCrossState String
checkIfGoldenCross price = do (oldCrossingState, oldShortState, oldLongState) <- get
let (shortEWMA, newShortState) = runState (computeShortTermEWMA price) oldShortState
let (longEWMA, newLongState) = runState (computeLongTermEWMA price) oldLongState
let newCrossingState = (shortEWMA < longEWMA)
put (newCrossingState, newShortState, newLongState)
return (if newCrossingState == oldCrossingState then
"no cross"
else
"golden cross!")
Since checkIfGoldenCross calls computeShortTermEWMA and computeLongTermEWMA, we must manually wrap/unwrap their states.
Is there a more elegant way?
If I understood your code correctly, you don't share state between the call to computeShortTermEWMA and computeLongTermEWMA. They're just two entirely independent functions which happen to use state internally themselves. In this case, the elegant thing to do would be to encapsulate runState in the definitions of computeShortTermEWMA and computeLongTermEWMA, since they're separate self-contained entities:
computeShortTermEWMA start price = runState (computeEWMA 0.2 price) start
All this does is make the call site a bit neater though; I just moved the runState into the definition. This marks the state a local implementation detail of computing the EWMA, which is what it really is. This is underscored by the way GoldenCrossState is a different type from EWMAState.
In other words, you're not really composing stateful functions; rather, you're composing functions that happen to use state inside. You can just hide that detail.
More generally, I don't really see what you're using the state for at all. I suppose you would use it to iterate through the stock price, maintaining the EWMA. However, I don't think this is necessarily the best way to do it. Instead, I would consider writing your EWMA function over a list of stock prices, using something like a scan. This should make your other analysis functions easier to implement, since they'll just be list functions as well. (In the future, if you need to deal with IO, you can always switch over to something like Pipes which presents an interface really similar to lists.)
There is really no need to use any monad at all for these simple functions. You're (ab)using the State monad to calculate a one-off result in computeEWMA when there is no state involved. The only line that is actually important is the formula for EWMA, so let's pull that into it's own function.
ewma :: Double -> Double -> Double -> Double
ewma a price t = a * t + (1 - a) * price
If you inline the definition of State and ignore the String values, this next function has almost the exact same signature as your original checkIfGoldenCross!
type EWMAState = (Bool, Double, Double)
ewmaStep :: Double -> EWMAState -> EWMAState
ewmaStep price (crossing, short, long) =
(crossing == newCrossing, newShort, newLong)
where newCrossing = newShort < newLong
newShort = ewma 0.2 price short
newLong = ewma 0.8 price long
Although it doesn't use the State monad, we're certainly dealing with state here. ewmaStep takes a stock price, the old EWMAState and returns a new EWMAState.
Now putting it all together with scanr :: (a -> b -> b) -> b -> [a] -> [b]
-- a list of stock prices
prices = [1.2, 3.7, 2.8, 4.3]
_1 (a, _, _) = a
main = print . map _1 $ scanr ewmaStep (False, 0, 0) prices
-- [False, True, False, True, False]
Because fold* and scan* use the cumulative result of previous values to compute each successive one, they are "stateful" enough that they can often be used in cases like this.
In this particular case, you have a y -> (a, y) and a z -> (b, z) that you want to use to compose a (x, y, z) -> (c, (x, y, z)). Having never used lens before, this seems like a perfect opportunity.
In general, we can promote a stateful operations on a sub-state to operate on the whole state like this:
promote :: Lens' s s' -> StateT s' m a -> StateT s m a
promote lens act = do
big <- get
let little = view lens big
(res, little') = runState act little
big' = set lens little' big
put big'
return res
-- Feel free to golf and optimize, but this is pretty readable.
Our lens a witness that s' is a sub-state of s.
I don't know if "promote" is a good name, and I don't recall seeing this function defined elsewhere (but it's probably already in lens).
The witnesses you need are named _2 and _3 in lens so, you could change a couple of lines of code to look like:
shortEWMA <- promote _2 (computeShortTermEWMA price)
longEWMA <- promote _3 (computeLongTermEWMA price)
If a Lens allows you to focus on inner values, maybe this combinator should be called blurredBy (for prefix application) or obscures (for infix application).
With a little type class magic, monad transformers allow you to have nested transformers of the same type. First, you will need a new instance for MonadState:
{-# LANGUAGE
UndecidableInstances
, OverlappingInstances
#-}
instance (MonadState s m, MonadTrans t, Monad (t m)) => MonadState s (t m) where
state f = lift (state f)
Then you must define your EWMAState as a newtype, tagged with the type of term (alternatively, it could be two different types - but using a phantom type as a tag has its advantages):
data Term = ShortTerm | LongTerm
type StockPrice = Double
newtype EWMAState (t :: Term) = EWMAState Double
type EWMAResult = Double
type CrossingState = Bool
Now, computeEWMA works on an EWMASTate which is polymorphic in term (the afformentioned example of tagging with phantom types), and in monad:
computeEWMA :: (MonadState (EWMAState t) m) => Double -> StockPrice -> m EWMAResult
computeEWMA a price = do
EWMAState old <- get
let new = a * old + (1.0 - a) * price
put $ EWMAState new
return new
For specific instances, you give them monomorphic type signatures:
computeShortTermEWMA :: (MonadState (EWMAState ShortTerm) m) => StockPrice -> m EWMAResult
computeShortTermEWMA = computeEWMA 0.2
computeLongTermEWMA :: (MonadState (EWMAState LongTerm) m) => StockPrice -> m EWMAResult
computeLongTermEWMA = computeEWMA 0.8
Finally, your function:
checkIfGoldenCross ::
( MonadState (EWMAState ShortTerm) m
, MonadState (EWMAState LongTerm) m
, MonadState CrossingState m) =>
StockPrice -> m String
checkIfGoldenCross price = do
oldCrossingState <- get
shortEWMA <- computeShortTermEWMA price
longEWMA <- computeLongTermEWMA price
let newCrossingState = shortEWMA < longEWMA
put newCrossingState
return (if newCrossingState == oldCrossingState then "no cross" else "golden cross!")
The only downside is you have to explicitly give a type signature - in fact, the instance we introduced at the beginning has ruined all hopes of good type errors and type inference for cases where you have multiple copies of the same transformer in a stack.
Then a small helper function:
runState3 :: StateT a (StateT b (State c)) x -> a -> b -> c -> ((a , b , c) , x)
runState3 sa a b c = ((a' , b', c'), x) where
(((x, a'), b'), c') = runState (runStateT (runStateT sa a) b) c
and:
>runState3 (checkIfGoldenCross 123) (shortTerm 123) (longTerm 123) True
((EWMAState 123.0,EWMAState 123.0,False),"golden cross!")
>runState3 (checkIfGoldenCross 123) (shortTerm 456) (longTerm 789) True
((EWMAState 189.60000000000002,EWMAState 655.8000000000001,True),"no cross")