upgrade to 0.8; added Opinion-section
This commit is contained in:
56
content/Coding/Haskell/Advantages.md
Normal file
56
content/Coding/Haskell/Advantages.md
Normal file
@ -0,0 +1,56 @@
|
||||
# Talks und Posts zu Haskell
|
||||
|
||||
Gründe Haskell zu nutzen und wo Vorteile liegen.
|
||||
|
||||
## Talks
|
||||
|
||||
### Simon Peyton Jones
|
||||
|
||||
- [The Future is parallel](https://www.youtube.com/watch?v=hlyQjK1qjw8)
|
||||
- [Lenses](https://skillsmatter.com/skillscasts/4251-lenses-compositional-data-access-and-manipulation)
|
||||
(Registrierung nötig - kostenfrei), siehe auch: [[Lenses]]#
|
||||
|
||||
### Others
|
||||
|
||||
- [Running a Startup on Haskell](https://www.youtube.com/watch?v=ZR3Jirqk6W8)
|
||||
- [We're doing it all wrong](https://www.youtube.com/watch?v=TS1lpKBMkgg) - A
|
||||
Long-Term Scala-Compiler-Developer quits his job after years and tells why
|
||||
Scala is a mess.
|
||||
- [Monads explained in Javascript](https://www.youtube.com/watch?v=b0EF0VTs9Dc)
|
||||
- [Vinyl Records](http://vimeo.com/95694918) with [Slides](https://github.com/VinylRecords/BayHac2014-Talk)
|
||||
- [Thinking with Laziness](http://begriffs.com/posts/2015-06-17-thinking-with-laziness.html)
|
||||
|
||||
## Bücher/Paper
|
||||
|
||||
### Simon Peyton Jones
|
||||
|
||||
- [Papers on STM](https://research.microsoft.com/en-us/um/people/simonpj/papers/stm/)
|
||||
- [Tackling the awkward squad](https://research.microsoft.com/en-us/um/people/simonpj/papers/marktoberdorf/)
|
||||
|
||||
### Others
|
||||
|
||||
- [Parallel and Concurrent Programming in Haskell](http://chimera.labs.oreilly.com/books/1230000000929/pr01.html)
|
||||
- [Slides of a Quickcheck-Talk](http://scholar.google.de/scholar?cluster=7602244452224287116&hl=de&as_sdt=0,5)
|
||||
- [Understanding F-Algebras](https://www.fpcomplete.com/user/bartosz/understanding-algebras)
|
||||
schöne Erklärung. Man könnte danach anfangen den [[Morphisms|Morphismen-zoo]]#
|
||||
zu verstehen...
|
||||
- [Monad Transformers](https://github.com/kqr/gists/blob/master/articles/gentle-introduction-monad-transformers.md)
|
||||
|
||||
## Funny Talks
|
||||
|
||||
- [Tom LaGatta on Category-Theory](https://www.youtube.com/watch?v=o6L6XeNdd_k)
|
||||
- [Unifying Structured Recursion Schemes](https://www.youtube.com/watch?v=9EGYSb9vov8)
|
||||
aka. [[Morphisms|The Morphism-Zoo]]
|
||||
- [Hole-Driven-Development Teaser (Enthusiasticon, raichoo)](https://www.youtube.com/watch?v=IRGKkiGG5CY)
|
||||
|
||||
## Unsorted/Unseen
|
||||
|
||||
- [Functional Reactive Programming](http://insights.pwning.de/_edit/Haskell/Why_Haskell_is_superior)
|
||||
- [Diagrams: Declarative Vector Graphics in Haskell](http://vimeo.com/84104226)
|
||||
- [Lenses, Folds & Traversels by Edward Kmett](https://www.youtube.com/watch?v=cefnmjtAolY)
|
||||
- [Discrimination is Wrong by Edward Kmett](https://www.youtube.com/watch?v=cB8DapKQz-I&list=WL&index=10)
|
||||
|
||||
## Tutorials
|
||||
|
||||
- [Haskell fast and hard](https://www.fpcomplete.com/school/starting-with-haskell/haskell-fast-hard/haskell-fast-hard-part-1)
|
||||
- [Counterexamples for Typeclasses](http://blog.functorial.com/posts/2015-12-06-Counterexamples.html)
|
8
content/Coding/Haskell/Code Snippets.md
Normal file
8
content/Coding/Haskell/Code Snippets.md
Normal file
@ -0,0 +1,8 @@
|
||||
# Code-Snippets
|
||||
|
||||
Hier schreiben wir ein paar Code-Highlights auf, die uns begegnet sind.
|
||||
|
||||
```query
|
||||
path:./*
|
||||
```
|
||||
|
165
content/Coding/Haskell/Code Snippets/Monoid.md
Normal file
165
content/Coding/Haskell/Code Snippets/Monoid.md
Normal file
@ -0,0 +1,165 @@
|
||||
# Monoid? Da war doch was...
|
||||
|
||||
Stellen wir uns vor, dass wir eine Funktion schreiben, die einen String bekommt (mehrere Lines mit ACSII-Text) und dieses Wort-für-Wort rückwärts ausgeben soll. Das ist ein einfacher Einzeiler:
|
||||
|
||||
~~~ { .haskell }
|
||||
module Main where
|
||||
|
||||
import System.Environment (getArgs)
|
||||
import Data.Monoid (mconcat)
|
||||
import Data.Functor ((<$>))
|
||||
|
||||
main = do
|
||||
ls <- readFile =<< head <$> getArgs
|
||||
mconcat <$> mapM (putStrLn . unwords . reverse . words) (lines ls) --die eigentliche Funktion, ls ist das argument.
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Was passiert hier an Vodoo? Und was machen die ganzen wilden Zeichen da?
|
||||
|
||||
Gehen wir die Main zeilenweise durch:
|
||||
Wir lesen die Datei, die im ersten Kommandozeilen-Argument gegeben wird. getArgs hat folgende Signatur:
|
||||
|
||||
```haskell
|
||||
getArgs :: IO [String]
|
||||
```
|
||||
|
||||
Wir bekommen als eine Liste der Argumente. Wir wollen nur das erste. Also machen wir head getArgs. Allerdings fliegt uns dann ein Fehler. head sieht nämlich so aus:
|
||||
|
||||
```haskell
|
||||
head :: [a] -> a
|
||||
```
|
||||
|
||||
Irgendwie müssen wird as **in** das IO bekommen. Hierzu gibt es fmap. Somit ist
|
||||
|
||||
```haskell
|
||||
fmap head :: IO [a] -> IO a
|
||||
```
|
||||
|
||||
Ein inline-Alias (um die Funktion links und das Argument rechts zu schreiben und sich ne Menge Klammern zu sparen) ist <$>. Somit ist schlussendlich der Inhalt der Datei aus dem ersten Argument (lazy) in ls.
|
||||
|
||||
Eine andere Möglichkeit sich das (in diesem Fall) zu merken, bzw. drauf zu kommen ist, dass [] AUCH ein Funktor (sogar eine Monade) ist. Man könnte das also auch so schreiben:
|
||||
|
||||
```haskell
|
||||
head :: [] a -> a
|
||||
head :: Functor f => [] (f a) -> f a -- das "a" geschickt ersetzt zur Verdeutlichung
|
||||
getArgs :: IO [] String
|
||||
fmap head :: Functor f => f [] a -> f a
|
||||
```
|
||||
|
||||
fmap "packt" die Funktion quasi 1 Umgebung (Funktor, Monade, ..) weiter rein - Sei es nun in Maybe, Either oder irgendwas anderes.
|
||||
|
||||
Alternatives (ausführliches) Beispiel am Ende.
|
||||
|
||||
Wenn wir uns die Signatur ansehen, dann haben wir nun
|
||||
|
||||
```haskell
|
||||
head <$> getArgs :: IO String
|
||||
```
|
||||
|
||||
readFile will aber nun ein String haben. Man kann nun
|
||||
|
||||
```haskell
|
||||
f <- head <$> getArgs
|
||||
ls <- readFile f
|
||||
```
|
||||
|
||||
kann man auch "inline" mit =<< die Sachen "auspacken".
|
||||
|
||||
Die 2. Zeile lesen wir nun einfach "von hinten", wie man das meistens tun sollte. Hier ist ein
|
||||
|
||||
```haskell
|
||||
lines ls :: [String]
|
||||
```
|
||||
|
||||
was uns den Inhalt der Datei zeilenweise gibt. Mit jeder Zeile möchten wir nun folgendes machen:
|
||||
|
||||
1. nach Wörtern trennen (words)
|
||||
2. Wörter in der reihenfolge umkehren (reverse)
|
||||
3. Wörter wider zu einer Zeile zusammensetzen (unwords)
|
||||
4. diese Zeile ausgeben (putStrLn)
|
||||
|
||||
Wenn wir uns die Signatur ansehen:
|
||||
|
||||
```haskell
|
||||
(putStrLn . unwords . reverse . words) :: String -> IO ()
|
||||
```
|
||||
|
||||
Das mag im ersten Moment verwirren, daher noch die Signaturen der Einzelfunktionen:
|
||||
|
||||
```haskell
|
||||
words :: String -> [String]
|
||||
reverse :: [a] -> [a]
|
||||
unwords :: [String] -> String
|
||||
putStrLn :: String -> IO ()
|
||||
```
|
||||
|
||||
Da wir am Ende in der IO-Monade landen müssen wir das auf unsere Zeilen mit mapM statt map anwenden. Dies sorgt auch dafür, dass die Liste der reihe nach durchgegangen wird. mapM mit unserer Funktion schaut dann so aus:
|
||||
|
||||
```haskell
|
||||
mapM (putStrLn . unwords . reverse . words) :: [String] -> [IO ()]
|
||||
```
|
||||
|
||||
eek! Das [IO ()] sieht ekelig aus. Wir haben eine Liste von IO-gar nichts. Das können wir eigentlich entsorgen. Da wir innerhalb der main-Funktion in einer IO-Monade sind, wollen wir IO () anstatt [IO ()] zurück haben.
|
||||
|
||||
Wenn wir uns jetzt erinnern, dass [] auch nur eine Monade ist und dass jede Monade ein Monoid ist, dann ist die Lösung einfach. Monoide haben eine "append"-funktion (mappend oder (<>) genannt). Wenn wir "nichts" an "nichts" anhängen, dann erhalten wir .... *Trommelwirbel* "nichts"! Wir müssen die [IO ()]-Liste also "nur noch" mit mappend falten. Hierzu gibt es schon eine vorgefertigte Funktion:
|
||||
|
||||
```haskell
|
||||
mconcat :: [a] -> a
|
||||
mconcat = foldr mappend mempty
|
||||
```
|
||||
|
||||
Was genau die gewünschte Faltung macht. Wir müssen nun wieder fmap nehmen, da wir die Liste selbst falten wollen - und nicht map, welches auf den IO () innerhalb der Liste arbeiten würde. Durch die Faltung fällt die Liste nun auf IO () zusammen.
|
||||
|
||||
Viel Voodoo in wenig Code, aber wenn man sich dran gewöhnt hat, sind Monaden in Monaden auch nicht schlimm. Man muss sich immer nur richtig "rein" fmap'en.
|
||||
|
||||
---
|
||||
|
||||
Kleinen Tipp gab es noch: mapM_ macht genau das, was oben mit mconcat erreicht werden sollte. Somit kann man auch
|
||||
|
||||
```haskell
|
||||
mapM_ (putStrLn . unwords . reverse . words) (lines ls)
|
||||
```
|
||||
|
||||
schreiben. Ich hab es aber mal wegen der klarheit oben so gelassen.
|
||||
|
||||
## Alternatives fmap-Beispiel
|
||||
|
||||
Nehmen wir als alternatives Beispiel mal an:
|
||||
|
||||
```haskell
|
||||
a :: IO Maybe State t
|
||||
```
|
||||
|
||||
Um Funktionen vom Typ
|
||||
|
||||
```haskell
|
||||
f :: IO a -> IO a
|
||||
f a -- valide
|
||||
```
|
||||
|
||||
zu nehmen, brauchen wir nichts machen. Bei
|
||||
|
||||
```haskell
|
||||
f' :: Maybe a -> Maybe a
|
||||
```
|
||||
|
||||
brauchen wir 1 fmap, also ein
|
||||
|
||||
```haskell
|
||||
f' a -- error
|
||||
f' <$> a
|
||||
```
|
||||
|
||||
um eine Funktion
|
||||
|
||||
```haskell
|
||||
f'' :: State t -> State t
|
||||
```
|
||||
|
||||
zu benutzen folglich:
|
||||
|
||||
```haskell
|
||||
f'' a -- error
|
||||
f'' <$> a -- error
|
||||
fmap f'' <$> a
|
||||
```
|
264
content/Coding/Haskell/Code Snippets/Morphisms.md
Normal file
264
content/Coding/Haskell/Code Snippets/Morphisms.md
Normal file
@ -0,0 +1,264 @@
|
||||
# *-Morpisms
|
||||
|
||||
**Backup eines Blogposts eines Kommilitonen:**
|
||||
|
||||
This weekend I spend some time on Morphisms.
|
||||
|
||||
Knowing that this might sound daunting to many
|
||||
dabbling Haskellers (like I am), I decided to
|
||||
write a real short MergeSort hylomorphism quickstarter.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
For those who need a refresher: MergeSort works by creating
|
||||
a balanced binary tree from the input list and directly
|
||||
collapsing it back into itself while treating the children
|
||||
as sorted lists and merging these with an O(n) algorithm.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
First the usual prelude:
|
||||
|
||||
```haskell
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
import Data.Functor.Foldable
|
||||
import Data.List (splitAt, unfoldr)
|
||||
```
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
We will use a binary tree like this. Note that
|
||||
there is no explicit recursion used, but `NodeF` has
|
||||
two *holes*. These will eventually filled later.
|
||||
|
||||
```haskell
|
||||
data TreeF c f = EmptyF | LeafF c | NodeF f f
|
||||
deriving (Eq, Show, Functor)
|
||||
```
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Aside: We could use this as a *normal* binary tree by
|
||||
wrapping it in `Fix`: `type Tree a = Fix (TreeF a)`
|
||||
But this would require us to write our tree like
|
||||
`Fix (NodeF (Fix (LeafF 'l')) (Fix (LeafF 'r')))`
|
||||
which would get tedious fast. Luckily Edward build
|
||||
a much better way to do this into *recursion-schemes*.
|
||||
I will touch on this later.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Without further ado we start to write a Coalgebra,
|
||||
which in my book is just a scary name for
|
||||
"function that is used to construct datastructures".
|
||||
|
||||
```haskell
|
||||
unflatten :: [a] -> TreeF a [a]
|
||||
unflatten ( []) = EmptyF
|
||||
unflatten (x:[]) = LeafF x
|
||||
unflatten ( xs) = NodeF l r where (l,r) = splitAt (length xs `div` 2) xs
|
||||
```
|
||||
|
||||
From the type signature it's immediately obvious,
|
||||
that we take a list of 'a's and use it to create
|
||||
a part of our tree.
|
||||
|
||||
The nice thing is that due to the fact that we
|
||||
haven't commited to a type in our tree nodes
|
||||
we can just put lists in there.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Aside: At this point we could use this Coalgebra to
|
||||
construct (unsorted) binary trees from lists:
|
||||
|
||||
```haskell
|
||||
example1 = ana unflatten [1,3] == Fix (NodeF (Fix (LeafF 1)) (Fix (LeafF 3)))
|
||||
```
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
On to our sorting, tree-collapsing Algebra.
|
||||
Which again is just a creepy word for
|
||||
"function that is used to deconstruct datastructures".
|
||||
|
||||
The function `mergeList` is defined below and
|
||||
just merges two sorted lists into one sorted list
|
||||
in O(n), I would probably take this from the `ordlist`
|
||||
package if I were to implement this *for real*.
|
||||
|
||||
Again we see that we can just construct our
|
||||
sorted output list from a `TreeF` that
|
||||
apparently contains just lists.
|
||||
|
||||
```haskell
|
||||
flatten :: Ord a => TreeF a [a] -> [a]
|
||||
flatten EmptyF = []
|
||||
flatten (LeafF c) = [c]
|
||||
flatten (NodeF l r) = mergeLists l r
|
||||
```
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Aside: We could use a Coalgebra to deconstruct trees:
|
||||
|
||||
```haskell
|
||||
example2 = cata flatten (Fix (NodeF (Fix (LeafF 3)) (Fix (LeafF 1)))) == [1,3]
|
||||
```
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Now we just combine the Coalgebra and the Algebra
|
||||
with one from the functions from Edwards `recursion-schemes`
|
||||
library:
|
||||
|
||||
```haskell
|
||||
mergeSort :: Ord a => [a] -> [a]
|
||||
mergeSort = hylo flatten unflatten
|
||||
|
||||
example3 = mergeSort [5,2,7,9,1,4] == [1,2,4,5,7,9]
|
||||
```
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
What have we gained?
|
||||
|
||||
We have implemented a MergeSort variant in 9 lines of
|
||||
code, not counting the `mergeLists` function below.
|
||||
Not bad, but [this implementation](http://en.literateprograms.org/Merge_sort_(Haskell))
|
||||
is not much longer.
|
||||
|
||||
On the other hand the morphism based implementation
|
||||
cleanly describes what happens during construction
|
||||
and deconstruction of our intermediate structure.
|
||||
|
||||
My guess is that, as soon as the algortihms get more
|
||||
complex, this will really make a difference.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
At this point I wasn't sure if this was useful or
|
||||
remotely applicable. Telling someone "I spend a
|
||||
whole weekend learning about Hylomorphism" isn't
|
||||
something the cool developer kids do.
|
||||
|
||||
It appeared to me that maybe I should have a look
|
||||
at the Core to see what the compiler finally comes
|
||||
up with (edited for brevity):
|
||||
|
||||
```haskell
|
||||
mergeSort :: [Integer] -> [Integer]
|
||||
mergeSort =
|
||||
\ (x :: [Integer]) ->
|
||||
case x of wild {
|
||||
[] -> [];
|
||||
: x1 ds ->
|
||||
case ds of _ {
|
||||
[] -> : x1 ([]);
|
||||
: ipv ipv1 ->
|
||||
unfoldr
|
||||
lvl9
|
||||
(let {
|
||||
p :: ([Integer], [Integer])
|
||||
p =
|
||||
case $wlenAcc wild 0 of ww { __DEFAULT ->
|
||||
case divInt# ww 2 of ww4 { __DEFAULT ->
|
||||
case tagToEnum# (<# ww4 0) of _ {
|
||||
False ->
|
||||
case $wsplitAt# ww4 wild of _ { (# ww2, ww3 #) -> (ww2, ww3) };
|
||||
True -> ([], wild)
|
||||
}
|
||||
}
|
||||
} } in
|
||||
(case p of _ { (x2, ds1) -> mergeSort x2 },
|
||||
case p of _ { (ds1, y) -> mergeSort y }))
|
||||
}
|
||||
}
|
||||
end Rec }
|
||||
```
|
||||
|
||||
While I am not really competent in reading Core and
|
||||
this is actually the first time I bothered to try,
|
||||
it is immediately obvious that there is no trace
|
||||
of any intermediate tree structure.
|
||||
|
||||
This is when it struck me. I was dazzled and amazed.
|
||||
And am still. Although we are writing our algorithm
|
||||
as if we are working on a real tree structure the
|
||||
library and the compiler are able to just remove
|
||||
the whole intermediate step.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Aftermath:
|
||||
|
||||
In the beginning I promised a way to work on
|
||||
non-functor data structures. Actually that
|
||||
was how I began to work with the `recursion-schemes`
|
||||
library.
|
||||
|
||||
We are able to create a 'normal' version of our tree
|
||||
from above:
|
||||
|
||||
```haskell
|
||||
data Tree c = Empty | Leaf c | Node (Tree c) (Tree c)
|
||||
deriving (Eq, Show)
|
||||
```
|
||||
|
||||
But we can not use this directly with our (Co-)Algebras.
|
||||
Luckily Edward build a little bit of type magic into
|
||||
the library:
|
||||
|
||||
```haskell
|
||||
type instance Base (Tree c) = (TreeF c)
|
||||
|
||||
instance Unfoldable (Tree c) where
|
||||
embed EmptyF = Empty
|
||||
embed (LeafF c) = Leaf c
|
||||
embed (NodeF l r) = Node l r
|
||||
|
||||
instance Foldable (Tree c) where
|
||||
project Empty = EmptyF
|
||||
project (Leaf c) = LeafF c
|
||||
project (Node l r) = NodeF l r
|
||||
```
|
||||
|
||||
Without going into detail by doing this we establish
|
||||
a relationship between `Tree` and `TreeF` and teach
|
||||
the compiler how to translate between these types.
|
||||
|
||||
Now we can use our Alebra on our non functor type:
|
||||
|
||||
```haskell
|
||||
example4 = cata flatten (Node (Leaf 'l') (Leaf 'r')) == "lr"
|
||||
```
|
||||
|
||||
The great thing about this is that, looking at the
|
||||
Core output again, there is no traces of the `TreeF`
|
||||
structure to be found. As far as I can tell, the
|
||||
algorithm is working directly on our `Tree` type.
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Literature:
|
||||
|
||||
- [Understanding F-Algebras](https://www.fpcomplete.com/user/bartosz/understanding-algebras)
|
||||
- [Recursion Schemes by Example](http://www.timphilipwilliams.com/slides.html)
|
||||
- [Recursion Schemes: A Field Guide](http://comonad.com/reader/2009/recursion-schemes/)
|
||||
- [This StackOverflow question](http://stackoverflow.com/questions/6941904/recursion-schemes-for-dummies)
|
||||
|
||||
----------------------------------------------------------
|
||||
|
||||
Appendix:
|
||||
|
||||
```haskell
|
||||
mergeLists :: Ord a => [a] -> [a] -> [a]
|
||||
mergeLists = curry $ unfoldr c where
|
||||
c ([], []) = Nothing
|
||||
c ([], y:ys) = Just (y, ([], ys))
|
||||
c (x:xs, []) = Just (x, (xs, []))
|
||||
c (x:xs, y:ys) | x <= y = Just (x, (xs, y:ys))
|
||||
| x > y = Just (y, (x:xs, ys))
|
||||
```
|
66
content/Coding/Haskell/FFPiH.md
Normal file
66
content/Coding/Haskell/FFPiH.md
Normal file
@ -0,0 +1,66 @@
|
||||
# Fortgeschrittene funktionale Programmierung in Haskell
|
||||
|
||||
FFPiH ist eine Vorlesung, die ich zusammen mit einem Kommilitonen im Sommer 2015
|
||||
erstmals erstellt und gehalten haben.
|
||||
|
||||
Insgesamt haben wir die Vorlesung 3x gehalten, wobei von der ersten zur zweiten
|
||||
Iteration der Inhalt massiv überarbeitet wurde und bei der Iteration von der
|
||||
zweiten zur dritten Vorlesung die Übungen komplett neu erstellt wurden.
|
||||
|
||||
Die gesamten Übungen sind unter anderem in der FFPiH-Organisation in meinem
|
||||
gitea hinterlegt:
|
||||
[https://gitea.dresselhaus.cloud/FFPiH](https://gitea.dresselhaus.cloud/FFPiH)
|
||||
|
||||
Einige der aktualisierten Übungen sind privat geschaltet, da diese iterativ
|
||||
aufeinander aufbauen und jeweils die Musterlösung der vorherigen enthalten.
|
||||
|
||||
## Aufbau der Vorlesung
|
||||
|
||||
Vorausgesetzt wurde, dass die Studierenden das erste Semester abgeschlossen
|
||||
hatten und somit bereits leichte Grundlagen in Haskell kannten (aber z.b. Dinge
|
||||
wie Functor/Applicative/Monad noch nicht *wirklich* erklärt bekommen haben).
|
||||
|
||||
Stück für Stück werden die Studis dann zunächst in abstrakte Konstrukte
|
||||
eingeführt, aber diese werden dann schnell in die Praxis umgesetzt. Etwa mit dem
|
||||
Schreiben eines eigenen Parsers.
|
||||
|
||||
Schlussendlich gibt es dann einen "Rundumschlag" durch die gesamte Informatik.
|
||||
Erstellung eines Spieles (auf basis einer kleinen Grundlage), erstellung von
|
||||
WebApps mit Yesod, Parallelisierung und Nebenläufigkeit für rechenintensive
|
||||
Anwendungen inkl. synchronisation mittels STM.
|
||||
|
||||
Optional gab es weitere Übungen zu dingen wie "verteiltes Rechnen".
|
||||
|
||||
Ziel hierbei war nicht, diese ganzen Themen in der Tiefe beizubringen, sondern
|
||||
aufzuzeigen, wie sie sehr schnell abstrakte Konstrukte, die ihnen ggf. 3 Semester
|
||||
später erst begegnen bugfrei benutzen können, da Haskell hier in sehr vielen
|
||||
Fällen einfach nur die "richtige" Lösung kompilieren lässt und alle gängigen
|
||||
Fallen schlicht ausschließt. Beispiel ist z.b. STM innerhalb von STM, Mischen
|
||||
von DB-Monade, Handler-Monade und Template-Engine in Yesod, Process () statt IO
|
||||
() in der Nutzung von CloudHaskell, etc. pp.
|
||||
|
||||
## Studentisches Feedback
|
||||
|
||||
Sehr gutes Feedback von den Studenten bekamen wir insbesondere für Übungen wie:
|
||||
|
||||
[Übung 2, Aufgabe 2](https://gitea.dresselhaus.cloud/FFPiH/uebung2017_2/src/branch/master/src/Aufgabe2.hs),
|
||||
weil hier durch "einfaches" umformen hin zu Abstraktionen und mit den Regeln dieser
|
||||
im ersten Fall die Laufzeit (vor Compileroptimierungen) von O(n²) auf O(0) ändert.
|
||||
|
||||
[Übung 4](https://gitea.dresselhaus.cloud/FFPiH/uebung2017-4), welche ein
|
||||
komplett fertigen (sehr rudimentären und simplen) Dungeon-Crawler bereitstellt,
|
||||
der "nur" 1-2 bugs hat und "wie ein echtes Projekt" erweitert werden muss.
|
||||
Diese Übung hat sich dann über 4 weitere Übungen gestreckt, wobei folgende
|
||||
Aufgaben gelöst werden müssen:
|
||||
|
||||
- Einarbeitung in QuickCheck zur Behebung eines Bugs im Test
|
||||
- Umschreiben von explizitem Argument-Passing hin zu Monad-Transformers mit
|
||||
stateful [[Lenses|lenses]]#
|
||||
- Continuation-Basierendes Event-System
|
||||
- Hinzufügen eines Parsers für Level, Items & deren Effekte und
|
||||
implementation dieser
|
||||
- Ändern des GUI-Parts von CLI auf 2D GL mittels gloss
|
||||
- Ändern von `StateT World` auf `RWST GameConfig Log World` und somit nutzen von
|
||||
individuellen Konfigurationen für z.b. Keybindings
|
||||
|
||||
|
562
content/Coding/Haskell/Lenses.md
Normal file
562
content/Coding/Haskell/Lenses.md
Normal file
@ -0,0 +1,562 @@
|
||||
# Lenses
|
||||
|
||||
## Wofür brauchen wir das überhaupt?
|
||||
|
||||
Die Idee dahinter ist, dass man Zugriffsabstraktionen über Daten verknüpfen
|
||||
kann. Als einfachen Datenstruktur kann man einen Record mit der entsprechenden
|
||||
Syntax nehmen.
|
||||
|
||||
### Beispiel
|
||||
|
||||
~~~ { .haskell }
|
||||
data Person = P { name :: String
|
||||
, addr :: Address
|
||||
, salary :: Int }
|
||||
data Address = A { road :: String
|
||||
, city :: String
|
||||
, postcode :: String }
|
||||
-- autogeneriert unten anderem: addr :: Person -> Address
|
||||
|
||||
setName :: String -> Person -> Person
|
||||
setName n p = p { name = n } --record update notation
|
||||
|
||||
setPostcode :: String -> Person -> Person
|
||||
setPostcode pc p
|
||||
= p { addr = addr p { postcode = pc } }
|
||||
-- update of a record inside a record
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
### Probleme
|
||||
|
||||
Probleme mit diesem Code:
|
||||
|
||||
- für 1-Dimensionale Felder ist die record-syntax ok.
|
||||
- tiefere Ebenen nur umständlich zu erreichen
|
||||
- eigentlich wollen wir nur pe in p setzen, müssen aber über addr etc. gehen.
|
||||
- wir brauchen wissen über die "Zwischenstrukturen", an denen wir nicht
|
||||
interessiert sind
|
||||
|
||||
### Was wir gern hätten
|
||||
|
||||
~~~ { .haskell }
|
||||
data Person = P { name :: String
|
||||
, addr :: Address
|
||||
, salary :: Int }
|
||||
-- a lens for each field
|
||||
lname :: Lens' Person String
|
||||
laddr :: Lens' Person Adress
|
||||
lsalary :: Lens' Person Int
|
||||
-- getter/setter for them
|
||||
view :: Lens' s a -> s -> a
|
||||
set :: Lens' s a -> a -> s -> s
|
||||
-- lens-composition
|
||||
composeL :: Lens' s1 s2 -> Lens s2 a -> Lens' s1 a
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
### Wie uns das hilft
|
||||
|
||||
Mit diesen Dingen (wenn wir sie hätten) könnte man dann
|
||||
|
||||
~~~ { .haskell }
|
||||
data Person = P { name :: String
|
||||
, addr :: Address
|
||||
, salary :: Int }
|
||||
data Address = A { road :: String
|
||||
, city :: String
|
||||
, postcode :: String }
|
||||
setPostcode :: String -> Person -> Person
|
||||
setPostcode pc p
|
||||
= set (laddr `composeL` lpostcode) pc p
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
machen und wäre fertig.
|
||||
|
||||
## Trivialer Ansatz
|
||||
|
||||
### Getter/Setter als Lens-Methoden
|
||||
|
||||
~~~ { .haskell }
|
||||
data LensR s a = L { viewR :: s -> a
|
||||
, setR :: a -> s -> s }
|
||||
|
||||
composeL (L v1 u1) (L v2 u2)
|
||||
= L (\s -> v2 (v1 s))
|
||||
(\a s -> u1 (u2 a (v1 s)) s)
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
### Wieso ist das schlecht?
|
||||
|
||||
- extrem ineffizient
|
||||
|
||||
Auslesen traversiert die Datenstruktur, dann wird die Funktion angewendet und
|
||||
zum setzen wird die Datenstruktur erneut traversiert:
|
||||
|
||||
~~~ { .haskell }
|
||||
over :: LensR s a -> (a -> a) -> s -> s
|
||||
over ln f s = setR l (f (viewR l s)) s
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
- Lösung: modify-funktion hinzufügen
|
||||
|
||||
~~~ { .haskell }
|
||||
data LensR s a
|
||||
= L { viewR :: s -> a
|
||||
, setR :: a -> s -> s
|
||||
, mod :: (a->a) -> s -> s
|
||||
, modM :: (a->Maybe a) -> s -> Maybe s
|
||||
, modIO :: (a->IO a) -> s -> IO s }
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Neues Problem: Für jeden Spezialfall muss die Lens erweitert werden.
|
||||
|
||||
### Something in common
|
||||
|
||||
Man kann alle Monaden abstrahieren. Functor reicht schon:
|
||||
|
||||
~~~ { .haskell }
|
||||
data LensR s a
|
||||
= L { viewR :: s -> a
|
||||
, setR :: a -> s -> s
|
||||
, mod :: (a->a) -> s -> s
|
||||
, modF :: Functor f => (a->f a) -> s -> f s }
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Idee: Die 3 darüberliegenden durch modF ausdrücken.
|
||||
|
||||
### Typ einer Lens
|
||||
|
||||
Wenn man das berücksichtigt, dann hat einen Lens folgenden Typ:
|
||||
|
||||
~~~ {.haskell}
|
||||
type Lens' s a = forall f. Functor f
|
||||
=> (a -> f a) -> s -> f s
|
||||
~~~
|
||||
|
||||
Allerdings haben wir dann noch unseren getter/setter:
|
||||
|
||||
~~~ {.haskell}
|
||||
data LensR s a = L { viewR :: s -> a
|
||||
, setR :: a -> s -> s }
|
||||
~~~
|
||||
|
||||
Stellt sich raus: Die sind isomorph! Auch wenn die von den Typen her komplett
|
||||
anders aussehen.
|
||||
|
||||
## Benutzen einer Lens als Setter
|
||||
|
||||
~~~ { .haskell }
|
||||
set :: Lens' s a -> (a -> s -> s)
|
||||
set ln a s = --...umm...
|
||||
--:t ln => (a -> f a) -> s -> f s
|
||||
-- => get s out of f s to return it
|
||||
~~~~~~
|
||||
|
||||
Wir können für f einfach die "Identity"-Monade nehmen, die wir nachher wegcasten
|
||||
können.
|
||||
|
||||
~~~ { .haskell }
|
||||
newtype Identity a = Identity a
|
||||
-- Id :: a -> Identity a
|
||||
|
||||
runIdentity :: Identity s -> s
|
||||
runIdentity (Identity x) = x
|
||||
|
||||
instance Functor Identity where
|
||||
fmap f (Identity x) = Identity (f x)
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
somit ist set einfach nur
|
||||
|
||||
~~~ { .haskell }
|
||||
set :: Lens' s a -> (a -> s -> s)
|
||||
set ln x s
|
||||
= runIdentity (ls set_fld s)
|
||||
where
|
||||
set_fld :: a -> Identity a
|
||||
set_fld _ = Identity x
|
||||
-- a was the OLD value.
|
||||
-- We throw that away and set the new value
|
||||
~~~~~~
|
||||
|
||||
oder kürzer (für nerds wie den Autor der Lens-Lib)
|
||||
|
||||
~~~ {.haskell }
|
||||
set :: Lens' s a -> (a -> s -> s)
|
||||
set ln x = runIdentity . ln (Identity . const x)
|
||||
~~~
|
||||
|
||||
## Benutzen einer Lens als Modify
|
||||
|
||||
Dasselbe wie Set, nur dass wir den Parameter nicht entsorgen, sondern in die
|
||||
mitgelieferte Funktion stopfen.
|
||||
|
||||
~~~ {.haskell}
|
||||
over :: Lens' s a -> (a -> a) -> s -> s
|
||||
over ln f = runIdentity . ln (Identity . f)
|
||||
~~~
|
||||
|
||||
## Benutzen einer Lens als Getter
|
||||
|
||||
~~~ { .haskell }
|
||||
view :: Lens' s a -> (s -> a)
|
||||
view ln s = --...umm...
|
||||
--:t ln => (a -> f a) -> s -> f s
|
||||
-- => get a out of the (f s) return-value
|
||||
-- Wait, WHAT?
|
||||
~~~~~~
|
||||
|
||||
Auch hier gibt es einen netten Funktor. Wir packen das "a" einfach in das "f"
|
||||
und werfen das "s" am Ende weg.
|
||||
|
||||
~~~ { .haskell }
|
||||
newtype Const v a = Const v
|
||||
|
||||
getConst :: Const v a -> v
|
||||
getConst (Const x) = x
|
||||
|
||||
instance Functor (Const v) where
|
||||
fmap f (Const x) = Const x
|
||||
-- throw f away. Nothing changes our const!
|
||||
~~~~~~
|
||||
|
||||
somit ergibt sich
|
||||
|
||||
~~~ { .haskell }
|
||||
view :: Lens' s a -> (s -> a)
|
||||
view ln s
|
||||
= getConst (ln Const s)
|
||||
-- Const :: s -> Const a s
|
||||
~~~~~~
|
||||
|
||||
oder nerdig
|
||||
|
||||
~~~ {.haskell}
|
||||
view :: Lens' s a -> (s -> a)
|
||||
view ln = getConst . ln Const
|
||||
~~~
|
||||
|
||||
## Lenses bauen
|
||||
|
||||
Nochmal kurz der Typ:
|
||||
|
||||
~~~ {.haskell}
|
||||
type Lens' s a = forall f. Functor f
|
||||
=> (a -> f a) -> s -> f s
|
||||
~~~
|
||||
|
||||
Für unser Personen-Beispiel vom Anfang:
|
||||
|
||||
~~~ { .haskell }
|
||||
data Person = P { _name :: String, _salary :: Int }
|
||||
|
||||
name :: Lens' Person String
|
||||
-- name :: Functor f => (String -> f String)
|
||||
-- -> Person -> f Person
|
||||
|
||||
name elt_fn (P n s)
|
||||
= fmap (\n' -> P n' s) (elt_fn n)
|
||||
-- fmap :: Functor f => (a->b) -> f a -> f b - der Funktor, der alles verknüpft
|
||||
-- \n' -> .. :: String -> Person - Funktion um das Element zu lokalisieren (WO wird ersetzt/gelesen/...)
|
||||
-- elt_fn n :: f String - Funktion um das Element zu verändern (setzen, ändern, ...)
|
||||
~~~~~~
|
||||
|
||||
Die Lambda-Funktion ersetzt einfach den Namen. Häufig sieht man auch
|
||||
|
||||
~~~ {.haskell}
|
||||
name elt_fn (P n s)
|
||||
= (\n' -> P n' s) <$> (elt_fn n)
|
||||
-- | Focus | |Function|
|
||||
~~~
|
||||
|
||||
## Wie funktioniert das intern?
|
||||
|
||||
~~~ { .haskell }
|
||||
view name (P {_name="Fred", _salary=100})
|
||||
-- inline view-function
|
||||
= getConst (name Const (P {_name="Fred", _salary=100})
|
||||
-- inline name
|
||||
= getConst (fmap (\n' -> P n' 100) (Const "Fred"))
|
||||
-- fmap f (Const x) = Const x - Definition von Const
|
||||
= getConst (Const "Fred")
|
||||
-- getConst (Const x) = x
|
||||
= "Fred"
|
||||
~~~~~~
|
||||
|
||||
Dieser Aufruf hat KEINE Runtime-Kosten, weil der Compiler direkt die Adresse des
|
||||
Feldes einsetzen kann. Der gesamte Boilerplate-Code wird vom Compiler
|
||||
wegoptimiert.
|
||||
|
||||
Dies gilt für jeden Funktor mit newtype, da das nur ein Typalias ist.
|
||||
|
||||
## Composing Lenses und deren Benutzung
|
||||
|
||||
Wie sehen denn die Typen aus?
|
||||
|
||||
Wir wollen ein
|
||||
|
||||
> Lens' s1 s2 -> Lens' s2 a -> Lens' s1 a
|
||||
|
||||
Wir haben 2 Lenses
|
||||
|
||||
> ln1 :: (s2 -> f s2) -> (s1 -> f s1)
|
||||
> ln2 :: (a -> f a) -> (s2 -> f s2)
|
||||
|
||||
wenn man scharf hinsieht, kann man die verbinden
|
||||
|
||||
> ln1 . ln2 :: (a -> f s) -> (s1 -> f s1)
|
||||
|
||||
und erhält eine Lens. Sogar die Gewünschte!
|
||||
Somit ist Lens-Composition einfach nur Function-Composition (.).
|
||||
|
||||
## Automatisieren mit Template-Haskell
|
||||
|
||||
Der Code um die Lenses zu bauen ist für records immer Identisch:
|
||||
|
||||
~~~ { .haskell }
|
||||
data Person = P { _name :: String, _salary :: Int }
|
||||
|
||||
name :: Lens' Person String
|
||||
name elt_fn (P n s) = (\n' -> P n' s) <$> (elt_fn n)
|
||||
~~~~~~
|
||||
|
||||
Daher kann man einfach
|
||||
|
||||
~~~ { .haskell }
|
||||
import Control.Lens.TH
|
||||
data Person = P { _name :: String, _salary :: Int }
|
||||
|
||||
$(makeLenses ''Person)
|
||||
~~~~~~
|
||||
|
||||
nehmen, was einem eine Lens für "name" und eine Lens für "salary" generiert.
|
||||
Mit anderen Templates kann man auch weitere Dinge steuern (etwa wofür Lenses
|
||||
generiert werden, welches Prefix (statt \_) man haben will etc. pp.).
|
||||
|
||||
Will man das aber haben, muss man selbst in den Control.Lens.TH-Code schauen.
|
||||
|
||||
## Lenses für den Beispielcode
|
||||
|
||||
~~~ { .haskell }
|
||||
import Control.Lens.TH
|
||||
|
||||
data Person = P { _name :: String
|
||||
, _addr :: Address
|
||||
, _salary :: Int }
|
||||
data Address = A { _road :: String
|
||||
, _city :: String
|
||||
, _postcode :: String }
|
||||
|
||||
$(makeLenses ''Person)
|
||||
$(makeLenses ''Address)
|
||||
|
||||
setPostcode :: String -> Person -> Person
|
||||
setPostcode pc p = set (addr . postcode) pc p
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
## Shortcuts mit "Line-Noise"
|
||||
|
||||
~~~ { .haskell }
|
||||
-- ...
|
||||
|
||||
setPostcode :: String -> Person -> Person
|
||||
setPostcode pc p = addr . postcode .~ pc $ p
|
||||
-- | Focus |set|to what|in where
|
||||
|
||||
getPostcode :: Person -> String
|
||||
getPostcode p = p ^. $ addr . postcode
|
||||
-- |from|get| Focus |
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Es gibt drölf-zillionen weitere Infix-Operatoren (für Folds,
|
||||
Listenkonvertierungen, -traversierungen, ...)
|
||||
|
||||
## Virtuelle Felder
|
||||
|
||||
Man kann mit Lenses sogar Felder emulieren, die gar nicht da sind. Angenommen
|
||||
folgender Code:
|
||||
|
||||
~~~ { .haskell }
|
||||
data Temp = T { _fahrenheit :: Float }
|
||||
|
||||
$(makeLenses ''Temp)
|
||||
-- liefert Lens: fahrenheit :: Lens Temp Float
|
||||
|
||||
centigrade :: Lens Temp Float
|
||||
centigrade centi_fn (T faren)
|
||||
= (\centi' -> T (cToF centi'))
|
||||
<$> (centi_fn (fToC faren))
|
||||
-- cToF & fToC as Converter-Functions defined someplace else
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Hiermit kann man dann auch Funktionen, die auf Grad-Celsius rechnen auf Daten
|
||||
anwenden, die eigenlich nur Fahrenheit speichern, aber eine Umrechnung
|
||||
bereitstellen. Analog kann man auch einen Zeit-Datentypen definieren, der
|
||||
intern mit Sekunden rechnet (und somit garantiert frei von Fehlern wie -3
|
||||
Minuten oder 37 Stunden ist)
|
||||
|
||||
## Non-Record Strukturen
|
||||
|
||||
Das ganze kann man auch parametrisieren und auf Non-Record-Strukturen anwenden.
|
||||
Beispielhaft an einer Map verdeutlicht:
|
||||
|
||||
~~~ { .haskell }
|
||||
-- from Data.Lens.At
|
||||
at :: Ord k => k -> Lens' (Map k v) (Maybe v)
|
||||
|
||||
-- oder identisch, wenn man die Lens' auflöst:
|
||||
at :: Ord k, forall f. Functor f => k -> (Maybe v -> f Maybe v) -> Map k v -> f Map k v
|
||||
|
||||
at k mb_fn m
|
||||
= wrap <$> (mb_fn mv)
|
||||
where
|
||||
mv = Map.lookup k m
|
||||
|
||||
wrap :: Maybe v -> Map k v
|
||||
wrap (Just v') = Map.insert k v' m
|
||||
wrap Nothing = case mv of
|
||||
Nothing -> m
|
||||
Just _ -> Map.delete k m
|
||||
|
||||
-- mb_fn :: Maybe v -> f Maybe v
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
## Weitere Beispiele
|
||||
|
||||
- Bitfields auf Strukturen die Bits haben (Ints, ...) in Data.Bits.Lens
|
||||
- Web-scraper in Package hexpat-lens
|
||||
|
||||
~~~ { .haskell }
|
||||
p ^.. _HTML' . to allNodes
|
||||
. traverse . named "a"
|
||||
. traverse . ix "href"
|
||||
. filtered isLocal
|
||||
. to trimSpaces
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Zieht alle externen Links aus dem gegebenen HTML-Code in p um weitere ziele
|
||||
fürs crawlen zu finden.
|
||||
|
||||
## Erweiterungen
|
||||
|
||||
Bisher hatten wir Lenses nur auf Funktoren F. Die nächstmächtigere Klasse ist
|
||||
Applicative.
|
||||
|
||||
~~~ { .haskell }
|
||||
type Traversal' s a = forall f. Applicative f
|
||||
=> (a -> f a) -> (s -> f s)
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Da wir den Container identisch lassen (weder s noch a wurde angefasst) muss sich
|
||||
etwas anderes ändern. Statt eines einzelnen Focus erhalten wir viele Foci.
|
||||
|
||||
Was ist ein Applicative überhaupt? Eine schwächere Monade (nur 1x Anwendung und
|
||||
kein Bind - dafür kann man die beliebig oft hintereinanderhängen).
|
||||
|
||||
~~~ { .haskell }
|
||||
class Functor f => Applicative f where
|
||||
pure :: a -> f a
|
||||
(<*>) :: f (a -> b) -> f a -> f b
|
||||
|
||||
-- Monade als Applicative:
|
||||
pure = return
|
||||
mf <*> mx = do { f <- mf; x <- mx; return (f x) }
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Recap: Was macht eine Lens:
|
||||
|
||||
~~~ { .haskell }
|
||||
data Adress = A { _road :: String
|
||||
, _city :: String
|
||||
, _postcode :: String }
|
||||
|
||||
road :: Lens' Adress String
|
||||
road elt_fn (A r c p) = (\r' -> A r' c p) <$> (elt_fn r)
|
||||
-- | "Hole" | | Thing to put in|
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Wenn man nun road & city gleichzeitig bearbeiten will:
|
||||
|
||||
~~~ { .haskell }
|
||||
addr_strs :: Traversal' Address String
|
||||
addr_strs elt_fn (A r c p)
|
||||
= ... (\r' c' -> A r' c' p) .. (elt_fn r) .. (elt_fn c) ..
|
||||
-- | function with 2 "Holes"| first Thing | second Thing
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
fmap kann nur 1 Loch stopfen, aber nicht mit n Löchern umgehen. Applicative mit
|
||||
<*> kann das.
|
||||
Somit gibt sich
|
||||
|
||||
~~~ { .haskell }
|
||||
addr_strs :: Traversal' Address String
|
||||
addr_strs elt_fn (A r c p)
|
||||
= pure (\r' c' -> A r' c' p) <*> (elt_fn r) <*> (elt_fn c)
|
||||
-- lift in Appl. | function with 2 "Holes"| first Thing | second Thing
|
||||
-- oder kürzer
|
||||
addr_strs :: Traversal' Address String
|
||||
addr_strs elt_fn (A r c p)
|
||||
= (\r' c' -> A r' c' p) <$> (elt_fn r) <*> (elt_fn c)
|
||||
-- pure x <*> y == x <$> y
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Wie würd eine modify-funktion aussehen?
|
||||
|
||||
~~~ {.haskell}
|
||||
over :: Lens' s a -> (a -> a) -> s -> s
|
||||
over ln f = runIdentity . ln (Identity . f)
|
||||
|
||||
over :: Traversal' s a -> (a -> a) -> s -> s
|
||||
over ln f = runIdentity . ln (Identity . f)
|
||||
~~~
|
||||
|
||||
Der Code ist derselbe - nur der Typ ist generischer. Auch die anderen Dinge
|
||||
funktioniert diese Erweiterung (für Identity und Const muss man noch ein paar
|
||||
dummy-Instanzen schreiben um sie von Functor auf Applicative oder Monad zu heben
|
||||
- konkret reicht hier die Instanzierung von Monoid). In der Lens-Library ist
|
||||
daher meist Monad m statt Functor f gefordert.
|
||||
|
||||
## Wozu dienen die Erweiterungen?
|
||||
|
||||
Man kann mit Foci sehr selektiv vorgehen. Auch kann man diese durch Funktionen
|
||||
steuern. Beispisweise eine Funktion anwenden auf
|
||||
|
||||
- Jedes 2. Listenelement
|
||||
- Alle graden Elemente in einem Baum
|
||||
- Alle Namen in einer Tabelle, deren Gehalt > 10.000€ ist
|
||||
|
||||
Traversals und Lenses kann man trivial kombinieren (`lens . lens` => `lens`,
|
||||
`lens . traversal` => `traversal` etc.)
|
||||
|
||||
## Wie es in Lens wirklich aussieht
|
||||
|
||||
In diesem Artikel wurde nur auf Monomorphic Lenses eingegangen. In der richtigen
|
||||
Library ist eine Lens
|
||||
|
||||
~~~ {.haskell}
|
||||
type Lens' s a = Lens s s a a
|
||||
type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t)
|
||||
~~~
|
||||
|
||||
sodass sich auch die Typen ändern können um z.B. automatisch einen Konvertierten
|
||||
(sicheren) Typen aus einer unsicheren Datenstruktur zu geben.
|
||||
|
||||
Die modify-Funktion over ist auch
|
||||
|
||||
~~~ {.haskell}
|
||||
> over :: Profunctor p => Setting p s t a b -> p a b -> s -> t
|
||||
~~~
|
||||
|
||||
> *Edward is deeply in thrall to abstractionitis* - Simon Peyton Jones
|
||||
|
||||
Lens alleine definiert 39 newtypes, 34 data-types und 194 Typsynonyme...
|
||||
Ausschnitt
|
||||
|
||||
~~~ { .haskell }
|
||||
-- traverseOf :: Functor f => Iso s t a b -> (a -> f b) -> s -> f t
|
||||
-- traverseOf :: Functor f => Lens s t a b -> (a -> f b) -> s -> f t
|
||||
-- traverseOf :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t
|
||||
|
||||
traverseOf :: Over p f s t a b -> p a (f b) -> s -> f t
|
||||
~~~~~~~~~~~~~~~~~~
|
||||
|
||||
dafuq?
|
320
content/Coding/Haskell/Webapp-Example.md
Normal file
320
content/Coding/Haskell/Webapp-Example.md
Normal file
@ -0,0 +1,320 @@
|
||||
# Webapp-Development in Haskell
|
||||
|
||||
Step-by-Step-Anleitung, wie man ein neues Projekt mit einer bereits erprobten
|
||||
Pipeline erstellt.
|
||||
|
||||
## Definition der API
|
||||
|
||||
Erster Schritt ist immer ein wünsch-dir-was bei der Api-Defenition.
|
||||
|
||||
Die meisten Services haben offensichtliche Anforderungen (Schnittstellen nach
|
||||
draußen, Schnittstellen intern, ...). Diese kann man immer sehr gut in einem
|
||||
`Request -> Response`-Model erfassen.
|
||||
|
||||
Um die Anforderungen und Möglichkeiten des jeweiligen Services sauber zu
|
||||
erfassen und automatisiert zu prüfen, dummy-implementationen zu bekommen und
|
||||
vieles andere mehr, empfiehlt es sich den #[[OpenAPI|openapi-generator]] zu
|
||||
nutzen.
|
||||
|
||||
Diese Definition läuft über openapi-v3 und kann z.b. mit Echtzeit-Vorschau im
|
||||
http://editor.swagger.io/ erspielen. Per Default ist der noch auf openapi-v2
|
||||
(aka swagger), kann aber auch v3.
|
||||
|
||||
Nach der Definition, was man am Ende haben möchte, muss man sich entscheiden, in
|
||||
welcher Sprache man weiter entwickelt. Ich empfehle aus verschiedenen Gründen
|
||||
primär 2 Sprachen: Python-Microservices (weil die ML-Libraries sehr gut sind,
|
||||
allerdings Änderungen meist schwer sind und der Code wenig robust - meist nur 1
|
||||
API-Endpunkt pro service) und Haskell (Stabilität, Performace, leicht zu ändern,
|
||||
gut anzupassen).
|
||||
|
||||
Im folgenden wird (aus offensichtlichen Gründen) nur auf das Haskell-Projekt eingegangen.
|
||||
|
||||
## Startprojekt in Haskell
|
||||
|
||||
### Erstellen eines neuen Projektes
|
||||
|
||||
Zunächst erstellen wir in normales Haskell-Projekt ohne Funktionalität & Firlefanz:
|
||||
|
||||
```bash
|
||||
stack new myservice
|
||||
```
|
||||
|
||||
Dies erstellt ein neues Verzeichnis und das generelle scaffolding.
|
||||
Nach einer kurzen Anpassung der `stack.yaml` (resolver auf unserer setzen;
|
||||
aktuell: `lts-17.4`) fügen wir am Ende der Datei
|
||||
|
||||
```yaml
|
||||
allow-newer: true
|
||||
ghc-options:
|
||||
"$locals": -fwrite-ide-info
|
||||
```
|
||||
|
||||
ein.
|
||||
Anschließend organisieren™ wir uns noch eine gute `.gitignore` und initialisieren
|
||||
das git mittels `git init; git add .; git commit -m "initial scaffold"`
|
||||
|
||||
### Generierung der API
|
||||
|
||||
Da die API immer wieder neu generiert werden kann (und sollte!) liegt sich in
|
||||
einem unterverzeichnis des Hauptprojektes.
|
||||
|
||||
Initial ist es das einfachste ein leeres temporäres Verzeichnis woanders zu
|
||||
erstellen, die `api-doc.yml` hinein kopieren und folgendes ausführen:
|
||||
|
||||
```bash
|
||||
openapi-generator generate -g haskell -o . -i api-doc.yml
|
||||
```
|
||||
|
||||
Dieses erstellt einem dann eine komplette library inkl. Datentypen.
|
||||
Wichtig: Der Name in der `api-doc` sollte vom Namen des Services (oben `myservice`)
|
||||
abweichen - entweder in Casing oder im Namen direkt. Suffixe wie API schneidet
|
||||
der Generator hier leider ab.
|
||||
(Wieso das ganze? Es entstehen nachher 2 libraries, `foo` & `fooAPI`. Da der
|
||||
generator das API abschneidet endet man mit foo & foo und der compiler meckert,
|
||||
dass er nicht weiß, welche lib gemeint ist).
|
||||
|
||||
danach: wie gewohnt `git init; git add .; git commit -m "initial"`. Auf dem
|
||||
Server der Wahl (github, gitea, gitlab, ...) nun ein Repository erstellen (am
|
||||
Besten: `myserviceAPI` - nach Konvention ist alles auf API endend autogeneriert!)
|
||||
und den Anweisungen nach ein remote hinzufügen & pushen.
|
||||
|
||||
#### Wieder zurück im Haskell-Service
|
||||
|
||||
In unserem eigentlichen Service müssen wir nun die API einbinden.
|
||||
Dazu erstellen wir ein Verzeichnis `libs` (Konvention) und machen ein `git
|
||||
submodule add <repository-url> libs/myserviceAPI`
|
||||
|
||||
Git hat nun die API in das submodul gepackt und wir können das oben erstellte
|
||||
temporäre Verzeichnis wieder löschen.
|
||||
|
||||
Anschließend müssen wir stack noch erklären, dass wir die API da nun liegen
|
||||
haben und passen wieder die `stack.yaml` an, indem wir das Verzeichnis unter
|
||||
packages hinzufügen.
|
||||
|
||||
```yaml
|
||||
packages:
|
||||
- .
|
||||
- libs/myserviceAPI # <<
|
||||
```
|
||||
|
||||
Nun können wir in der `package.yaml` (oder `myservice.cabal`, falls kein `hpack`
|
||||
verwendet wird) unter den dependencies unsere API hinzufügen (name wie die
|
||||
cabal-Datei in `libs/myserviceAPI`).
|
||||
|
||||
### Einbinden anderer Microservices
|
||||
|
||||
Funktioniert komplett analog zu dem vorgehen oben (ohne das generieren natürlich
|
||||
:grin:).
|
||||
`stack.yaml` editieren und zu den packages hinzufügen:
|
||||
|
||||
```yaml
|
||||
packages:
|
||||
- .
|
||||
- libs/myserviceAPI
|
||||
- libs/myCoolMLServiceAPI
|
||||
```
|
||||
|
||||
in der `package.yaml` (oder der cabal) die dependencies hinzufügen und schon
|
||||
haben wir die Features zur Verfügung und können gegen diese Services reden.
|
||||
|
||||
### Entfernen von anderen Technologien/Microservices
|
||||
|
||||
In git ist das entfernen von Submodules etwas frickelig, daher hier ein
|
||||
copy&paste der
|
||||
[GitHub-Antwort](https://gist.github.com/myusuf3/7f645819ded92bda6677):
|
||||
|
||||
```bash
|
||||
## Remove the submodule entry from .git/config
|
||||
git submodule deinit -f path/to/submodule
|
||||
|
||||
## Remove the submodule directory from the superproject's .git/modules directory
|
||||
rm-rf .git/modules/path/to/submodule
|
||||
|
||||
## Remove the entry in .gitmodules and remove the submodule directory located at path/to/submodule
|
||||
git rm-f path/to/submodule
|
||||
```
|
||||
|
||||
Falls das nicht klappt, gibt es alternative Vorschläge unter dem Link oben.
|
||||
|
||||
### Woher weiss ich, was wo liegt? Dokumentation? Halloo??
|
||||
|
||||
Keine Panik. Ein `stack haddock --open` hilft da. Das generiert die
|
||||
Dokumentation für alle in der `package.yaml` (oder cabal-file) eingetragenen
|
||||
dependencies inkl. aller upstream-dependencies. Man bekommt also eine komplette
|
||||
lokale Dokumentation von allem. Geöffnet wird dann die Paket-Startseite inkl.
|
||||
der direkten dependencies:
|
||||
|
||||
Es gibt 2 wichtige Pfade im Browser:
|
||||
|
||||
- ...../all/index.html - hier sind alle Pakete aufgeführt
|
||||
- ...../index.html - hier sind nur die direkten dependencies aufgeführt.
|
||||
|
||||
Wenn man einen lokalen Webserver startet kann man mittels "s" auch die
|
||||
interaktive Suche öffnen (Suche nach Typen, Funktionen, Signaturen, etc.). In
|
||||
Bash mit `python3` geht das z.b. einfach über:
|
||||
|
||||
```bash
|
||||
cd $(stack path --local-doc-root)
|
||||
python3 -m SimpleHTTPServer 8000
|
||||
firefox "http://localhost:8000"
|
||||
```
|
||||
|
||||
### Implementation des Services und Start
|
||||
|
||||
#### Loader/Bootstrapper
|
||||
|
||||
Generelles Vorgehen:
|
||||
|
||||
- in `app/Main.hs`:
|
||||
Hier ist quasi immer nur eine Zeile drin: `main = myServiceMain`
|
||||
|
||||
Grund: Applications tauchen nicht im Haddock auf. Also haben wir ein
|
||||
"src"-Modul, welches hier nur geladen & ausgeführt wird.
|
||||
- in `src/MyService.hs`:
|
||||
`myServiceMain :: IO ()` definieren
|
||||
|
||||
Für die Main kann man prinzipiell eine Main andere Services copy/pasten. Im
|
||||
folgenden eine Annotierte main-Funktion - zu den einzelnen Voraussetzungen
|
||||
kommen wir im Anschluss.
|
||||
|
||||
![[Main.hs#]]
|
||||
|
||||
#### Weitere Instanzen und Definitionen, die der Generator (noch) nicht macht
|
||||
|
||||
In der `Myservice.Types` werden ein paar hilfreiche Typen und Typ-Instanzen
|
||||
definiert. Im Folgenden geht es dabei um Dinge für:
|
||||
|
||||
- `Envy`
|
||||
- Laden von `$ENV_VAR` in Datentypen
|
||||
- Definitionen für Default-Settings
|
||||
- `ServerConfig`
|
||||
- Definition der Server-Konfiguration & Benennung der Environment-Variablen
|
||||
- `ExtraTypes`
|
||||
- ggf. Paketweite extra-Typen, die der Generator nicht macht, weil sie nicht
|
||||
aus der API kommen (z.B. cache)
|
||||
- `Out`/`BSON`-Instanzen
|
||||
- Der API-Generator generiert nur wenige Instanzen automatisch (z.B. `aeson`),
|
||||
daher werden hier die fehlenden definiert.
|
||||
- `BSON`: Kommunikation mit `MongoDB`
|
||||
- `Out`: pretty-printing im Log
|
||||
- Nur nötig, wenn man pretty-printing via `Out` statt über Generics wie z.b.
|
||||
`pretty-generic` oder die automatische Show-Instanz via `prerryShow`
|
||||
macht.
|
||||
|
||||
![[MyService_Types.hs#]]
|
||||
|
||||
#### Was noch zu tun ist
|
||||
|
||||
Den Service implementieren. Einfach ein neues Modul aufmachen (z.B.
|
||||
`MyService.Handler` oder
|
||||
`MyService.DieserEndpunktbereich`/`MyService.JenerEndpunktbereich`) und dort die
|
||||
Funktion implementieren, die man in der `Main.hs` benutzt hat.
|
||||
In dem Handler habt ihr dann keinen Stress mehr mit Validierung, networking,
|
||||
logging, etc. pp. weil alles in der Main abgehandelt wurde und ihr nur noch den
|
||||
"Happy-Case" implementieren müsst.
|
||||
Beispiel für unseren Handler oben:
|
||||
|
||||
```haskell
|
||||
myApiEndpointV1Post :: MonadIO m => ServerConfig -> (ClientEnv,ClientEnv) -> TQueue BS.ByteString -> ([LogItem] -> IO ()) -> Request -> m Response
|
||||
myApiEndpointV1Post sc calls amqPost log req = do
|
||||
liftIO . log $ [Info $ "recieved "<>pretty req] -- input-logging
|
||||
liftIO . atomically . writeTQueue . LBS.toStrict $ "{\"hey Kibana, i recieved:\"" <> A.encode (pretty req) <> "}" -- log in activeMQ/Kibana
|
||||
|
||||
|
||||
--- .... gaaaanz viel komplizierter code um die Response zu erhalten ;)
|
||||
let ret = Response 1337 Nothing -- dummy-response ;)
|
||||
-- gegeben wir haben eine gültige mongodb-pipe;
|
||||
-- mehr logik will ich in die Beispiele nicht packen.
|
||||
-- Man kann die z.b. als weiteren Wert in einer TMVar (damit man sie ändern & updaten kann) an die Funktion übergeben.
|
||||
liftIO . access pipe master "DatabaseName" $ do
|
||||
ifM (auth (myServiceMongoUsername sc) (myServiceMongoPassword sc)) (return ()) (liftIO . printLog . pure . Error $ "MongoDB: Login failed.")
|
||||
save "DatabaseCollection" ["_id" =: 1337, "entry" =: ret] -- selbe id wie oben ;)
|
||||
return ret
|
||||
```
|
||||
|
||||
Diese dummy-Antwort führt auf, wie gut man die ganzen Sachen mischen kann.
|
||||
|
||||
- Logging in die Dateien/`stdout` - je nach Konfiguration
|
||||
- Logging von Statistiken in Kibana
|
||||
- Speichern der Antwort in der MongoDB
|
||||
- Generieren einer Serverantwort und ausliefern dieser über die Schnittstelle
|
||||
|
||||
#### Tipps & Tricks
|
||||
|
||||
##### Dateien, die statisch ausgeliefert werden sollen
|
||||
|
||||
Hierzu erstellt man ein Verzeichnis `static/` (Konvention; ist im generator so
|
||||
generiert, dass das ausgeliefert wird). Packt man hier z.b. eine `index.html`
|
||||
rein, erscheint die, wenn man den Service ansurft.
|
||||
|
||||
##### Wie bekomme ich diese fancy Preview hin?
|
||||
|
||||
Der Editor, der ganz am Anfang zum Einsatz gekommen ist, braucht nur die
|
||||
`api-doc.yml` um diese Ansicht zu erzeugen. Daher empfiehlt sich hier ein
|
||||
angepasster Fork davon indem die Pfade in der index.html korrigiert sind. Am
|
||||
einfachsten (und von den meisten services so benutzt): In meiner Implementation
|
||||
liegt dann nach dem starten auf http://localhost:PORT/ui/ und kann direkt dort
|
||||
getestet werden.
|
||||
|
||||
##### Wie sorge ich für bessere Warnungen, damit der Compiler meine Bugs fängt?
|
||||
|
||||
```bash
|
||||
stack build --file-watch --ghc-options '-freverse-errors -W -Wall -Wcompat' --interleaved-output
|
||||
```
|
||||
|
||||
Was tut das?
|
||||
|
||||
- `--file-watch`: automatisches (minimales) kompilieren bei dateiänderungen
|
||||
- `--ghc-options`
|
||||
- `-freverse-errors`: Fehlermeldungen in umgekehrter Reihenfolge (Erster
|
||||
Fehler ganz unten; wenig scrollen )
|
||||
- `-W`: Warnungen an
|
||||
- `-Wall`: Alle sinnvollen Warnungen an (im gegensatz zu `-Weverything`, was
|
||||
WIRKLICH alles ist )
|
||||
- `-Wcompat`: Warnungen für Sachen, die in der nächsten Compilerversion kaputt
|
||||
brechen werden & vermieden werden sollten
|
||||
- `--interleaved-output`: stack-log direkt ausgeben & nicht in Dateien schreiben
|
||||
und die dann am ende zusammen cat\'en.
|
||||
|
||||
Um pro Datei Warnungen auszuschalten (z.B. weil man ganz sicher weiss, was man
|
||||
tut -.-): `{-# OPTIONS_GHC -Wno-whatsoever #-}` als pragma in die Datei.
|
||||
|
||||
**Idealerweise sollte das Projekt keine Warnungen erzeugen.**
|
||||
|
||||
### Deployment
|
||||
|
||||
Als Beispiel sei hier ein einfaches Docker-Build mit Jenkins-CI gezeigt, weil
|
||||
ich das aus Gründen rumliegen hatte. Kann man analog in fast alle anderen CI
|
||||
übersetzen.
|
||||
|
||||
#### Docker
|
||||
|
||||
Die angehängten Scripte gehen von einer Standard-Einrichtung aus (statische
|
||||
Sachen in static, 2-3 händische Anpassungen auf das eigene Projekt nach
|
||||
auspacken). Nachher liegt dann auch unter static/version die gebaute
|
||||
Versionsnummer & kann abgerufen werden. In der `Dockerfile.release` und der
|
||||
`Jenkinsfile` müssen noch Anpassungen gemacht werden. Konkret:
|
||||
|
||||
- in der `Dockerfile.release`: alle `<<<HIER>>>`-Stellen sinnvoll befüllen
|
||||
- in der `Jenkinsfile` die defs für "servicename" und "servicebinary" ausfüllen.
|
||||
Binary ist das, was bei stack exec aufgerufen wird; name ist der Image-Name
|
||||
für das docker-repository.
|
||||
|
||||
#### Jenkins
|
||||
|
||||
Änderungen die dann noch gemacht werden müssen:
|
||||
|
||||
- git-repository URL anpassen
|
||||
- Environment-Vars anpassen (\$BRANCH = test & live haben keine zusatzdinger im
|
||||
docker-image-repository; ansonsten hat das image \$BRANCH im Namen)
|
||||
|
||||
Wenn das fertig gebaut ist, liegt im test/live-repository ein docker-image
|
||||
namens `servicename:version`.
|
||||
|
||||
### OMG! Ich muss meine API ändern. Was mache ich nun?
|
||||
|
||||
1. api-doc.yml bearbeiten, wie gewünscht
|
||||
2. mittels generator die Api & submodule neu generieren
|
||||
3. ggf. custom Änderungen übernehmen (:Gitdiffsplit hilft)
|
||||
4. Alle Compilerfehler + Warnungen in der eigentlichen Applikation fixen
|
||||
5. If it comipilez, ship it! (Besser nicht :grin:)
|
188
content/Coding/Haskell/Webapp-Example/Main.hs.md
Normal file
188
content/Coding/Haskell/Webapp-Example/Main.hs.md
Normal file
@ -0,0 +1,188 @@
|
||||
# Webapp-Example: Main.hs
|
||||
|
||||
Wie man das verwendet, siehe #[[Webapp-Example]].
|
||||
|
||||
```haskell
|
||||
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module MyService where
|
||||
|
||||
-- generische imports aus den dependencies/base, nicht in der prelude
|
||||
import Codec.MIME.Type
|
||||
import Configuration.Dotenv as Dotenv
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch
|
||||
import Control.Monad.Except
|
||||
import Conversion
|
||||
import Conversion.Text ()
|
||||
import Data.Binary.Builder
|
||||
import Data.String (IsString (..))
|
||||
import Data.Time
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Format
|
||||
import Data.Default
|
||||
import Network.HostName
|
||||
import Network.HTTP.Client as HTTP hiding
|
||||
(withConnection)
|
||||
import Network.HTTP.Types (Status, statusCode)
|
||||
import Network.Mom.Stompl.Client.Queue
|
||||
import Network.Wai (Middleware)
|
||||
import Network.Wai.Logger
|
||||
import Network.Wai.Middleware.Cors
|
||||
import Network.Wai.Middleware.RequestLogger (OutputFormat (..),
|
||||
logStdout,
|
||||
mkRequestLogger,
|
||||
outputFormat)
|
||||
import Servant.Client (mkClientEnv,
|
||||
parseBaseUrl)
|
||||
import System.Directory
|
||||
import System.Envy
|
||||
import System.IO
|
||||
import System.Log.FastLogger
|
||||
import Text.PrettyPrint.GenericPretty
|
||||
|
||||
-- generische imports, aber qualified, weil es sonst zu name-clashes kommt
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
-- import qualified Data.ByteString.Char8 as BS8
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Network.HTTP.Client.TLS as UseDefaultHTTPSSettings (tlsManagerSettings)
|
||||
import qualified Network.Mom.Stompl.Client.Queue as AMQ
|
||||
import qualified Network.Wai as WAI
|
||||
|
||||
-- Handler für den MyServiceBackend-Typen und Imports aus den Libraries
|
||||
import MyService.Handler as H -- handler der H.myApiEndpointV1Post implementiert
|
||||
import MyService.Types -- weitere Type (s. nächste box)
|
||||
import MyServiceGen.API as MS -- aus der generierten library
|
||||
|
||||
|
||||
myServicemain :: IO ()
|
||||
myServicemain = do
|
||||
-- .env-Datei ins Prozess-Environment laden, falls noch nicht von außen gesetzt
|
||||
void $ loadFile $ Dotenv.Config [".env"] [] False
|
||||
-- Config holen (defaults + overrides aus dem Environment)
|
||||
sc@ServerConfig{..} <- decodeWithDefaults defConfig
|
||||
-- Backend-Setup
|
||||
-- legt sowas wie Proxy-Server fest und wo man wie dran kommt. Benötigt für das Sprechen mit anderen Microservices
|
||||
let defaultHTTPSSettings = UseDefaultHTTPSSettings.tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro $ 1000 * 1000 * myserviceMaxTimeout }
|
||||
createBackend url proxy = do
|
||||
manager <- newManager . managerSetProxy proxy
|
||||
$ defaultHTTPSSettings
|
||||
url' <- parseBaseUrl url
|
||||
return (mkClientEnv manager url')
|
||||
internalProxy = case myserviceInternalProxyUrl of
|
||||
"" -> noProxy
|
||||
url -> useProxy $ HTTP.Proxy (fromString url) myserviceInternalProxyPort
|
||||
-- externalProxy = case myserviceExternalProxyUrl of
|
||||
-- "" -> noProxy
|
||||
-- url -> useProxy $ HTTP.Proxy (fromString url) myserviceExternalProxyPort
|
||||
|
||||
-- Definieren & Erzeugen der Funktionen um die anderen Services anzusprechen.
|
||||
calls <- (,)
|
||||
<$> createBackend myserviceAUri internalProxy
|
||||
<*> createBackend myserviceBUri internalProxy
|
||||
|
||||
-- Logging-Setup
|
||||
hSetBuffering stdout LineBuffering
|
||||
hSetBuffering stderr LineBuffering
|
||||
|
||||
|
||||
-- Infos holen, brauchen wir später
|
||||
myName <- getHostName
|
||||
today <- formatTime defaultTimeLocale "%F" . utctDay <$> getCurrentTime
|
||||
|
||||
|
||||
-- activeMQ-Transaktional-Queue zum schreiben nachher vorbereiten
|
||||
amqPost <- newTQueueIO
|
||||
|
||||
|
||||
-- bracket a b c == erst a machen, ergebnis an c als variablen übergeben. Schmeisst c ne exception/wird gekillt/..., werden die variablen an b übergeben.
|
||||
bracket
|
||||
-- logfiles öffnen
|
||||
(LogFiles <$> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".info") AppendMode
|
||||
<*> openFile (if myserviceDebug then "/logs/myservice-"<>myName<>"-"<>today<>".debug" else "/dev/null") AppendMode
|
||||
<*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".error") AppendMode
|
||||
<*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".timings") AppendMode
|
||||
)
|
||||
-- und bei exception/beendigung schlißen.h
|
||||
(\(LogFiles a b c d) -> mapM_ hClose [a,b,c,d])
|
||||
$ \logfiles -> do
|
||||
|
||||
|
||||
-- logschreibe-funktionen aliasen; log ist hier abstrakt, iolog spezialisiert auf io.
|
||||
let log = printLogFiles logfiles :: MonadIO m => [LogItem] -> m ()
|
||||
iolog = printLogFilesIO logfiles :: [LogItem] -> IO ()
|
||||
|
||||
|
||||
-- H.myApiEndpointV1Post ist ein Handler (alle Handler werden mit alias H importiert) und in einer eigenen Datei
|
||||
-- Per Default bekommen Handler sowas wie die server-config, die Funktionen um mit anderen Services zu reden, die AMQ-Queue um ins Kibana zu loggen und eine Datei-Logging-Funktion
|
||||
-- Man kann aber noch viel mehr machen - z.b. gecachte Daten übergeben, eine Talk-Instanz, etc. pp.
|
||||
server = MyServiceBackend{ myApiEndpointV1Post = H.myApiEndpointV1Post sc calls amqPost log
|
||||
}
|
||||
config = MS.Config $ "http://" ++ myserviceHost ++ ":" ++ show myservicePort ++ "/"
|
||||
iolog . pure . Info $ "Using Server configuration:"
|
||||
iolog . pure . Info $ pretty sc { myserviceActivemqPassword = "******" -- Do NOT log the password ;)
|
||||
, myserviceMongoPassword = "******"
|
||||
}
|
||||
-- alle Services starten (Hintergrund-Aktionen wie z.b. einen MongoDB-Dumper, einen Talk-Server oder wie hier die ActiveMQ
|
||||
void $ forkIO $ keepActiveMQConnected sc iolog amqPost
|
||||
-- logging-Framework erzeugen
|
||||
loggingMW <- loggingMiddleware
|
||||
-- server starten
|
||||
if myserviceDebug
|
||||
then runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]})) . loggingMW . logStdout) server
|
||||
else runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]}))) server
|
||||
|
||||
|
||||
-- Sollte bald in die Library hs-stomp ausgelagert werden
|
||||
-- ist ein Beispiel für einen ActiveMQ-Dumper
|
||||
keepActiveMQConnected :: ServerConfig -> ([LogItem] -> IO ()) -> TQueue BS.ByteString -> IO ()
|
||||
keepActiveMQConnected sc@ServerConfig{..} printLog var = do
|
||||
res <- handle (\(e :: SomeException) -> do
|
||||
printLog . pure . Error $ "Exception in AMQ-Thread: "<>show e
|
||||
return $ Right ()
|
||||
) $ AMQ.try $ do -- catches all AMQ-Exception that we can handle. All others bubble up.
|
||||
printLog . pure . Info $ "AMQ: connecting..."
|
||||
withConnection myserviceActivemqHost myserviceActivemqPort [ OAuth myserviceActivemqUsername myserviceActivemqPassword
|
||||
, OTmo (30*1000) {- 30 sec timeout -}
|
||||
]
|
||||
[] $ \c -> do
|
||||
let oconv = return
|
||||
printLog . pure . Info $ "AMQ: connected"
|
||||
withWriter c "Chaos-Logger for Kibana" "chaos.logs" [] [] oconv $ \writer -> do
|
||||
printLog . pure . Info $ "AMQ: queue created"
|
||||
let postfun = writeQ writer (Type (Application "json") []) []
|
||||
void $ race
|
||||
(forever $ atomically (readTQueue var) >>= postfun)
|
||||
(threadDelay (600*1000*1000)) -- wait 10 Minutes
|
||||
-- close writer
|
||||
-- close connection
|
||||
-- get outside of all try/handle/...-constructions befor recursing.
|
||||
case res of
|
||||
Left ex -> do
|
||||
printLog . pure . Error $ "AMQ: "<>show ex
|
||||
keepActiveMQConnected sc printLog var
|
||||
Right _ -> keepActiveMQConnected sc printLog var
|
||||
|
||||
|
||||
-- Beispiel für eine Custom-Logging-Middleware.
|
||||
-- Hier werden z.B. alle 4xx-Status-Codes inkl. Payload ins stdout-Log geschrieben.
|
||||
-- Nützlich, wenn die Kollegen ihre Requests nicht ordentlich schreiben können und der Server das Format zurecht mit einem BadRequest ablehnt ;)
|
||||
loggingMiddleware :: IO Middleware
|
||||
loggingMiddleware = liftIO $ mkRequestLogger $ def { outputFormat = CustomOutputFormatWithDetails out }
|
||||
where
|
||||
out :: ZonedDate -> WAI.Request -> Status -> Maybe Integer -> NominalDiffTime -> [BS.ByteString] -> Builder -> LogStr
|
||||
out _ r status _ _ payload _
|
||||
| statusCode status < 300 = ""
|
||||
| statusCode status > 399 && statusCode status < 500 = "Error code "<>toLogStr (statusCode status) <>" sent. Request-Payload was: "<> mconcat (toLogStr <$> payload) <> "\n"
|
||||
| otherwise = toLogStr (show r) <> "\n"
|
||||
|
||||
```
|
83
content/Coding/Haskell/Webapp-Example/MyService_Types.hs.md
Normal file
83
content/Coding/Haskell/Webapp-Example/MyService_Types.hs.md
Normal file
@ -0,0 +1,83 @@
|
||||
# Webapp-Example: MyService/Types.hs
|
||||
|
||||
Anleitung siehe #[[Webapp-Example]].
|
||||
|
||||
```haskell
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module MyService.Types where
|
||||
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import Data.Text
|
||||
import Data.Time.Clock
|
||||
import GHC.Generics
|
||||
import System.Envy
|
||||
import Text.PrettyPrint (text)
|
||||
import Text.PrettyPrint.GenericPretty
|
||||
|
||||
-- Out hat hierfür keine Instanzen, daher kurz eine einfach Definition.
|
||||
instance Out Text where
|
||||
doc = text . unpack
|
||||
docPrec i a = text $ showsPrec i a ""
|
||||
|
||||
instance Out UTCTime where
|
||||
doc = text . show
|
||||
docPrec i a = text $ showsPrec i a ""
|
||||
|
||||
-- Der ServerConfig-Typ. Wird mit den defaults unten initialisiert, dann mit den Variablen aus der .env-Datei überschrieben und zum Schluss können Serveradmins diese via $MYSERVICE_FOO nochmal überschreiben.
|
||||
data ServerConfig = ServerConfig
|
||||
{ myserviceHost :: String -- ^ Environment: $MYSERVICE_HOST
|
||||
, myservicePort :: Int -- ^ Environment: $MYSERVICE_PORT
|
||||
, myserviceMaxTimeout :: Int -- ^ Environment: $MYSERVICE_MAX_TIMEOUT
|
||||
, myserviceInternalProxyUrl :: String -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_URL
|
||||
, myserviceInternalProxyPort :: Int -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_PORT
|
||||
, myserviceExternalProxyUrl :: String -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_URL
|
||||
, myserviceExternalProxyPort :: Int -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_PORT
|
||||
, myserviceActivemqHost :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_HOST
|
||||
, myserviceActivemqPort :: Int -- ^ Environment: $MYSERVICE_ACTIVEMQ_PORT
|
||||
, myserviceActivemqUsername :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_USERNAME
|
||||
, myserviceActivemqPassword :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_PASSWORD
|
||||
, myserviceMongoUsername :: String -- ^ Environment: $MYSERVICE_MONGO_USERNAME
|
||||
, myserviceMongoPassword :: String -- ^ Environment: $MYSERVICE_MONGO_PASSWORD
|
||||
, myserviceDebug :: Bool -- ^ Environment: $MYSERVICE_DEBUG
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
-- Default-Konfigurations-Instanz für diesen Service.
|
||||
instance DefConfig ServerConfig where
|
||||
defConfig = ServerConfig "0.0.0.0" 8080 20
|
||||
""
|
||||
""
|
||||
""
|
||||
0
|
||||
""
|
||||
0
|
||||
""
|
||||
0
|
||||
""
|
||||
""
|
||||
""
|
||||
""
|
||||
False
|
||||
|
||||
-- Kann auch aus dem ENV gefüllt werden
|
||||
instance FromEnv ServerConfig
|
||||
-- Und hübsch ausgegeben werden.
|
||||
instance Out ServerConfig
|
||||
|
||||
|
||||
instance Out Response
|
||||
instance FromBSON Repsonse -- FromBSON-Instanz geht immer davon aus, dass alle keys da sind (ggf. mit null bei Nothing).
|
||||
```
|
Reference in New Issue
Block a user