//we have a "person":
var person = {
name: "James",
age: 28,
address: {
house: 42,
street: "Some Road",
city: "London"
}
};
data Person = Person
{ name :: String
, age :: Int
, address :: Address
}
data Address = Address
{ house :: Int
, street :: String
, city :: String
}
james = Person {
name = "James",
age = 28,
address = Address {
house = 42,
street = "Some Road",
city = "London"
}
}
var houseNumber =
person.address.house;
person.address.house = 29;
houseNumber =
house (address james)
updatedJames =
james {
address =
(address james) { house = 29 }
}
setHouse person value =
person { address = (address person) { house = value } }
setStreet person value =
person { address = (address person) { street = value } }
newPerson1 = setHouse person 45
newPerson2 = setStreet person "New Street"
Because they are not composable!
data Lens obj field = Lens
{ view :: obj -> field
, set :: field -> obj -> obj
}
lens(obj, field) — pair of
• getter from obj to field
• setter of field inside object
over :: Lens obj field -> (field -> field) -> (obj -> obj)
over lens updater obj = set lens (updater $ view lens obj) obj
view :: Lens obj field -> obj -> field
set :: Lens obj field -> field -> obj -> obj
data Lens obj field = Lens
{ view :: obj -> field
, over :: (field -> field) -> (obj -> obj)
}
Let's use another but equivalent definition for further convenience
set :: Lens obj field -> field -> obj -> obj
set = _
set :: Lens obj field -> field -> obj -> obj
set lens newField obj = over lens (const newField) obj
view :: Lens obj field -> obj -> field
over :: Lens obj field -> (field -> field) -> (obj -> obj)
personAddressLens :: Lens Person Address
personAddressLens = Lens address (\fn obj -> obj { address = fn (address obj) })
addressCityLens :: Lens Address City
addressCityLens = Lens city (\fn obj -> obj { city = fn (city obj) })
data Lens obj field = Lens
{ view :: obj -> field
, over :: (field -> field) -> (obj -> obj)
}
data Person = Person
{ name :: String
, age :: Int
, address :: Address
}
data Address = Address
{ house :: Int
, street :: Street
, city :: City
}
newtype City = City String
newtype Street = Street String
personAddressLens :: Lens Person Address
addressCityLens :: Lens Address City
Naive ugly implementation
personCityLens :: Lens Person City
personCityLens =
Lens (city . address)
(\cityFn person -> person
{ address = address person
{ city = cityFn $ city $ address person }
}
)
personCityLens :: Lens Person City
personCityLens =
Lens (view addressCityLens . view personAddressLens)
(over personAddressLens . over addressCityLens)
Using existing lenses
(.) :: (b -> c) -> (a -> b) -> (a -> c)
(.) g f x = g (f x)
view addressCityLens :: Address -> City
view personAddressLens :: Person -> Address
a -> b = Person -> Address
a = Person, b = Address
b -> c = Address -> City
b = Address, c = City
a -> c = Person -> City
(.) :: (b -> c) -> (a -> b) -> (a -> c)
over personAddressLens :: (Address -> Address) -> (Person -> Person)
over addressCityLens :: (City -> City) -> (Address -> Address)
a -> b = (City -> City) -> (Address -> Address)
a = City -> City, b = Address -> Address
b -> c = (Address -> Address) -> (Person -> Person)
b = Address -> Address, c = Person -> Person
a -> c = (City -> City) -> (Person -> Person)
ghci> view addressLens james
Address {house = 42, street = "Some Road", city = "London"}
ghci> view personToCityLens james
"London"
ghci> set personToCityLens "Paris" james
Person { name = "James"
, age = 28,
, address = Address { house = 42
, street = "Some Road"
, city = "Paris"
}
}
ghci> over personToCityLens (++"!!!!") james
Person { name = "James"
, age = 28,
, address = Address { house = 42
, street = "Some Road"
, city = "London!!!!"
}
}
(.>) :: Lens obj field
-> Lens field subfield
-> Lens obj subfield
o2f .> f2s = _
(.>) :: Lens obj field
-> Lens field subfield
-> Lens obj subfield
o2f .> f2s = Lens (view f2s . view o2f)
(over o2f . over f2s)
personAddressLens :: Lens Person Address
addressCityLens :: Lens Address City
personCityLens :: Lens Person City
personCityLens = personAddressLens .> addressCityLens
We just created naive implementation of lens library. Unfortunately, our lenses are not so great, real lens are different...
ghci> set (addressLens .> cityLens) "Paris" james
Person { name = "James"
, age = 28,
, address = Address { house = 42
, street = "Some Road"
, city = "Paris"
}
}
ghci> over (addressLens .> cityLens) (++"!!!!") james
Person { name = "James"
, age = 28,
, address = Address { house = 42
, street = "Some Road"
, city = "London!!!!"
}
}
It's possible to make API nicer!
ghci> james & addressLens.>cityLens .= "Paris"
Person { name = "James"
, age = 28,
, address = Address { house = 42
, street = "Some Road"
, city = "Paris"
}
}
type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t)
type Lens' s a = Lens s s a a
type Lens' s a = forall f. Functor f => (a -> f a) -> (s -> f s)
-- lens :: (s -> a) -> (s -> a -> s) -> (a -> f a) -> s -> f s
lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens get set f s = set s <$> f (get s)
newtype Const a x = Const { getConst :: a }
instance Functor (Const a) where
fmap _ (Const v) = Const v
-- view :: ((a -> Const a a) -> (s -> Const a s)) -> s -> a
view :: Lens' s a -> s -> a
view lns s = _
newtype Identity a = Identity { runIdentity :: a }
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
-- over :: ((a -> Identity a) -> s -> Identity s) -> (a -> a) -> s -> s
over :: Lens' s a -> (a -> a) -> s -> s
over lns fn s = _
-- set :: ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
set :: Lens' s a -> a -> s -> s
set l a s = runIdentity $ l (Identity . const a) s
newtype Const a x = Const { getConst :: a }
instance Functor (Const a) where
fmap _ (Const v) = Const v
-- view :: ((a -> Const a a) -> (s -> Const a s)) -> s -> a
view :: Lens' s a -> s -> a
view l s = getConst $ l Const s
newtype Identity a = Identity { runIdentity :: a }
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
-- over :: ((a -> Identity a) -> s -> Identity s) -> (a -> a) -> s -> s
over :: Lens' s a -> (a -> a) -> s -> s
over l fn s = runIdentity $ l (Identity . fn) s
view l (set l field obj) ≡ field
I. You get back what you put in:
set l (view l obj) obj ≡ obj
II. Putting back what you got doesn't change anything:
set l field (set l field obj) ≡ set l field obj
III. Setting twice is the same as setting once:
(.~) :: Lens' s a -> a -> (s -> s)
(.=) :: Lens' s a -> a -> State s ()
(%~) :: Lens' s a -> (a -> a) -> (s -> s)
(%=) :: Lens' s a -> (a -> a) -> State s ()
Operators that begin with ^ are kinds of views. The only example we've seen so far is (^.) which is view exactly.
Operators that end with ~ are like over or set. In fact,
(.~) == set and (%~) is over.
Operators that have . in them are usually somehow «basic»
Operators that have % in them usually take functions.
Operators that have = in them are just like their cousins where = is replaced by ~, but instead of taking the whole object as an argument, they apply their modifications in a State monad.
initialState :: Game
initialState = Game
{ _score = 0
, _units =
[ Unit { _health = 10
, _position = Point { _x = 3.5
, _y = 7.0 }
}
, Unit { _health = 15
, _position = Point { _x = 1.0
, _y = 1.0 }
}
, Unit { _health = 8
, _position = Point { _x = 0.0
, _y = 2.1 }
}
]
, _boss = Unit
{ _health = 100
, _position = Point { _x = 0.0
, _y = 0.0 }
}
}
Let's have some initial state for testing
score :: Lens' Game Int
score = lens _score (\game v -> game { _score = v })
units :: Lens' Game [Unit]
units = lens _units (\game v -> game { _units = v })
boss :: Lens' Game Unit
boss = lens _boss (\game v -> game { _boss = v })
health :: Lens' Unit Int
health = lens _health (\unit v -> unit { _health = v })
position :: Lens' Unit Point
position = lens _position (\unit v -> unit { _position = v })
x :: Lens' Point Double
x = lens _x (\point v -> point { _x = v })
y :: Lens' Point Double
y = lens _y (\point v -> point { _y = v })
lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
(.) :: ((Unit -> f Unit) -> (Game -> f Game))
-> ((Int -> f Int ) -> (Unit -> f Unit))
-> ((Int -> f Int ) -> (Game -> f Game))
type Lens' obj field
= forall f . Functor f => (field -> f field) -> (obj -> f obj)
boss :: Functor f => (Unit -> f Unit) -> (Game -> f Game) -- Lens' Game Unit
health :: Functor f => (Int -> f Int) -> (Unit -> f Unit) -- Lens' Unit Int
(.) :: (b -> c) -> (a -> b) -> (a -> c)
(g . f) x = g (f x)
boss . health :: ???
a ~ (Int -> f Int)
b ~ (Unit -> f Unit)
c ~ (Game -> f Game)
(.) :: Lens' Game Unit
-> Lens' Unit Int
-> Lens' Game Int
boss . health :: Lens' Game Int
ghci> initialState^.score
0
ghci> initialState^.boss.position.x
0.0
ghci> let thisBoss = initialState^.boss
ghci> thisBoss
Unit {_health = 100, _position = Point {_x = 0.0, _y = 0.0}}
ghci> thisBoss & position.x .~ 1.0
Unit {_health = 100, _position = Point {_x = 1.0, _y = 0.0}}
ghci> ("Hello", 4.5) ^. _1
"Hello"
ghci> ([1,2,3], "Hello", 4.5) ^. _1
[1,2,3]
ghci> ([1,2,3], "Hello", 4.5) ^. _3
4.5
ghci> ("Hello", 4.5) & _1 %~ (++ ", world!")
("Hello, world!",4.5)
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
strike :: StateT Game IO ()
strike = do
liftIO $ putStrLn "*shink*"
boss.health -= 10
ghci> newState <- execStateT strike initialState
*shink*
ghci> newState^.boss.health
90
fireBreath :: StateT Game IO ()
fireBreath = do
lift $ putStrLn "*rawr*"
units.traversed.health -= 3
Lens allows focusing on single element when this element exists for sure.
type Lens' obj field
= forall f . Functor f => (field -> f field) -> obj -> f obj
type Traversal s t a b
= forall f . Applicative f => (a -> f b) -> (s -> f t)
type Traversal' obj field
= forall f . Applicative f => (field -> f field) -> (obj -> f obj)
Traversal allows to focus on multiple elements
class (Functor t, Foldable t) => Traversable t where
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
traverse :: (Applicative f, Traversable t) => (a -> f b) -> t a -> f (t b)
traverse :: (Applicative f, Traversable t) => (a -> f b) -> (t a -> f (t b))
traverse :: Traversal (t a) (t b) a b
traversed :: Traversable t => Traversal' (t a) a
traversed = traverse
(.) :: Lens' a b -> Traversal' b c -> Traversal' a c
(.) :: Traversal' a b -> Lens' b c -> Traversal' a c
units :: Lens' Game [Unit]
units.traversed :: Traversal' Game Unit
units.traversed.health :: Traversal' Game Int
Traversable is composable with Lens!
ghci> :t units.traversed.health
units.traversed.health
:: Applicative f => (Int -> f Int) -> Game -> f Game
ghci> toListOf partyHP newState
[7,12,5]
ghci> initialState^..partyHP
[10,15,8]
ghci> newState^..partyHP
[7,12,5]
You can't use (^.) to extract values of Traversal. Because (^.) is for single value. And Traversal can contain multiple values. So you need to collect values into some Monoid.
type Getting r s a = (a -> Const r a) -> s -> Const r s
toListOf :: Getting (Endo [a]) s a -> s -> [a]
(^..) :: s -> Getting (Endo [a]) s a -> [a]
partyHP = units.traversed.health
around :: Point -> Double -> Traversal' Unit Unit
around center radius = filtered (\unit ->
(unit^.position.x - center^.x)^2
+ (unit^.position.y - center^.y)^2
< radius^2 )
ghci> initialState^..units.traversed.position
[Point {_x = 3.5, _y = 7.0},Point {_x = 1.0, _y = 1.0},Point {_x
= 0.0, _y = 2.1}]
ghci> newState <- execStateT (fireBreath (Point 0.5 1.5)) initialState
*rawr*
ghci> (initialState^..partyHP, newState^..partyHP)
([10,15,8],[10,12,5])
filtered Traversal
fireBreath :: Point -> StateT Game IO ()
fireBreath target = do
lift $ putStrLn "*rawr*"
units.traversed.(around target 1.0).health -= 3
partyLoc :: Traversal' Game Point
partyLoc = units.traversed.position
retreat :: StateT Game IO ()
retreat = do
lift $ putStrLn "Retreat!"
zoom partyLoc $ do
x += 10
y += 10
battle :: StateT Game IO ()
battle = do
-- Charge!
for_ ["Take that!", "and that!", "and that!"] $ \taunt -> do
liftIO $ putStrLn taunt
strike
-- The dragon awakes!
fireBreath (Point 0.5 1.5)
replicateM_ 3 $ do
-- The better part of valor
retreat
-- Boss chases them
zoom (boss.position) $ do
x += 10
y += 10
preview :: Prism' s a -> s -> Maybe a
review :: Prism' s a -> a -> s
_Left :: Prism' (Either a b) a
_Just :: Prism' (Maybe a) a
ghci> preview _Left (Left "hi")
Just "hi"
ghci> preview _Left (Right "hi")
Nothing
ghci> review _Left "hi"
Left "hi"
ghci> preview _Just (Just "hi")
Just "hi"
ghci> review _Just "hi"
Just "hi"
ghci> Left "hi" ^? _Left
Just "hi"
_Cons :: Prism' [a] (a, [a])
_Nil :: Prism' [a] ()
ghci> preview _Cons []
Nothing
ghci> preview _Cons [1,2,3]
Just (1, [2,3])
ghci> preview _Nil []
Just ()
ghci> preview _Nil [1,2,3]
Nothing
type Prism s t a b
= forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
Updating values inside type sums.
data X = MkX { _fieldX :: String }
data C = MkC1 X | MkC2 Y
data B = MkB { _fieldB :: C }
data A = MkA { _fieldA :: [B] }
foo :: A
How to update fieldX inside A only if it's X?
foo & fieldA.traversed.fieldB._MkC1.fieldX .~ "New string"
lens library is really heavy. It has a lot of dependencies. If you're writing your own library you might want to use lighter alternatives which are, happily, completely compatible with lens library!
instance MonadBaseControl IO IO where
type StM IO a = a
liftBaseWith f = f id
restoreM = return
{-# INLINABLE liftBaseWith #-}
{-# INLINABLE restoreM #-}
instance MonadBaseControl Maybe Maybe where
type StM Maybe a = a
liftBaseWith f = f id
restoreM = return
{-# INLINABLE liftBaseWith #-}
{-# INLINABLE restoreM #-}
instance MonadBaseControl [] [] where
type StM [] a = a
liftBaseWith f = f id
restoreM = return
{-# INLINABLE liftBaseWith #-}
{-# INLINABLE restoreM #-}
instance MonadBaseControl STM STM where
type StM STM a = a
liftBaseWith f = f id
restoreM = return
{-# INLINABLE liftBaseWith #-}
{-# INLINABLE restoreM #-}
Looks like boilerplate!
instance MonadBaseControl (Either e) (Either e) where
type StM (Either e) a = a
liftBaseWith f = f id
restoreM = return
{-# INLINABLE liftBaseWith #-}
{-# INLINABLE restoreM #-}
instance MonadBaseControl IO IO where
type StM IO a = a
liftBaseWith f = f id
restoreM = return
{-# INLINABLE liftBaseWith #-}
{-# INLINABLE restoreM #-}
Haskell has support for small subset of CPP preprocessor pragmas. These pragmas can be useful for different reasons, like, generate boilerplate instances.
{-# LANGUAGE CPP #-}
#define BASE(M) \
instance MonadBaseControl (M) (M) where { \
type StM (M) a = a; \
liftBaseWith f = f id; \
restoreM = return; \
{-# INLINABLE liftBaseWith #-}; \
{-# INLINABLE restoreM #-}}
And now we can easily generate instances:
BASE(IO)
BASE(Maybe)
BASE(Either e)
BASE([])
BASE((->) r)
BASE(Identity)
BASE(STM)
#if MIN_VERSION_base(4,4,0)
BASE(Strict.ST s)
BASE( ST s)
#endif
#undef BASE
CPP pragmas are easy to use. They can be ugly though sometimes unavoidable. But they are not powerful enough.
data Game = Game
{ _score :: Int
, _units :: [Unit]
, _boss :: Unit
} deriving (Show)
data Unit = Unit
{ _health :: Int
, _position :: Point
} deriving (Show)
data Point = Point
{ _x :: Double
, _y :: Double
} deriving (Show)
Step 1. Create your data types with fields prefixed by underscore.
As usual, in Haskell, you can use something complex and smart without understanding how it works. So here's quick guide how to use lens library in real life.
{-# LANGUAGE TemplateHaskell #-}
module MyModule where
import Control.Lens
data Game = Game
{ _score :: Int
, _units :: [Unit]
, _boss :: Unit
} deriving (Show)
{- And other data types -}
Step 2. Add this to your module(s):
• {-# LANGUAGE TemplateHaskell #-}
• import Control.Lens
Step 3. Use makeLenses macro to generate lenses.
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data Game = Game
{ _score :: Int
, _units :: [Unit]
, _boss :: Unit
} deriving (Show)
data Unit = Unit
{ _health :: Int
, _position :: Point
} deriving (Show)
data Point = Point
{ _x :: Double
, _y :: Double
} deriving (Show)
makeLenses ''Game
makeLenses ''Unit
makeLenses ''Point
score :: Lens' Game Int
score = lens _score (\game v -> game { _score = v })
units :: Lens' Game [Unit]
units = lens _units (\game v -> game { _units = v })
boss :: Lens' Game Unit
boss = lens _boss (\game v -> game { _boss = v })
health :: Lens' Unit Int
health = lens _health (\unit v -> unit { _health = v })
position :: Lens' Unit Point
position = lens _position (\unit v -> unit { _position = v })
x :: Lens' Point Double
x = lens _x (\point v -> point { _x = v })
y :: Lens' Point Double
y = lens _y (\point v -> point { _y = v })
makeLenses expands roughly to something like this
fst (x,_) = x -- tuples of different size in Haskell have different types!
fst3 (x,_,_) = x
fst4 (x,_,_,_) = x
print $ fst3 ("hello world", 1, 2)
print $ fst4 ("hello world", 1, 2, 3)
{-# LANGUAGE TemplateHaskell #-}
print $ $(fstN 3) ("hello world", 1, 2)
print $ $(fstN 4) ("hello world", 1, 2, 3)
{-# LANGUAGE TemplateHaskell #-}
module FstN where
import Language.Haskell.TH
fstN :: Int -> Q Exp
fstN n = do
x <- newName "x"
pure $ LamE [TupP $ VarP x : replicate (n - 1) WildP] (VarE x)
Everything is not okay with such code
LamE [TupP [VarP x_1,WildP,WildP]] (VarE x_1) -- AST of lambda \(x,_,_) -> x
ghci> :t (VarP, VarE)
(VarP, VarE) :: (Name -> Pat, Name -> Exp)
ghci> :t newName
newName :: String -> Q Name
ghci> :t (varE, varP)
(varE, varP) :: (Name -> Q Exp, Name -> Q Pat)
import Language.Haskell.TH
fst3 = do
x <- newName "x"
pure $ LamE [TupP [VarP x, WildP, WildP]] (VarE x)
Corresponds to this expression:
\(x,_,_) -> x
fst3 is a macro. Use $(fst3) to expand macro. $() is called splice.
ghci> :t fst3
fst3 :: Q Exp -- Q is some monad
ghci> :t $(fst3)
$(fst3) :: (t2, t1, t) -> t2
ghci> $(fst3) ("hello", 10, True)
"hello"
import Language.Haskell.TH
fst3 = do
x <- newName "x"
lamE [tupP [varP x, wildP, wildP]] (varE x)
fst4 :: Q Exp
fst4 = do
x <- newName "x"
lamE [tupP [varP x, wildP, wildP, wildP]] (varE x)
fstN :: Int -- ^ take tuple «length» as argument
-> Q Exp
fstN n = do
x <- newName "x"
lamE [tupP $ varP x : replicate (n - 1) wildP] (varE x)
fst5 :: Q Exp
fst5 = do
x <- newName "x"
lamE [tupP [varP x, wildP, wildP, wildP, wildP]] (varE x)
You got the idea :)
The [| … |] notation is the quasi quotes for Haskell expression.
The contents within quasi quotes will be parsed at compile time.
There exist several GHC parsers, but you can define your own!
When you do [| \x -> x |], the string inside the brackets is parsed by the Haskell compiler as expression and gives you back the AST (Abstract Syntax Tree) of this expression.
ghci> :set -XQuasiQuotes
ghci> import Language.Haskell.TH (runQ)
ghci> runQ [| \x -> x |]
LamE [ VarP x_0 ] ( VarE x_0 )
ghci> runQ [| data A = B Int |]
<interactive>:11:9: error: parse error on input ‘data’
ghci> runQ [d| data A = B Int |] -- «d» is for declaration
[ DataD [] A_1 [] Nothing
[ NormalC B_2
[
( Bang NoSourceUnpackedness NoSourceStrictness
, ConT GHC.Types.Int
)
]
] []
]
{-# LANGUAGE QuasiQuotes #-}
import Data.Text (Text, pack)
import NeatInterpolation (text)
example :: Text -> Int -> Text
example prefix n =
let nText = pack $ show n in
[text|
Number $prefix : $nText is:
- even: ${even n}
|]
ghci> :set -XOverloadedStrings
ghci> import qualified Data.Text.IO as TextIO
ghci> TextIO.putStrLn $ example "number" 5
Number number : 5 is:
- even: ${even n}
Not so neat as you want... But still.
bar :: String
bar = [qc| Well {"hello" ++ " there"} {6 * 7} |]
absdir :: QuasiQuoter
homeDir :: Path Abs Dir
homeDir = [absdir|/home/chris/|]
$ ghci -ddump-splices -XTemplateHaskell
Prelude> $([| 1 + 2 ^ 3 * 4 |])
<interactive>:1:3-21: Splicing expression
[| 1 + 2 ^ 3 * 4 |] ======> (1 + ((2 ^ 3) * 4))
33
{-# LANGUAGE TemplateHaskell #-}
module CustomShow where
import Language.Haskell.TH
emptyShow :: Name -> Q [Dec]
emptyShow name = [d|instance Show $(conT name) where show _ = ""|]
{-# LANGUAGE TemplateHaskell #-}
import CustomShow (emptyShow)
data MyData = MyData
{ foo :: String
, bar :: Int
}
emptyShow ''MyData -- ''MyData == mkName "MyData"
-- ^ Expands to: instance Show MyData where show _ = ""
main = print $ MyData { foo = "bar", bar = 5 }
import Data.FileEmbed (embedFile, makeRelativeToProject)
compileConfig :: CompileConfig
compileConfig =
$(do let file = $(embedFile =<< makeRelativeToProject "constants.yaml")
case decodeEither file of
Left a -> fail (toString a)
Right x -> lift (x :: CompileConfig))
k :: Integral a => a
k = fromIntegral . ccK $ compileConfig
genesisN :: Integral i => i
genesisN = fromIntegral . ccGenesisN $ compileConfig
import qualified Data.Aeson.TH as A
import Language.Haskell.TH.Syntax (Lift)
import Serokell.Aeson.Options (defaultOptions)
data CompileConfig = CompileConfig
{ ccK :: !Int
, ccGenesisN :: !Int
} deriving (Show, Lift)
A.deriveFromJSON defaultOptions ''CompileConfig
k: 2
genesisN: 12
Automatic deriving to parse from file
constants.yaml