index.html

<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<!--[if IE]><meta http-equiv="X-UA-Compatible" content="IE=edge"><![endif]-->
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta name="generator" content="Asciidoctor 1.5.4">
<title>Exercises and notes for book "Haskell Programming from first principles" - Unofficial</title>
<link rel="stylesheet" href="https://fonts.googleapis.com/css?family=Open+Sans:300,300italic,400,400italic,600,600italic%7CNoto+Serif:400,400italic,700,700italic%7CDroid+Sans+Mono:400,700">
<style>
/* Asciidoctor default stylesheet | MIT License | http://asciidoctor.org */
/* Remove comment around @import statement below when using as a custom stylesheet */
/*@import "https://fonts.googleapis.com/css?family=Open+Sans:300,300italic,400,400italic,600,600italic%7CNoto+Serif:400,400italic,700,700italic%7CDroid+Sans+Mono:400,700";*/
article,aside,details,figcaption,figure,footer,header,hgroup,main,nav,section,summary{display:block}
audio,canvas,video{display:inline-block}
audio:not([controls]){display:none;height:0}
[hidden],template{display:none}
script{display:none!important}
html{font-family:sans-serif;-ms-text-size-adjust:100%;-webkit-text-size-adjust:100%}
body{margin:0}
a{background:transparent}
a:focus{outline:thin dotted}
a:active,a:hover{outline:0}
h1{font-size:2em;margin:.67em 0}
abbr[title]{border-bottom:1px dotted}
b,strong{font-weight:bold}
dfn{font-style:italic}
hr{-moz-box-sizing:content-box;box-sizing:content-box;height:0}
mark{background:#ff0;color:#000}
code,kbd,pre,samp{font-family:monospace;font-size:1em}
pre{white-space:pre-wrap}
q{quotes:"\201C" "\201D" "\2018" "\2019"}
small{font-size:80%}
sub,sup{font-size:75%;line-height:0;position:relative;vertical-align:baseline}
sup{top:-.5em}
sub{bottom:-.25em}
img{border:0}
svg:not(:root){overflow:hidden}
figure{margin:0}
fieldset{border:1px solid silver;margin:0 2px;padding:.35em .625em .75em}
legend{border:0;padding:0}
button,input,select,textarea{font-family:inherit;font-size:100%;margin:0}
button,input{line-height:normal}
button,select{text-transform:none}
button,html input[type="button"],input[type="reset"],input[type="submit"]{-webkit-appearance:button;cursor:pointer}
button[disabled],html input[disabled]{cursor:default}
input[type="checkbox"],input[type="radio"]{box-sizing:border-box;padding:0}
input[type="search"]{-webkit-appearance:textfield;-moz-box-sizing:content-box;-webkit-box-sizing:content-box;box-sizing:content-box}
input[type="search"]::-webkit-search-cancel-button,input[type="search"]::-webkit-search-decoration{-webkit-appearance:none}
button::-moz-focus-inner,input::-moz-focus-inner{border:0;padding:0}
textarea{overflow:auto;vertical-align:top}
table{border-collapse:collapse;border-spacing:0}
*,*:before,*:after{-moz-box-sizing:border-box;-webkit-box-sizing:border-box;box-sizing:border-box}
html,body{font-size:100%}
body{background:#fff;color:rgba(0,0,0,.8);padding:0;margin:0;font-family:"Noto Serif","DejaVu Serif",serif;font-weight:400;font-style:normal;line-height:1;position:relative;cursor:auto}
a:hover{cursor:pointer}
img,object,embed{max-width:100%;height:auto}
object,embed{height:100%}
img{-ms-interpolation-mode:bicubic}
.left{float:left!important}
.right{float:right!important}
.text-left{text-align:left!important}
.text-right{text-align:right!important}
.text-center{text-align:center!important}
.text-justify{text-align:justify!important}
.hide{display:none}
body{-webkit-font-smoothing:antialiased}
img,object,svg{display:inline-block;vertical-align:middle}
textarea{height:auto;min-height:50px}
select{width:100%}
.center{margin-left:auto;margin-right:auto}
.spread{width:100%}
p.lead,.paragraph.lead>p,#preamble>.sectionbody>.paragraph:first-of-type p{font-size:1.21875em;line-height:1.6}
.subheader,.admonitionblock td.content>.title,.audioblock>.title,.exampleblock>.title,.imageblock>.title,.listingblock>.title,.literalblock>.title,.stemblock>.title,.openblock>.title,.paragraph>.title,.quoteblock>.title,table.tableblock>.title,.verseblock>.title,.videoblock>.title,.dlist>.title,.olist>.title,.ulist>.title,.qlist>.title,.hdlist>.title{line-height:1.45;color:#7a2518;font-weight:400;margin-top:0;margin-bottom:.25em}
div,dl,dt,dd,ul,ol,li,h1,h2,h3,#toctitle,.sidebarblock>.content>.title,h4,h5,h6,pre,form,p,blockquote,th,td{margin:0;padding:0;direction:ltr}
a{color:#2156a5;text-decoration:underline;line-height:inherit}
a:hover,a:focus{color:#1d4b8f}
a img{border:none}
p{font-family:inherit;font-weight:400;font-size:1em;line-height:1.6;margin-bottom:1.25em;text-rendering:optimizeLegibility}
p aside{font-size:.875em;line-height:1.35;font-style:italic}
h1,h2,h3,#toctitle,.sidebarblock>.content>.title,h4,h5,h6{font-family:"Open Sans","DejaVu Sans",sans-serif;font-weight:300;font-style:normal;color:#ba3925;text-rendering:optimizeLegibility;margin-top:1em;margin-bottom:.5em;line-height:1.0125em}
h1 small,h2 small,h3 small,#toctitle small,.sidebarblock>.content>.title small,h4 small,h5 small,h6 small{font-size:60%;color:#e99b8f;line-height:0}
h1{font-size:2.125em}
h2{font-size:1.6875em}
h3,#toctitle,.sidebarblock>.content>.title{font-size:1.375em}
h4,h5{font-size:1.125em}
h6{font-size:1em}
hr{border:solid #ddddd8;border-width:1px 0 0;clear:both;margin:1.25em 0 1.1875em;height:0}
em,i{font-style:italic;line-height:inherit}
strong,b{font-weight:bold;line-height:inherit}
small{font-size:60%;line-height:inherit}
code{font-family:"Droid Sans Mono","DejaVu Sans Mono",monospace;font-weight:400;color:rgba(0,0,0,.9)}
ul,ol,dl{font-size:1em;line-height:1.6;margin-bottom:1.25em;list-style-position:outside;font-family:inherit}
ul,ol,ul.no-bullet,ol.no-bullet{margin-left:1.5em}
ul li ul,ul li ol{margin-left:1.25em;margin-bottom:0;font-size:1em}
ul.square li ul,ul.circle li ul,ul.disc li ul{list-style:inherit}
ul.square{list-style-type:square}
ul.circle{list-style-type:circle}
ul.disc{list-style-type:disc}
ul.no-bullet{list-style:none}
ol li ul,ol li ol{margin-left:1.25em;margin-bottom:0}
dl dt{margin-bottom:.3125em;font-weight:bold}
dl dd{margin-bottom:1.25em}
abbr,acronym{text-transform:uppercase;font-size:90%;color:rgba(0,0,0,.8);border-bottom:1px dotted #ddd;cursor:help}
abbr{text-transform:none}
blockquote{margin:0 0 1.25em;padding:.5625em 1.25em 0 1.1875em;border-left:1px solid #ddd}
blockquote cite{display:block;font-size:.9375em;color:rgba(0,0,0,.6)}
blockquote cite:before{content:"\2014 \0020"}
blockquote cite a,blockquote cite a:visited{color:rgba(0,0,0,.6)}
blockquote,blockquote p{line-height:1.6;color:rgba(0,0,0,.85)}
@media only screen and (min-width:768px){h1,h2,h3,#toctitle,.sidebarblock>.content>.title,h4,h5,h6{line-height:1.2}
h1{font-size:2.75em}
h2{font-size:2.3125em}
h3,#toctitle,.sidebarblock>.content>.title{font-size:1.6875em}
h4{font-size:1.4375em}}
table{background:#fff;margin-bottom:1.25em;border:solid 1px #dedede}
table thead,table tfoot{background:#f7f8f7;font-weight:bold}
table thead tr th,table thead tr td,table tfoot tr th,table tfoot tr td{padding:.5em .625em .625em;font-size:inherit;color:rgba(0,0,0,.8);text-align:left}
table tr th,table tr td{padding:.5625em .625em;font-size:inherit;color:rgba(0,0,0,.8)}
table tr.even,table tr.alt,table tr:nth-of-type(even){background:#f8f8f7}
table thead tr th,table tfoot tr th,table tbody tr td,table tr td,table tfoot tr td{display:table-cell;line-height:1.6}
body{tab-size:4}
h1,h2,h3,#toctitle,.sidebarblock>.content>.title,h4,h5,h6{line-height:1.2;word-spacing:-.05em}
h1 strong,h2 strong,h3 strong,#toctitle strong,.sidebarblock>.content>.title strong,h4 strong,h5 strong,h6 strong{font-weight:400}
.clearfix:before,.clearfix:after,.float-group:before,.float-group:after{content:" ";display:table}
.clearfix:after,.float-group:after{clear:both}
*:not(pre)>code{font-size:.9375em;font-style:normal!important;letter-spacing:0;padding:.1em .5ex;word-spacing:-.15em;background-color:#f7f7f8;-webkit-border-radius:4px;border-radius:4px;line-height:1.45;text-rendering:optimizeSpeed}
pre,pre>code{line-height:1.45;color:rgba(0,0,0,.9);font-family:"Droid Sans Mono","DejaVu Sans Mono",monospace;font-weight:400;text-rendering:optimizeSpeed}
.keyseq{color:rgba(51,51,51,.8)}
kbd{font-family:"Droid Sans Mono","DejaVu Sans Mono",monospace;display:inline-block;color:rgba(0,0,0,.8);font-size:.65em;line-height:1.45;background-color:#f7f7f7;border:1px solid #ccc;-webkit-border-radius:3px;border-radius:3px;-webkit-box-shadow:0 1px 0 rgba(0,0,0,.2),0 0 0 .1em white inset;box-shadow:0 1px 0 rgba(0,0,0,.2),0 0 0 .1em #fff inset;margin:0 .15em;padding:.2em .5em;vertical-align:middle;position:relative;top:-.1em;white-space:nowrap}
.keyseq kbd:first-child{margin-left:0}
.keyseq kbd:last-child{margin-right:0}
.menuseq,.menu{color:rgba(0,0,0,.8)}
b.button:before,b.button:after{position:relative;top:-1px;font-weight:400}
b.button:before{content:"[";padding:0 3px 0 2px}
b.button:after{content:"]";padding:0 2px 0 3px}
p a>code:hover{color:rgba(0,0,0,.9)}
#header,#content,#footnotes,#footer{width:100%;margin-left:auto;margin-right:auto;margin-top:0;margin-bottom:0;max-width:62.5em;*zoom:1;position:relative;padding-left:.9375em;padding-right:.9375em}
#header:before,#header:after,#content:before,#content:after,#footnotes:before,#footnotes:after,#footer:before,#footer:after{content:" ";display:table}
#header:after,#content:after,#footnotes:after,#footer:after{clear:both}
#content{margin-top:1.25em}
#content:before{content:none}
#header>h1:first-child{color:rgba(0,0,0,.85);margin-top:2.25rem;margin-bottom:0}
#header>h1:first-child+#toc{margin-top:8px;border-top:1px solid #ddddd8}
#header>h1:only-child,body.toc2 #header>h1:nth-last-child(2){border-bottom:1px solid #ddddd8;padding-bottom:8px}
#header .details{border-bottom:1px solid #ddddd8;line-height:1.45;padding-top:.25em;padding-bottom:.25em;padding-left:.25em;color:rgba(0,0,0,.6);display:-ms-flexbox;display:-webkit-flex;display:flex;-ms-flex-flow:row wrap;-webkit-flex-flow:row wrap;flex-flow:row wrap}
#header .details span:first-child{margin-left:-.125em}
#header .details span.email a{color:rgba(0,0,0,.85)}
#header .details br{display:none}
#header .details br+span:before{content:"\00a0\2013\00a0"}
#header .details br+span.author:before{content:"\00a0\22c5\00a0";color:rgba(0,0,0,.85)}
#header .details br+span#revremark:before{content:"\00a0|\00a0"}
#header #revnumber{text-transform:capitalize}
#header #revnumber:after{content:"\00a0"}
#content>h1:first-child:not([class]){color:rgba(0,0,0,.85);border-bottom:1px solid #ddddd8;padding-bottom:8px;margin-top:0;padding-top:1rem;margin-bottom:1.25rem}
#toc{border-bottom:1px solid #efefed;padding-bottom:.5em}
#toc>ul{margin-left:.125em}
#toc ul.sectlevel0>li>a{font-style:italic}
#toc ul.sectlevel0 ul.sectlevel1{margin:.5em 0}
#toc ul{font-family:"Open Sans","DejaVu Sans",sans-serif;list-style-type:none}
#toc li{line-height:1.3334;margin-top:.3334em}
#toc a{text-decoration:none}
#toc a:active{text-decoration:underline}
#toctitle{color:#7a2518;font-size:1.2em}
@media only screen and (min-width:768px){#toctitle{font-size:1.375em}
body.toc2{padding-left:15em;padding-right:0}
#toc.toc2{margin-top:0!important;background-color:#f8f8f7;position:fixed;width:15em;left:0;top:0;border-right:1px solid #efefed;border-top-width:0!important;border-bottom-width:0!important;z-index:1000;padding:1.25em 1em;height:100%;overflow:auto}
#toc.toc2 #toctitle{margin-top:0;margin-bottom:.8rem;font-size:1.2em}
#toc.toc2>ul{font-size:.9em;margin-bottom:0}
#toc.toc2 ul ul{margin-left:0;padding-left:1em}
#toc.toc2 ul.sectlevel0 ul.sectlevel1{padding-left:0;margin-top:.5em;margin-bottom:.5em}
body.toc2.toc-right{padding-left:0;padding-right:15em}
body.toc2.toc-right #toc.toc2{border-right-width:0;border-left:1px solid #efefed;left:auto;right:0}}
@media only screen and (min-width:1280px){body.toc2{padding-left:20em;padding-right:0}
#toc.toc2{width:20em}
#toc.toc2 #toctitle{font-size:1.375em}
#toc.toc2>ul{font-size:.95em}
#toc.toc2 ul ul{padding-left:1.25em}
body.toc2.toc-right{padding-left:0;padding-right:20em}}
#content #toc{border-style:solid;border-width:1px;border-color:#e0e0dc;margin-bottom:1.25em;padding:1.25em;background:#f8f8f7;-webkit-border-radius:4px;border-radius:4px}
#content #toc>:first-child{margin-top:0}
#content #toc>:last-child{margin-bottom:0}
#footer{max-width:100%;background-color:rgba(0,0,0,.8);padding:1.25em}
#footer-text{color:rgba(255,255,255,.8);line-height:1.44}
.sect1{padding-bottom:.625em}
@media only screen and (min-width:768px){.sect1{padding-bottom:1.25em}}
.sect1+.sect1{border-top:1px solid #efefed}
#content h1>a.anchor,h2>a.anchor,h3>a.anchor,#toctitle>a.anchor,.sidebarblock>.content>.title>a.anchor,h4>a.anchor,h5>a.anchor,h6>a.anchor{position:absolute;z-index:1001;width:1.5ex;margin-left:-1.5ex;display:block;text-decoration:none!important;visibility:hidden;text-align:center;font-weight:400}
#content h1>a.anchor:before,h2>a.anchor:before,h3>a.anchor:before,#toctitle>a.anchor:before,.sidebarblock>.content>.title>a.anchor:before,h4>a.anchor:before,h5>a.anchor:before,h6>a.anchor:before{content:"\00A7";font-size:.85em;display:block;padding-top:.1em}
#content h1:hover>a.anchor,#content h1>a.anchor:hover,h2:hover>a.anchor,h2>a.anchor:hover,h3:hover>a.anchor,#toctitle:hover>a.anchor,.sidebarblock>.content>.title:hover>a.anchor,h3>a.anchor:hover,#toctitle>a.anchor:hover,.sidebarblock>.content>.title>a.anchor:hover,h4:hover>a.anchor,h4>a.anchor:hover,h5:hover>a.anchor,h5>a.anchor:hover,h6:hover>a.anchor,h6>a.anchor:hover{visibility:visible}
#content h1>a.link,h2>a.link,h3>a.link,#toctitle>a.link,.sidebarblock>.content>.title>a.link,h4>a.link,h5>a.link,h6>a.link{color:#ba3925;text-decoration:none}
#content h1>a.link:hover,h2>a.link:hover,h3>a.link:hover,#toctitle>a.link:hover,.sidebarblock>.content>.title>a.link:hover,h4>a.link:hover,h5>a.link:hover,h6>a.link:hover{color:#a53221}
.audioblock,.imageblock,.literalblock,.listingblock,.stemblock,.videoblock{margin-bottom:1.25em}
.admonitionblock td.content>.title,.audioblock>.title,.exampleblock>.title,.imageblock>.title,.listingblock>.title,.literalblock>.title,.stemblock>.title,.openblock>.title,.paragraph>.title,.quoteblock>.title,table.tableblock>.title,.verseblock>.title,.videoblock>.title,.dlist>.title,.olist>.title,.ulist>.title,.qlist>.title,.hdlist>.title{text-rendering:optimizeLegibility;text-align:left;font-family:"Noto Serif","DejaVu Serif",serif;font-size:1rem;font-style:italic}
table.tableblock>caption.title{white-space:nowrap;overflow:visible;max-width:0}
.paragraph.lead>p,#preamble>.sectionbody>.paragraph:first-of-type p{color:rgba(0,0,0,.85)}
table.tableblock #preamble>.sectionbody>.paragraph:first-of-type p{font-size:inherit}
.admonitionblock>table{border-collapse:separate;border:0;background:none;width:100%}
.admonitionblock>table td.icon{text-align:center;width:80px}
.admonitionblock>table td.icon img{max-width:none}
.admonitionblock>table td.icon .title{font-weight:bold;font-family:"Open Sans","DejaVu Sans",sans-serif;text-transform:uppercase}
.admonitionblock>table td.content{padding-left:1.125em;padding-right:1.25em;border-left:1px solid #ddddd8;color:rgba(0,0,0,.6)}
.admonitionblock>table td.content>:last-child>:last-child{margin-bottom:0}
.exampleblock>.content{border-style:solid;border-width:1px;border-color:#e6e6e6;margin-bottom:1.25em;padding:1.25em;background:#fff;-webkit-border-radius:4px;border-radius:4px}
.exampleblock>.content>:first-child{margin-top:0}
.exampleblock>.content>:last-child{margin-bottom:0}
.sidebarblock{border-style:solid;border-width:1px;border-color:#e0e0dc;margin-bottom:1.25em;padding:1.25em;background:#f8f8f7;-webkit-border-radius:4px;border-radius:4px}
.sidebarblock>:first-child{margin-top:0}
.sidebarblock>:last-child{margin-bottom:0}
.sidebarblock>.content>.title{color:#7a2518;margin-top:0;text-align:center}
.exampleblock>.content>:last-child>:last-child,.exampleblock>.content .olist>ol>li:last-child>:last-child,.exampleblock>.content .ulist>ul>li:last-child>:last-child,.exampleblock>.content .qlist>ol>li:last-child>:last-child,.sidebarblock>.content>:last-child>:last-child,.sidebarblock>.content .olist>ol>li:last-child>:last-child,.sidebarblock>.content .ulist>ul>li:last-child>:last-child,.sidebarblock>.content .qlist>ol>li:last-child>:last-child{margin-bottom:0}
.literalblock pre,.listingblock pre:not(.highlight),.listingblock pre[class="highlight"],.listingblock pre[class^="highlight "],.listingblock pre.CodeRay,.listingblock pre.prettyprint{background:#f7f7f8}
.sidebarblock .literalblock pre,.sidebarblock .listingblock pre:not(.highlight),.sidebarblock .listingblock pre[class="highlight"],.sidebarblock .listingblock pre[class^="highlight "],.sidebarblock .listingblock pre.CodeRay,.sidebarblock .listingblock pre.prettyprint{background:#f2f1f1}
.literalblock pre,.literalblock pre[class],.listingblock pre,.listingblock pre[class]{-webkit-border-radius:4px;border-radius:4px;word-wrap:break-word;padding:1em;font-size:.8125em}
.literalblock pre.nowrap,.literalblock pre[class].nowrap,.listingblock pre.nowrap,.listingblock pre[class].nowrap{overflow-x:auto;white-space:pre;word-wrap:normal}
@media only screen and (min-width:768px){.literalblock pre,.literalblock pre[class],.listingblock pre,.listingblock pre[class]{font-size:.90625em}}
@media only screen and (min-width:1280px){.literalblock pre,.literalblock pre[class],.listingblock pre,.listingblock pre[class]{font-size:1em}}
.literalblock.output pre{color:#f7f7f8;background-color:rgba(0,0,0,.9)}
.listingblock pre.highlightjs{padding:0}
.listingblock pre.highlightjs>code{padding:1em;-webkit-border-radius:4px;border-radius:4px}
.listingblock pre.prettyprint{border-width:0}
.listingblock>.content{position:relative}
.listingblock code[data-lang]:before{display:none;content:attr(data-lang);position:absolute;font-size:.75em;top:.425rem;right:.5rem;line-height:1;text-transform:uppercase;color:#999}
.listingblock:hover code[data-lang]:before{display:block}
.listingblock.terminal pre .command:before{content:attr(data-prompt);padding-right:.5em;color:#999}
.listingblock.terminal pre .command:not([data-prompt]):before{content:"$"}
table.pyhltable{border-collapse:separate;border:0;margin-bottom:0;background:none}
table.pyhltable td{vertical-align:top;padding-top:0;padding-bottom:0;line-height:1.45}
table.pyhltable td.code{padding-left:.75em;padding-right:0}
pre.pygments .lineno,table.pyhltable td:not(.code){color:#999;padding-left:0;padding-right:.5em;border-right:1px solid #ddddd8}
pre.pygments .lineno{display:inline-block;margin-right:.25em}
table.pyhltable .linenodiv{background:none!important;padding-right:0!important}
.quoteblock{margin:0 1em 1.25em 1.5em;display:table}
.quoteblock>.title{margin-left:-1.5em;margin-bottom:.75em}
.quoteblock blockquote,.quoteblock blockquote p{color:rgba(0,0,0,.85);font-size:1.15rem;line-height:1.75;word-spacing:.1em;letter-spacing:0;font-style:italic;text-align:justify}
.quoteblock blockquote{margin:0;padding:0;border:0}
.quoteblock blockquote:before{content:"\201c";float:left;font-size:2.75em;font-weight:bold;line-height:.6em;margin-left:-.6em;color:#7a2518;text-shadow:0 1px 2px rgba(0,0,0,.1)}
.quoteblock blockquote>.paragraph:last-child p{margin-bottom:0}
.quoteblock .attribution{margin-top:.5em;margin-right:.5ex;text-align:right}
.quoteblock .quoteblock{margin-left:0;margin-right:0;padding:.5em 0;border-left:3px solid rgba(0,0,0,.6)}
.quoteblock .quoteblock blockquote{padding:0 0 0 .75em}
.quoteblock .quoteblock blockquote:before{display:none}
.verseblock{margin:0 1em 1.25em 1em}
.verseblock pre{font-family:"Open Sans","DejaVu Sans",sans;font-size:1.15rem;color:rgba(0,0,0,.85);font-weight:300;text-rendering:optimizeLegibility}
.verseblock pre strong{font-weight:400}
.verseblock .attribution{margin-top:1.25rem;margin-left:.5ex}
.quoteblock .attribution,.verseblock .attribution{font-size:.9375em;line-height:1.45;font-style:italic}
.quoteblock .attribution br,.verseblock .attribution br{display:none}
.quoteblock .attribution cite,.verseblock .attribution cite{display:block;letter-spacing:-.025em;color:rgba(0,0,0,.6)}
.quoteblock.abstract{margin:0 0 1.25em 0;display:block}
.quoteblock.abstract blockquote,.quoteblock.abstract blockquote p{text-align:left;word-spacing:0}
.quoteblock.abstract blockquote:before,.quoteblock.abstract blockquote p:first-of-type:before{display:none}
table.tableblock{max-width:100%;border-collapse:separate}
table.tableblock td>.paragraph:last-child p>p:last-child,table.tableblock th>p:last-child,table.tableblock td>p:last-child{margin-bottom:0}
table.tableblock,th.tableblock,td.tableblock{border:0 solid #dedede}
table.grid-all th.tableblock,table.grid-all td.tableblock{border-width:0 1px 1px 0}
table.grid-all tfoot>tr>th.tableblock,table.grid-all tfoot>tr>td.tableblock{border-width:1px 1px 0 0}
table.grid-cols th.tableblock,table.grid-cols td.tableblock{border-width:0 1px 0 0}
table.grid-all *>tr>.tableblock:last-child,table.grid-cols *>tr>.tableblock:last-child{border-right-width:0}
table.grid-rows th.tableblock,table.grid-rows td.tableblock{border-width:0 0 1px 0}
table.grid-all tbody>tr:last-child>th.tableblock,table.grid-all tbody>tr:last-child>td.tableblock,table.grid-all thead:last-child>tr>th.tableblock,table.grid-rows tbody>tr:last-child>th.tableblock,table.grid-rows tbody>tr:last-child>td.tableblock,table.grid-rows thead:last-child>tr>th.tableblock{border-bottom-width:0}
table.grid-rows tfoot>tr>th.tableblock,table.grid-rows tfoot>tr>td.tableblock{border-width:1px 0 0 0}
table.frame-all{border-width:1px}
table.frame-sides{border-width:0 1px}
table.frame-topbot{border-width:1px 0}
th.halign-left,td.halign-left{text-align:left}
th.halign-right,td.halign-right{text-align:right}
th.halign-center,td.halign-center{text-align:center}
th.valign-top,td.valign-top{vertical-align:top}
th.valign-bottom,td.valign-bottom{vertical-align:bottom}
th.valign-middle,td.valign-middle{vertical-align:middle}
table thead th,table tfoot th{font-weight:bold}
tbody tr th{display:table-cell;line-height:1.6;background:#f7f8f7}
tbody tr th,tbody tr th p,tfoot tr th,tfoot tr th p{color:rgba(0,0,0,.8);font-weight:bold}
p.tableblock>code:only-child{background:none;padding:0}
p.tableblock{font-size:1em}
td>div.verse{white-space:pre}
ol{margin-left:1.75em}
ul li ol{margin-left:1.5em}
dl dd{margin-left:1.125em}
dl dd:last-child,dl dd:last-child>:last-child{margin-bottom:0}
ol>li p,ul>li p,ul dd,ol dd,.olist .olist,.ulist .ulist,.ulist .olist,.olist .ulist{margin-bottom:.625em}
ul.unstyled,ol.unnumbered,ul.checklist,ul.none{list-style-type:none}
ul.unstyled,ol.unnumbered,ul.checklist{margin-left:.625em}
ul.checklist li>p:first-child>.fa-square-o:first-child,ul.checklist li>p:first-child>.fa-check-square-o:first-child{width:1em;font-size:.85em}
ul.checklist li>p:first-child>input[type="checkbox"]:first-child{width:1em;position:relative;top:1px}
ul.inline{margin:0 auto .625em auto;margin-left:-1.375em;margin-right:0;padding:0;list-style:none;overflow:hidden}
ul.inline>li{list-style:none;float:left;margin-left:1.375em;display:block}
ul.inline>li>*{display:block}
.unstyled dl dt{font-weight:400;font-style:normal}
ol.arabic{list-style-type:decimal}
ol.decimal{list-style-type:decimal-leading-zero}
ol.loweralpha{list-style-type:lower-alpha}
ol.upperalpha{list-style-type:upper-alpha}
ol.lowerroman{list-style-type:lower-roman}
ol.upperroman{list-style-type:upper-roman}
ol.lowergreek{list-style-type:lower-greek}
.hdlist>table,.colist>table{border:0;background:none}
.hdlist>table>tbody>tr,.colist>table>tbody>tr{background:none}
td.hdlist1,td.hdlist2{vertical-align:top;padding:0 .625em}
td.hdlist1{font-weight:bold;padding-bottom:1.25em}
.literalblock+.colist,.listingblock+.colist{margin-top:-.5em}
.colist>table tr>td:first-of-type{padding:0 .75em;line-height:1}
.colist>table tr>td:last-of-type{padding:.25em 0}
.thumb,.th{line-height:0;display:inline-block;border:solid 4px #fff;-webkit-box-shadow:0 0 0 1px #ddd;box-shadow:0 0 0 1px #ddd}
.imageblock.left,.imageblock[style*="float: left"]{margin:.25em .625em 1.25em 0}
.imageblock.right,.imageblock[style*="float: right"]{margin:.25em 0 1.25em .625em}
.imageblock>.title{margin-bottom:0}
.imageblock.thumb,.imageblock.th{border-width:6px}
.imageblock.thumb>.title,.imageblock.th>.title{padding:0 .125em}
.image.left,.image.right{margin-top:.25em;margin-bottom:.25em;display:inline-block;line-height:0}
.image.left{margin-right:.625em}
.image.right{margin-left:.625em}
a.image{text-decoration:none;display:inline-block}
a.image object{pointer-events:none}
sup.footnote,sup.footnoteref{font-size:.875em;position:static;vertical-align:super}
sup.footnote a,sup.footnoteref a{text-decoration:none}
sup.footnote a:active,sup.footnoteref a:active{text-decoration:underline}
#footnotes{padding-top:.75em;padding-bottom:.75em;margin-bottom:.625em}
#footnotes hr{width:20%;min-width:6.25em;margin:-.25em 0 .75em 0;border-width:1px 0 0 0}
#footnotes .footnote{padding:0 .375em 0 .225em;line-height:1.3334;font-size:.875em;margin-left:1.2em;text-indent:-1.05em;margin-bottom:.2em}
#footnotes .footnote a:first-of-type{font-weight:bold;text-decoration:none}
#footnotes .footnote:last-of-type{margin-bottom:0}
#content #footnotes{margin-top:-.625em;margin-bottom:0;padding:.75em 0}
.gist .file-data>table{border:0;background:#fff;width:100%;margin-bottom:0}
.gist .file-data>table td.line-data{width:99%}
div.unbreakable{page-break-inside:avoid}
.big{font-size:larger}
.small{font-size:smaller}
.underline{text-decoration:underline}
.overline{text-decoration:overline}
.line-through{text-decoration:line-through}
.aqua{color:#00bfbf}
.aqua-background{background-color:#00fafa}
.black{color:#000}
.black-background{background-color:#000}
.blue{color:#0000bf}
.blue-background{background-color:#0000fa}
.fuchsia{color:#bf00bf}
.fuchsia-background{background-color:#fa00fa}
.gray{color:#606060}
.gray-background{background-color:#7d7d7d}
.green{color:#006000}
.green-background{background-color:#007d00}
.lime{color:#00bf00}
.lime-background{background-color:#00fa00}
.maroon{color:#600000}
.maroon-background{background-color:#7d0000}
.navy{color:#000060}
.navy-background{background-color:#00007d}
.olive{color:#606000}
.olive-background{background-color:#7d7d00}
.purple{color:#600060}
.purple-background{background-color:#7d007d}
.red{color:#bf0000}
.red-background{background-color:#fa0000}
.silver{color:#909090}
.silver-background{background-color:#bcbcbc}
.teal{color:#006060}
.teal-background{background-color:#007d7d}
.white{color:#bfbfbf}
.white-background{background-color:#fafafa}
.yellow{color:#bfbf00}
.yellow-background{background-color:#fafa00}
span.icon>.fa{cursor:default}
.admonitionblock td.icon [class^="fa icon-"]{font-size:2.5em;text-shadow:1px 1px 2px rgba(0,0,0,.5);cursor:default}
.admonitionblock td.icon .icon-note:before{content:"\f05a";color:#19407c}
.admonitionblock td.icon .icon-tip:before{content:"\f0eb";text-shadow:1px 1px 2px rgba(155,155,0,.8);color:#111}
.admonitionblock td.icon .icon-warning:before{content:"\f071";color:#bf6900}
.admonitionblock td.icon .icon-caution:before{content:"\f06d";color:#bf3400}
.admonitionblock td.icon .icon-important:before{content:"\f06a";color:#bf0000}
.conum[data-value]{display:inline-block;color:#fff!important;background-color:rgba(0,0,0,.8);-webkit-border-radius:100px;border-radius:100px;text-align:center;font-size:.75em;width:1.67em;height:1.67em;line-height:1.67em;font-family:"Open Sans","DejaVu Sans",sans-serif;font-style:normal;font-weight:bold}
.conum[data-value] *{color:#fff!important}
.conum[data-value]+b{display:none}
.conum[data-value]:after{content:attr(data-value)}
pre .conum[data-value]{position:relative;top:-.125em}
b.conum *{color:inherit!important}
.conum:not([data-value]):empty{display:none}
dt,th.tableblock,td.content,div.footnote{text-rendering:optimizeLegibility}
h1,h2,p,td.content,span.alt{letter-spacing:-.01em}
p strong,td.content strong,div.footnote strong{letter-spacing:-.005em}
p,blockquote,dt,td.content,span.alt{font-size:1.0625rem}
p{margin-bottom:1.25rem}
.sidebarblock p,.sidebarblock dt,.sidebarblock td.content,p.tableblock{font-size:1em}
.exampleblock>.content{background-color:#fffef7;border-color:#e0e0dc;-webkit-box-shadow:0 1px 4px #e0e0dc;box-shadow:0 1px 4px #e0e0dc}
.print-only{display:none!important}
@media print{@page{margin:1.25cm .75cm}
*{-webkit-box-shadow:none!important;box-shadow:none!important;text-shadow:none!important}
a{color:inherit!important;text-decoration:underline!important}
a.bare,a[href^="#"],a[href^="mailto:"]{text-decoration:none!important}
a[href^="http:"]:not(.bare):after,a[href^="https:"]:not(.bare):after{content:"(" attr(href) ")";display:inline-block;font-size:.875em;padding-left:.25em}
abbr[title]:after{content:" (" attr(title) ")"}
pre,blockquote,tr,img,object,svg{page-break-inside:avoid}
thead{display:table-header-group}
svg{max-width:100%}
p,blockquote,dt,td.content{font-size:1em;orphans:3;widows:3}
h2,h3,#toctitle,.sidebarblock>.content>.title{page-break-after:avoid}
#toc,.sidebarblock,.exampleblock>.content{background:none!important}
#toc{border-bottom:1px solid #ddddd8!important;padding-bottom:0!important}
.sect1{padding-bottom:0!important}
.sect1+.sect1{border:0!important}
#header>h1:first-child{margin-top:1.25rem}
body.book #header{text-align:center}
body.book #header>h1:first-child{border:0!important;margin:2.5em 0 1em 0}
body.book #header .details{border:0!important;display:block;padding:0!important}
body.book #header .details span:first-child{margin-left:0!important}
body.book #header .details br{display:block}
body.book #header .details br+span:before{content:none!important}
body.book #toc{border:0!important;text-align:left!important;padding:0!important;margin:0!important}
body.book #toc,body.book #preamble,body.book h1.sect0,body.book .sect1>h2{page-break-before:always}
.listingblock code[data-lang]:before{display:block}
#footer{background:none!important;padding:0 .9375em}
#footer-text{color:rgba(0,0,0,.6)!important;font-size:.9em}
.hide-on-print{display:none!important}
.print-only{display:block!important}
.hide-for-print{display:none!important}
.show-for-print{display:inherit!important}}
</style>
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.5.0/css/font-awesome.min.css">
</head>
<body class="article">
<div id="header">
<h1>Exercises and notes for book "Haskell Programming from first principles" - Unofficial</h1>
<div id="toc" class="toc">
<div id="toctitle">Table of Contents</div>
<ul class="sectlevel1">
<li><a href="#_1_all_you_need_is_lambda">1 All you need is lambda</a>
<ul class="sectlevel2">
<li><a href="#_1_6_multiple_arguments">1.6 Multiple arguments</a></li>
<li><a href="#_1_11_exercises">1.11 Exercises</a></li>
</ul>
</li>
<li><a href="#_2_hello_haskell">2 Hello, Haskell!</a>
<ul class="sectlevel2">
<li><a href="#_2_5_functions">2.5 Functions</a></li>
<li><a href="#_2_6_infix_operators">2.6 Infix Operators</a></li>
<li><a href="#_2_7_declaring_values">2.7 Declaring values</a></li>
<li><a href="#_2_12_let_and_where">2.12 Let and where</a></li>
<li><a href="#_2_13_chapter_exercises">2.13 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_3_string_simple_operations_with_text">3 String: Simple Operations with Text</a>
<ul class="sectlevel2">
<li><a href="#_3_4_top_level_versus_local_definitions">3.4 Top-level versus local definitions</a></li>
<li><a href="#_3_5_types_of_concatenation_functions">3.5 Types of concatenation functions</a></li>
<li><a href="#_3_8_chapter_exercises">3.8 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_4_basic_datatypes">4 Basic datatypes</a>
<ul class="sectlevel2">
<li><a href="#_4_2_anatomy_of_a_data_declaration">4.2 Anatomy of a data declaration</a></li>
<li><a href="#_4_4_comparing_values">4.4 Comparing values</a></li>
<li><a href="#_4_7_chapter_exercises">4.7 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_5_types">5 Types</a>
<ul class="sectlevel2">
<li><a href="#_5_4_typeclass_constrained_type_variables">5.4 Typeclass-constrained type variables</a></li>
<li><a href="#_5_5_currying">5.5 Currying</a></li>
<li><a href="#_5_6_polymorphism">5.6 Polymorphism</a></li>
<li><a href="#_5_7_type_inference">5.7 Type inference</a></li>
<li><a href="#_5_9_chapter_exercises">5.9 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_6_typeclasses">6 Typeclasses</a>
<ul class="sectlevel2">
<li><a href="#_6_7_ord">6.7 Ord</a></li>
<li><a href="#_6_12_writing_instances_for_your_typeclasses">6.12 Writing instances for your typeclasses</a></li>
<li><a href="#_6_14_chapter_exercises">6.14 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_7_more_functional_patterns">7 More functional patterns</a>
<ul class="sectlevel2">
<li><a href="#_7_4_anonymous_functions">7.4 Anonymous functions</a></li>
<li><a href="#_7_5_pattern_matching">7.5 Pattern matching</a></li>
<li><a href="#_7_6_case_expressions">7.6 Case expressions</a></li>
<li><a href="#_7_7_higher_order_functions">7.7 Higher-order functions</a></li>
<li><a href="#_7_8_guards">7.8 Guards</a></li>
<li><a href="#_7_10_pointfree_style">7.10 Pointfree style</a></li>
<li><a href="#_7_12_chapter_exercises">7.12 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_8_recursion">8 Recursion</a>
<ul class="sectlevel2">
<li><a href="#_8_2_factorial">8.2 Factorial</a></li>
<li><a href="#_8_6_chapter_exercises">8.6 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_9_lists">9 Lists</a>
<ul class="sectlevel2">
<li><a href="#_9_5_using_ranges_to_construct_lists">9.5 Using ranges to construct lists</a></li>
<li><a href="#_9_6_extracting_portions_of_lists">9.6 Extracting portions of lists</a></li>
<li><a href="#_9_7_list_comprehensions">9.7 List comprehensions</a></li>
<li><a href="#_9_8_spines_and_non_strict_evaluation">9.8 Spines and non-strict evaluation</a></li>
<li><a href="#_9_9_transforming_lists_of_values">9.9 Transforming lists of values</a></li>
<li><a href="#_9_10_filtering_lists_of_values">9.10 Filtering lists of values</a></li>
<li><a href="#_9_11_zipping_lists">9.11 Zipping lists</a></li>
<li><a href="#_9_12_chapter_exercises">9.12 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_10_folding_lists">10 Folding lists</a>
<ul class="sectlevel2">
<li><a href="#_10_5_fold_left">10.5 Fold left</a></li>
<li><a href="#_10_6_how_to_write_fold_functions">10.6 How to write fold functions</a></li>
<li><a href="#_10_9_scans">10.9 Scans</a></li>
<li><a href="#_10_10_chapter_exercises">10.10 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_11_algebraic_datatypes">11 Algebraic datatypes</a>
<ul class="sectlevel2">
<li><a href="#_11_4_data_constructors_and_values">11.4 Data constructors and values</a></li>
<li><a href="#_11_5_what_s_a_type_and_what_s_data">11.5 What’s a type and what’s data?</a></li>
<li><a href="#_11_7_what_makes_these_datatypes_algebraic">11.7 What makes these datatypes algebraic?</a></li>
<li><a href="#_11_8_sum_types">11.8 Sum types</a></li>
<li><a href="#_11_9_product_types">11.9 Product types</a></li>
<li><a href="#_11_10_normal_form">11.10 Normal form</a></li>
<li><a href="#_11_11_constructing_and_deconstructing_values">11.11 Constructing and deconstructing values</a></li>
<li><a href="#_11_12_function_type_is_exponential">11.12 Function type is exponential</a></li>
<li><a href="#_11_15_binary_tree">11.15 Binary Tree</a></li>
<li><a href="#_11_16_chapter_exercises">11.16 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_12_signaling_adversity">12 Signaling adversity</a>
<ul class="sectlevel2">
<li><a href="#_12_5_chapter_exercises">12.5 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_13_building_projects_in_haskell">13 Building projects in Haskell</a>
<ul class="sectlevel3">
<li><a href="#_differences_between_cabal_and_stack">Differences between cabal and stack</a></li>
<li><a href="#_13_3_working_with_a_basic_project">13.3 Working with a basic project</a></li>
<li><a href="#_13_7_more_on_importing_modules">13.7 More on importing modules</a></li>
<li><a href="#_13_9_do_syntax_and_io">13.9 do syntax and IO</a></li>
<li><a href="#_13_15_chapter_exercises">13.15 Chapter exercises</a></li>
</ul>
</li>
<li><a href="#_14_testing">14 Testing</a>
<ul class="sectlevel2">
<li><a href="#_14_3_conventional_testing">14.3 Conventional testing</a></li>
<li><a href="#_14_5_morse_code">14.5 Morse code</a></li>
<li><a href="#_14_7_chapter_exercises">14.7 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_15_monoid_semigroup">15 Monoid, Semigroup</a>
<ul class="sectlevel2">
<li><a href="#_15_10_reusing_algebras_by_asking_for_algebras">15.10 Reusing algebras by asking for algebras</a></li>
<li><a href="#_15_11_madness">15.11 Madness</a></li>
<li><a href="#_15_12_better_living_through_quickcheck">15.12 Better living through QuickCheck</a></li>
<li><a href="#_15_14_chapter_exercises">15.14 Chapter exercises</a></li>
</ul>
</li>
<li><a href="#_16_functor">16 Functor</a>
<ul class="sectlevel2">
<li><a href="#_16_4_let_s_talk_about_f_baby">16.4 Let’s talk about f , baby</a></li>
<li><a href="#_16_7_commonly_used_functors">16.7 Commonly used functors</a></li>
<li><a href="#_16_10_intermission_exercises">16.10 Intermission: Exercises</a></li>
<li><a href="#_16_11_ignoring_possibilities">16.11 Ignoring possibilities</a></li>
<li><a href="#_16_17_chapter_exercises">16.17 Chapter exercises</a></li>
</ul>
</li>
<li><a href="#_17_applicative">17 Applicative</a>
<ul class="sectlevel2">
<li><a href="#_17_5_applicative_in_use">17.5 Applicative in use</a></li>
<li><a href="#_17_8_ziplist_monoid">17.8 ZipList Monoid</a></li>
<li><a href="#_17_9_chapter_exercises">17.9 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_18_monad">18 Monad</a>
<ul class="sectlevel2">
<li><a href="#_18_2_sorry_monad_is_not_a_burrito">18.2 Sorry — Monad is not a burrito</a></li>
<li><a href="#_18_4_examples_of_monad_use">18.4 Examples of Monad use</a></li>
<li><a href="#_18_5_monad_laws">18.5 Monad laws</a></li>
<li><a href="#_18_7_chapter_exercises">18.7 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_19_applying_structure">19 Applying structure</a></li>
<li><a href="#_20_foldable">20 Foldable</a>
<ul class="sectlevel2">
<li><a href="#_20_5_some_basic_derived_operations">20.5 Some basic derived operations</a></li>
<li><a href="#_20_6_chapter_exercises">20.6 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_21_traversable">21 Traversable</a>
<ul class="sectlevel2">
<li><a href="#_21_12_chapter_exercises">21.12 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_22_reader">22 Reader</a>
<ul class="sectlevel2">
<li><a href="#_22_2_a_new_beginning">22.2 A new beginning</a></li>
<li><a href="#_22_5_but_uh_reader">22.5 But uh, Reader?</a></li>
<li><a href="#_22_6_functions_have_an_applicative_too">22.6 Functions have an Applicative too</a></li>
<li><a href="#_22_7_the_monad_of_functions">22.7 The Monad of functions</a></li>
<li><a href="#_22_11_chapter_exercises">22.11 Chapter Exercises</a></li>
</ul>
</li>
<li><a href="#_23_state">23 State</a>
<ul class="sectlevel2">
<li><a href="#_23_5_throw_down">23.5 Throw down</a></li>
<li><a href="#_23_6_write_state_for_yourself">23.6 Write State for yourself</a></li>
<li><a href="#_23_7_get_a_coding_job_with_one_weird_trick">23.7 Get a coding job with one weird trick</a></li>
<li><a href="#_23_8_chapter_exercises">23.8 Chapter exercises</a></li>
</ul>
</li>
<li><a href="#_24_parser_combinators">24 Parser combinators</a>
<ul class="sectlevel2">
<li><a href="#_24_3_understanding_the_parsing_process">24.3 Understanding the parsing process</a></li>
<li><a href="#_24_4_parsing_fractions">24.4 Parsing fractions</a></li>
<li><a href="#_24_6_alternative">24.6 Alternative</a></li>
<li><a href="#_24_7_parsing_configuration_files">24.7 Parsing configuration files</a></li>
<li><a href="#_24_11_chapter_exercises">24.11 Chapter Exercises</a></li>
</ul>
</li>
</ul>
</div>
</div>
<div id="content">
<div id="preamble">
<div class="sectionbody">
<div class="paragraph">
<p>This is <strong>UNOFFICIAL</strong>. In this document you will find finished exercises (hopefully without bugs) and notes for the book <strong>Haskell Programming from first principles</strong> from <strong>Chris Allen</strong> and <strong>Julie Moronuki</strong>. More details about the book and a place where to purchase it - <a href="http://haskellbook.com/" class="bare">http://haskellbook.com/</a></p>
</div>
<div class="paragraph">
<p>Sources for this documents are at <a href="https://github.com/lukleh/haskell-book-exercises" class="bare">https://github.com/lukleh/haskell-book-exercises</a></p>
</div>
<div class="admonitionblock important">
<table>
<tr>
<td class="icon">
<i class="fa icon-important" title="Important"></i>
</td>
<td class="content">
These are my personal notes and solved exercises for the book. I did this for myself and thought it may as well help others. I claim nothing. As I progress in book, I try to update this document.
</td>
</tr>
</table>
</div>
<div class="admonitionblock note">
<table>
<tr>
<td class="icon">
<i class="fa icon-note" title="Note"></i>
</td>
<td class="content">
This document is written in asciidoc, use Asciidoctor to build <code>asciidoctor index.adoc</code>
</td>
</tr>
</table>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_1_all_you_need_is_lambda">1 All you need is lambda</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_1_6_multiple_arguments">1.6 Multiple arguments</h3>
<div class="sect3">
<h4 id="_intermission_exercises">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>b) <code>λxy.xz</code> equals <code>λmn.mz</code></p>
</li>
<li>
<p>c) <code>λxy.xxy</code> equals <code>λa(λb.aab)</code></p>
</li>
<li>
<p>b) <code>λxyz.zx</code> equals <code>λtos.st</code></p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_1_11_exercises">1.11 Exercises</h3>
<div class="sect3">
<h4 id="_combinators">Combinators</h4>
<div class="paragraph">
<p>Combinator is lambda term with no free variable</p>
</div>
<div class="paragraph">
<p><code>λxyz.xz(yz) &#8594; λyz.yz(z) &#8594; λz.zz</code></p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>λx.xxx</code>       - yes</p>
</li>
<li>
<p><code>λxy.zx</code>       - no, <code>z</code> not in head</p>
</li>
<li>
<p><code>λxyz.xy(zx)</code>  - yes</p>
</li>
<li>
<p><code>λxyz.xy(zxy)</code> - yes</p>
</li>
<li>
<p><code>λxy.xy(zxy)</code>  - no, <code>z</code> not in head</p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_normal_form_or_diverge">Normal form or diverge</h4>
<div class="paragraph">
<p>Diverge - reduction does not end</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>λx.xxx</code>          - converge, no reduction</p>
</li>
<li>
<p><code>(λz.zzz)(λy.yy)</code> - diverge, <code>(λz.zzz)(λy.yy) &#8594; (λy.yy)(λy.yy)(λy.yy) &#8594; λy.yy)(λy.yy(λy.yy)</code> into more nested expressions. Also, alpha-equivalent to divergent example <code>(λx.xx)(λx.xx)</code></p>
</li>
<li>
<p><code>(λx.xxx)z</code>       - converge, <code>(λx.xxx)z &#8594; zzz</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_beta_reduce">Beta reduce</h4>
<div class="paragraph">
<p>Reduce in normal order (leftmost outermost first). Otherwise you get different results.</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>(λabc.cba)zz(λwv.w) &#8594; (λa.λb.λc.cba)zz(λw.λv.w) &#8594; (λb.λc.cbz)z(λw.λv.w) &#8594; (λc.czz)(λw.λv.w) &#8594; (λw.λv.w)zz &#8594; (λv.z)z &#8594; z</code></p>
</li>
<li>
<p><code>(λx.λy.xyy)(λa.a)b &#8594; (λy.(λa.a)yy)b &#8594; (λa.a)bb &#8594; bb</code></p>
</li>
<li>
<p><code>(λy.y)(λx.xx)(λz.zq) &#8594; (λx.xx)(λz.zq) &#8594; (λz.zq)(λz.zq) &#8594; (λz.zq)q &#8594; qq</code></p>
</li>
<li>
<p><code>(λz.z)(λz.zz)(λz.zy) &#8594; (λz.zz)(λz.zy) &#8594; (λz.zy)(λz.zy) &#8594; (λz.zy)y &#8594; yy</code></p>
</li>
<li>
<p><code>(λx.λy.xyy)(λy.y)y &#8594; (λy.(λy.y)yy)y &#8594; (λy.y)yy &#8594; yy</code></p>
</li>
<li>
<p><code>(λa.aa)(λb.ba)c &#8594; (λb.ba)(λb.ba)c &#8594; ((λb.ba)a)c &#8594; aac</code></p>
</li>
<li>
<p><code>(λxyz.xz(yz))(λx.z)(λx.a) &#8594; (λx.λy.λz.xz(yz))(λx.z)(λx.a) &#8594; (λy.λz1.(λx.z)z1(yz1))(λx.a) &#8594; (λz1.(λx.z)z1λx.a)z1 &#8594; (λz1.zλx.a)z1 &#8594; λz1.za</code></p>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_2_hello_haskell">2 Hello, Haskell!</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_2_5_functions">2.5 Functions</h3>
<div class="sect3">
<h4 id="_exercises_comprehension_check">Exercises: Comprehension Check</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">let half x = x / 2

let square x = x * x</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">dpi x = 3.14 * x * x</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">dpi x = pi * x * x</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_2_6_infix_operators">2.6 Infix Operators</h3>
<div class="sect3">
<h4 id="_associativity_and_precedence">Associativity and precedence</h4>
<div class="paragraph">
<p>Higher precedence is applied first. Scale is 0-9.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Prelude&gt; :info (^)
(^) :: (Num a, Integral b) =&gt; a -&gt; b -&gt; a   -- Defined in ‘GHC.Real’
infixr 8 ^</code></pre>
</div>
</div>
<div class="paragraph">
<p>Left associative</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">2 * 3 * 4
-- is evaluated as if it was
(2 * 3) * 4</code></pre>
</div>
</div>
<div class="paragraph">
<p>Right associative</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Prelude&gt; 2 ^ 3 ^ 4
2417851639229258349412352
Prelude&gt; 2 ^ (3 ^ 4)
2417851639229258349412352
Prelude&gt; (2 ^ 3) ^ 4
4096</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_exercises_parentheses_and_association">Exercises: Parentheses and Association</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Different, because <code>(*)</code> has a higher precedence than <code>(+)</code> (7 vs. 6)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">8 + 7 * 9 = 71
(8 + 7) * 9 = 135</code></pre>
</div>
</div>
</li>
<li>
<p>The same, based on the same precedence comparison as 1</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">perimeter x y = (x * 2) + (y * 2)
perimeter x y = x * 2 + y * 2</code></pre>
</div>
</div>
</li>
<li>
<p>Different, because <code>(/)</code> has a higher precedence than <code>(+)</code> (7 vs. 6)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f x = x / 2 + 9
f x = x / (2 + 9)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_2_7_declaring_values">2.7 Declaring values</h3>
<div class="sect3">
<h4 id="_exercises_heal_the_sick">Exercises: Heal the Sick</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Erroneous space after 3</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">let area x = 3. 14 * (x * x)
-- fix
let area x = 3.14 * (x * x)</code></pre>
</div>
</div>
</li>
<li>
<p><code>b</code> not defined in scope of <code>double</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">let double x = b * 2
-- fix
let double x = x * 2</code></pre>
</div>
</div>
</li>
<li>
<p>Improper alignment, top-level expressions should be defined on the same level of indentation</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">-- file ch02_2.6_1.hs
x = 7
 y = 10
f = x + y

Prelude&gt; :l ch02_2.6_1.hs
[1 of 1] Compiling Main             ( ch02_2.6_1.hs, interpreted )

ch02_2.6_1.hs:2:4: parse error on input ‘=’
Failed, modules loaded: none.

-- fixed
x = 7
y = 10
f = x + y</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_2_12_let_and_where">2.12 Let and where</h3>
<div class="sect3">
<h4 id="_exercises_a_head_code">Exercises: A Head Code</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">let x = 5 in x
-- 5
let x = 5 in x * x
-- 25
let x = 5; y = 6 in x * y
-- 30
let x = 3; y = 1000 in x + 3
-- 6</code></pre>
</div>
</div>
<div class="paragraph">
<p><code><strong>let</strong></code> rewritten to <code><strong>where</strong></code></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f1 = x
    where x = 5

f2 = x * x
    where x = 5

f3 = x * y
    where x = 5
          y = 6

f4 = x + 3
   where x = 3
         y = 1000</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_let_rewritten_to_where_for_new_expressions">let rewritten to where for new expressions</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">--let x = 3; y = 1000 in x * 3 + y
f1 = x * 3 + y
    where x = 3
          y = 1000

--let y = 10; x = 10 * 5  + y in x * 5
f2 = x * 5
    where y = 10
          x = 10 * 5 + y

--let x = 7; y = negate x; z = y * 10 in z / x + y
f3 = z / x + y
    where x = 7
          y = negate x
          z = y * 10</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_2_13_chapter_exercises">2.13 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_parenthesization">Parenthesization</h4>
<div class="paragraph">
<p>(Ignoring single-element and whole-element parenthesization)</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">2 + 2 * 3 - 1
2 + (2 * 3) - 1
(2 + (2 * 3)) - 1</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(^) 10 $ 1 + 1
(^) 10 $ (1 + 1)</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">2 ^ 2 * 4 ^ 5 + 1
(2 ^ 2) * 4 ^ 5 + 1
(2 ^ 2) * (4 ^ 5) + 1
((2^2) * (4 ^ 5)) + 1</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_equivalent_expressions">Equivalent Expressions</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Equivalent</p>
</li>
<li>
<p>Equivalent (<code>10 ^ 2 = 100</code>, <code>10 + 9 * 10 == 10 + (9 * 10) == 10 + 90 = 100</code>)</p>
</li>
<li>
<p>Non-equivalent (<code>400 - 37 = 363</code>, <code>(-) 37 400 == 37 - 400 = 363</code>)</p>
</li>
<li>
<p>Non-equivalent (<code>div 100 3 = 33</code>, <code>100/3 == 33.33..</code>)</p>
</li>
<li>
<p>Non-equivalent (<code>2 * 5 + 18 == (2 * 5) + 18 == 10 + 18 = 28</code>, <code>2 * (5 + 8) = 2 * 23 = 46</code>)</p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_more_fun_with_functions">More fun with functions</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">z = 7
x = y ^ 2
waxOn = x * 5
y = z + 8</code></pre>
</div>
</div>
<div class="paragraph">
<p>to REPL</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">let z = 7
let y = z + 8
let x = y ^ 2
let waxOn = x * 5</code></pre>
</div>
</div>
<div class="paragraph">
<p><code>waxOn == 1125</code></p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>waxOn</strong></code> results</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">10 + waxOn
-- 1135
(+10) waxOn
-- 1135
(-) 15 waxOn
-- -1110
(-) waxOn 15
-- 1110</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>triple</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">let triple x = x * 3
triple waxOn
-- 3375</code></pre>
</div>
</div>
</li>
<li>
<p>where waxOn</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">waxOn = x * 5
    where z = 7
          y = z + 8
          x = y ^ 2</code></pre>
</div>
</div>
</li>
<li>
<p>rest</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">waxOn = x * 5
    where z = 7
          y = z + 8
          x = y ^ 2

triple x = x * 3

waxOff x = triple x</code></pre>
</div>
</div>
<div class="paragraph">
<p><code><strong>waxOff</strong></code> is <code><strong>triple</strong></code><br>
<code><strong>waxOff waxOn</strong></code> is <code><strong>triple waxOn</strong></code></p>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_3_string_simple_operations_with_text">3 String: Simple Operations with Text</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_3_4_top_level_versus_local_definitions">3.4 Top-level versus local definitions</h3>
<div class="sect3">
<h4 id="_exercises_scope">Exercises: Scope</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Yes, <code>y</code> in scope for <code>z</code></p>
</li>
<li>
<p>No, <code>h</code> is not in scope for <code>g</code></p>
</li>
<li>
<p>No, <code>d</code> is local to <code>area</code> and thus out of scope in <code>r = d / 2</code></p>
</li>
<li>
<p>Yes, <code>r</code> and <code>p</code> are in scope for <code>area</code></p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_3_5_types_of_concatenation_functions">3.5 Types of concatenation functions</h3>
<div class="sect3">
<h4 id="_exercises_syntax_errors">Exercises: Syntax Errors</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Does nto compile because infix operator is used as prefix</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">++ [1, 2, 3] [4, 5, 6]
-- fix
(++) [1, 2, 3] [4, 5, 6]</code></pre>
</div>
</div>
</li>
<li>
<p>Does not compile due to incorrect symbol surrounding strings</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">'&lt;3' ++ ' Haskell'
--fix
"&lt;3" ++ " Haskell"</code></pre>
</div>
</div>
</li>
<li>
<p>Compiles. Result: "&lt;3 Haskell"</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">concat ["&lt;3", " Haskell"]</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_3_8_chapter_exercises">3.8 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_reading_syntax">Reading syntax</h4>
<div class="paragraph">
<p>Fixing Errors:</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">concat [[1, 2, 3], [4, 5, 6]]
-- Working

++ [1, 2, 3] [4, 5, 6]
-- Incorrect (infix used as prefix). Fix:
(++) [1, 2, 3] [4, 5, 6]

(++) "hello" " world"
-- Working

["hello" ++ " world]
-- Incorrect (missing closing "). Fix:
["hello" ++ " world"]

4 !! "hello"
-- Incorrect (order of arguments). Fix:
"hello" !! 4

(!!) "hello" 4
-- Working

take "4 lovely"
-- Incorrect (placement of opening "). Fix:
take 4 "lovely"

take 3 "awesome"
-- Working</code></pre>
</div>
</div>
<div class="paragraph">
<p>Pair code with result</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">-- a) - d)
concat [[1 * 6], [2 * 6], [3 * 6]]
[6,12,18]

-- b) - c)
"rain" ++ drop 2 "elbow"
"rainbow"

-- c) - e)
10 * head [1, 2, 3]
10

-- d) - a)
(take 3 "Julie") ++ (tail "yes")
"Jules"

-- e) - b)
concat [tail [1, 2, 3], tail [4, 5, 6], tail [7, 8, 9]]
[2,3,5,6,8,9]</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_building_functions">Building functions</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>String/list manipulation functions (includes 1 and 2)</p>
</li>
</ol>
</div>
<div class="listingblock">
<div class="content">
<pre>-- f1 str = str ++ "!"
f1 :: String -&gt; String
f1 = (++"!")

f2 :: String -&gt; String
f2 str = ((take 1).(drop 4)) str

f3 :: String -&gt; String
-- f3 str = drop 9 str
f3 = drop 9</pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>thirdLetter</strong></code></p>
</li>
</ol>
</div>
<div class="listingblock">
<div class="content">
<pre>thirdLetter :: String -&gt; Char
-- thirdLetter str = str !! 2
thirdLetter = (!! 2)</pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Letter index</p>
</li>
</ol>
</div>
<div class="listingblock">
<div class="content">
<pre>letterIndex :: Int -&gt; Char
letterIndex n = "Curry is awesome!" !! (n - 1)</pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Reverse function using <code>drop</code> and <code>take</code> (for fixed input)</p>
</li>
</ol>
</div>
<div class="listingblock">
<div class="content">
<pre>import Data.List.Split

rvrs :: String
-- rvrs = three ++ " " ++ two ++ " " ++ one
--   where str = "Curry is awesome"
--         one = take 5 str
--         two = ((take 2) . (drop 6)) str
--         three = drop 9 str
rvrs = unwords . reverse $ splitOn " " "Curry is awesome"</pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Extension of previous</p>
</li>
</ol>
</div>
<div class="listingblock">
<div class="content">
<pre>module Reverse where

import Data.List.Split

rvrs :: String -&gt; String
rvrs str = unwords . reverse $ splitOn " " str

main = print $ rvrs "Curry is awesome"</pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_4_basic_datatypes">4 Basic datatypes</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_4_2_anatomy_of_a_data_declaration">4.2 Anatomy of a data declaration</h3>
<div class="paragraph">
<p>given data type, answer</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Mood = Blah | Woot deriving Show</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>type constructor is <code>Mood</code></p>
</li>
<li>
<p>values are <code>Blah</code> and <code>Woot</code></p>
</li>
<li>
<p><code>:: Mood &#8594; Woot</code> to <code>:: Mood &#8594; Mood</code>, as <code>Woot</code> is value, not type</p>
</li>
<li>
<p>change mood</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Mood = Blah | Woot deriving Show
changeMood :: Mood -&gt; Mood
changeMood Blah = Woot
changeMood _ = Blah</code></pre>
</div>
</div>
</li>
<li>
<p>done :)</p>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_4_4_comparing_values">4.4 Comparing values</h3>
<div class="sect3">
<h4 id="_intermission_exercises_2">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>bug</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">not True &amp;&amp; true
-- fix
not True &amp;&amp; True</code></pre>
</div>
</div>
</li>
<li>
<p>bug</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">not (x = 6)
-- fix
not (x == 6)</code></pre>
</div>
</div>
</li>
<li>
<p>correct</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(1 * 2) &gt; 5</code></pre>
</div>
</div>
</li>
<li>
<p>bug</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">[Merry] &gt; [Happy]
-- fix
["Merry"] &gt; ["Happy"]</code></pre>
</div>
</div>
</li>
<li>
<p>bug</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">[1, 2, 3] ++ "look at me!"
-- fix
['1', '2', '3'] ++ "look at me!"</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_4_7_chapter_exercises">4.7 Chapter Exercises</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">awesome = ["Papuchon", "curry", "Haskell"]
alsoAwesome = ["Quake", "The Simons"]
allAwesome = [awesome, alsoAwesome]</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>length</p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>type signature</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">:: [a] -&gt; Int</code></pre>
</div>
</div>
</li>
<li>
<p>takes one argument</p>
</li>
<li>
<p>result is <code>Int</code></p>
</li>
</ol>
</div>
</li>
<li>
<p>results</p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p><code>length [1, 2, 3, 4, 5] == 5</code></p>
</li>
<li>
<p><code>length [(1, 2), (2, 3), (3, 4)] == 3</code></p>
</li>
<li>
<p><code>length allAwesome == 2</code></p>
</li>
<li>
<p><code>length (concat allAwesome) == 5</code></p>
</li>
</ol>
</div>
</li>
<li>
<p>second breaks</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">-- works
6 / 3
-- both values need to be Fractional, length returns Int
6 / length [1, 2, 3]</code></pre>
</div>
</div>
</li>
<li>
<p>fixed previous example</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">6 `div` length [1, 2, 3]</code></pre>
</div>
</div>
</li>
<li>
<p><code>2 + 3 == 5</code> type is <code>Bool</code> and result is <code>True</code> as <code>5 == 5</code></p>
</li>
<li>
<p>type is <code>Bool</code>, result is <code>False</code> as <code>8 /= 5</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Prelude&gt; let x = 5
Prelude&gt; x + 3 == 5</code></pre>
</div>
</div>
</li>
<li>
<p>as follows</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Prelude&gt; length allAwesome == 2
-- works - True
Prelude&gt; length [1, 'a', 3, 'b']
-- breaks on types, list cannot be heterogenic
Prelude&gt; length allAwesome + length awesome
-- works - 5
Prelude&gt; (8 == 8) &amp;&amp; ('b' &lt; 'a')
-- works - False
Prelude&gt; (8 == 8) &amp;&amp; 9
-- breaks - 9 is not a Bool</code></pre>
</div>
</div>
</li>
<li>
<p>palidrome function</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">isPalindrome :: (Eq a) =&gt; [a] -&gt; Bool
isPalindrome x = reverse x == x</code></pre>
</div>
</div>
</li>
<li>
<p>return absolute value</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myAbs :: Integer -&gt; Integer
myAbs x = if x &lt; 0 then negate x else x</code></pre>
</div>
</div>
</li>
<li>
<p>tuple function</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: (a, b) -&gt; (c, d) -&gt; ((b, d), (a, c))
f x y = ((snd x, snd y), (fst x, fst y))</code></pre>
</div>
</div>
</li>
</ol>
</div>
<div class="sect3">
<h4 id="_reading_syntax_2">Reading Syntax</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>length + 1</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">x = (+)
f xs = w `x` 1
    where w = length xs</code></pre>
</div>
</div>
</li>
<li>
<p>identity</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">\x -&gt; x</code></pre>
</div>
</div>
</li>
<li>
<p>head</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">\ (x:xs) -&gt; x</code></pre>
</div>
</div>
</li>
<li>
<p>fst</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f (a, b) = a</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_match_the_function_names_to_their_types">Match the function names to their types</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>c) <code>Show a &#8658; a &#8594; String</code></p>
</li>
<li>
<p>b) <code>Eq a &#8658; a &#8594; a &#8594; Bool</code></p>
</li>
<li>
<p>a) <code>(a, b) &#8594; a</code></p>
</li>
<li>
<p>d) <code>Num a &#8658; a &#8594; a &#8594; a</code></p>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_5_types">5 Types</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_5_4_typeclass_constrained_type_variables">5.4 Typeclass-constrained type variables</h3>
<div class="sect3">
<h4 id="_intermission_exercises_3">Intermission: Exercises</h4>
<div class="paragraph">
<p>pair functions and signatures</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>a) c)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">not :: Bool -&gt; Bool</code></pre>
</div>
</div>
</li>
<li>
<p>b) d)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">length :: [a] -&gt; Int</code></pre>
</div>
</div>
</li>
<li>
<p>c) b)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">concat :: [[a]] -&gt; [a]</code></pre>
</div>
</div>
</li>
<li>
<p>d) a)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">head :: [a] -&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>e) e)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(&lt;) :: Ord a =&gt; a -&gt; a -&gt; Bool</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_5_5_currying">5.5 Currying</h3>
<div class="paragraph">
<p>test like this</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Prelude&gt; let f :: a -&gt; a -&gt; a -&gt; a; f = undefined
Prelude&gt; :t f undefined
f undefined :: a -&gt; a -&gt; a
Prelude&gt; :t f 1
f 1 :: Num a =&gt; a -&gt; a -&gt; a
Prelude&gt; :t f (1 :: Int)
f (1 :: Int) :: Int -&gt; Int -&gt; Int</code></pre>
</div>
</div>
<div class="sect3">
<h4 id="_intermission_exercises_4">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>a)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: a -&gt; a -&gt; a -&gt; a
f 'a' :: Char -&gt; Char -&gt; Char</code></pre>
</div>
</div>
</li>
<li>
<p>d)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">g :: a -&gt; b -&gt; c -&gt; b
g 0 'c' "woot" :: Char</code></pre>
</div>
</div>
</li>
<li>
<p>d)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">h :: (Num a, Num b) =&gt; a -&gt; b -&gt; b
h 1.0 2 :: Num b =&gt; b</code></pre>
</div>
</div>
</li>
<li>
<p>c)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">h :: (Num a, Num b) =&gt; a -&gt; b -&gt; b
h 1 (5.5 :: Double) :: Double</code></pre>
</div>
</div>
</li>
<li>
<p>a)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">jackal :: (Ord a, Eq b) =&gt; a -&gt; b -&gt; a
jackal "keyboard" "has the word jackal in it" :: [Char]</code></pre>
</div>
</div>
</li>
<li>
<p>e)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">jackal :: (Ord a, Eq b) =&gt; a -&gt; b -&gt; a
jackal "keyboard" "has the word jackal in it" :: Eq b =&gt; b -&gt; [Char]</code></pre>
</div>
</div>
</li>
<li>
<p>d)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">kessel :: (Ord a, Num b) =&gt; a -&gt; b -&gt; a
kessel 1 2 :: (Num a, Ord a) =&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>a)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">kessel :: (Ord a, Num b) =&gt; a -&gt; b -&gt; a
kessel 1 (2 :: Integer) :: (Num a, Ord a) =&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>c)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">kessel :: (Ord a, Num b) =&gt; a -&gt; b -&gt; a
kessel (1 :: Integer) 2 :: Integer</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_5_6_polymorphism">5.6 Polymorphism</h3>
<div class="sect3">
<h4 id="_intermission_exercises_5">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>id</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: a -&gt; a
f a = a</code></pre>
</div>
</div>
</li>
<li>
<p>return first or second argument</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: a -&gt; a -&gt; a
f a b = a
f a b = b</code></pre>
</div>
</div>
</li>
<li>
<p>only one implementation, like id</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: a -&gt; b -&gt; b
f a b = b</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_5_7_type_inference">5.7 Type inference</h3>
<div class="sect3">
<h4 id="_intermission_exercises_6">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>[Char] &#8594; [Char]</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(++) :: [a] -&gt; [a] -&gt; [a]
myConcat x = x ++ " yo"</code></pre>
</div>
</div>
</li>
<li>
<p><code>Fractional a &#8658; a &#8594; a</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(*) :: Num a =&gt; a -&gt; a -&gt; a
myMult x = (x / 3) * 5</code></pre>
</div>
</div>
</li>
<li>
<p><code>Int &#8594; [Char]</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take :: Int -&gt; [a] -&gt; [a]
myTake x = take x "hey you"</code></pre>
</div>
</div>
</li>
<li>
<p><code>Int &#8594; Bool</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(&gt;) :: Ord a =&gt; a -&gt; a -&gt; Bool
myCom x = x &gt; (length [1..10])</code></pre>
</div>
</div>
</li>
<li>
<p><code>Char &#8594; Bool</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(&lt;) :: Ord a =&gt; a -&gt; a -&gt; Bool
myAlph x = x &lt; 'z'</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_5_9_chapter_exercises">5.9 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_multiple_choice">Multiple choice</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>c) value of type <code><strong>[a]</strong></code> is a list whose elements are all of some type <code><strong>a</strong></code></p>
</li>
<li>
<p>a) function of type <code><strong>[[a]] &#8594; [a]</strong></code> could take a list of strings as an argument</p>
</li>
<li>
<p>b) function of type <code><strong>[a] &#8594; Int &#8594; a</strong></code> returns one element of type <code>a</code> from a list</p>
</li>
<li>
<p>c) function of type <code><strong>(a, b) &#8594; a</strong></code> takes a tuple argument and returns the first value</p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_determine_the_type">Determine the type</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>return value and type</p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p><code>54 :: Num a &#8658; a</code></p>
</li>
<li>
<p><code>(0, "doge) :: Num t &#8658; (t, [Char])</code></p>
</li>
<li>
<p><code>(0, "doge) :: (Integer, [Char])</code></p>
</li>
<li>
<p><code>False :: Bool</code></p>
</li>
<li>
<p><code>5 :: Int</code></p>
</li>
<li>
<p><code>False :: Bool</code></p>
</li>
</ol>
</div>
</li>
<li>
<p>type is <code>Num a &#8658; a</code></p>
</li>
<li>
<p><code>y</code> is shadowed, type is <code>Num a &#8658; a &#8594; a</code></p>
</li>
<li>
<p>type is <code>Fractional &#8658; a :: a</code></p>
</li>
<li>
<p>type is <code>[Char]</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_does_it_compile">Does it compile?</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>wahoo = bigNum $ 10</code> breaks, because <code>bigNum</code> is a value, not a function</p>
</li>
<li>
<p>works fine in GHCI, should work too in file</p>
</li>
<li>
<p>breaks on <code>c = b 10</code>, <code>b</code> has value <code>5</code>, cannot apply value to a value</p>
</li>
<li>
<p>breaks on <code>b = 10000 * c</code>, <code>c</code> is not defined</p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_type_variable_or_specific_type_constructor">Type variable or specific type constructor?</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>f :: zed &#8594; Zed &#8594; Blah</code> is fully polymorphic, concrete and concrete</p>
</li>
<li>
<p><code>f :: Enum b &#8658; a &#8594; b &#8594; C</code> is fully polymorphic, constrained polymorphic and concrete</p>
</li>
<li>
<p><code>f :: f &#8594; g &#8594; C</code> is fully polymorphic, fully polymorphic and concrete</p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_write_a_type_signature">Write a type signature</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>functionH (x:_) = x</code> type signature <code>functionH :: [a] &#8594; a</code></p>
</li>
<li>
<p><code>functionC x y = if (x &gt; y) then True else False</code> type signature <code>functionC :: Ord a &#8658; a &#8594; a &#8594; Bool</code></p>
</li>
<li>
<p><code>functionS (x, y) = y</code> type signature <code>functionS :: (a, b) &#8594; b</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_given_a_type_write_the_function">Given a type, write the function</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>i :: a &#8594; a; i a = a</code> or <code>id</code></p>
</li>
<li>
<p><code>c :: a &#8594; b &#8594; a; c a _ = a</code></p>
</li>
<li>
<p><code>c'' :: b &#8594; a &#8594; b; c :: a &#8594; b &#8594; a</code> they are the same</p>
</li>
<li>
<p><code>c' :: a &#8594; b &#8594; b; c _ b = b</code></p>
</li>
<li>
<p><code>r :: [a] &#8594; [a]</code> possibly <code>r a = tail a</code> or <code>r a = reverse a</code></p>
</li>
<li>
<p><code>co :: (b &#8594; c) &#8594; (a &#8594; b) &#8594; (a &#8594; c); co = (.)</code></p>
</li>
<li>
<p><code>a :: (a &#8594; c) &#8594; a &#8594; a; a f x = x</code> basically ignore the first argument</p>
</li>
<li>
<p><code>a' :: (a &#8594; b) &#8594; a &#8594; b; a' = ($)</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_fix_it">Fix it</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Sing where

fstString :: [Char] -&gt; [Char]
fstString x = x ++ " in the rain"

sndString :: [Char] -&gt; [Char]
sndString x = x ++ " over the rainbow"

sing = if (x &gt; y) then fstString x else sndString y
    where x = "Singin"
          y = "Somewhere"</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Sing where

fstString :: [Char] -&gt; [Char]
fstString x = x ++ " in the rain"

sndString :: [Char] -&gt; [Char]
sndString x = x ++ " over the rainbow"

sing = if (x &lt; y) then fstString x else sndString y
    where x = "Singin"
          y = "Somewhere"</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Arith3Broken where

main :: IO ()
main = do
    print $ 1 + 2
    putStrLn $ show 10
    print (negate (-1))
    print ((+) 0 blah)
    where blah = negate 1</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_type_kwon_do">Type-Kwon-Do</h4>
<div class="paragraph">
<p>full example for this section, it is al only about type checking</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Woot

data Blah

f :: Woot -&gt; Blah
f = undefined

g :: (Blah, Woot) -&gt; (Blah, Blah)
g (x, y) = (x, f y)</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>just a composition</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: Int -&gt; String
f = undefined

g :: String -&gt; Char
g = undefined

h :: Int -&gt; Char
h = g . f</code></pre>
</div>
</div>
</li>
<li>
<p>also a composition</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data A
data B
data C

q :: A -&gt; B
q = undefined

w :: B -&gt; C
w = undefined

e :: A -&gt; C
e = w . q</code></pre>
</div>
</div>
</li>
<li>
<p>once u got the point, it is kinda easy</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data X
data Y
data Z

xz :: X -&gt; Z
xz = undefined

yz :: Y -&gt; Z
yz = undefined

xform :: (X, Y) -&gt; (Z, Z)
xform (x, y) = (xz x, yz y)</code></pre>
</div>
</div>
</li>
<li>
<p>neat</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">munge :: (x -&gt; y) -&gt; (y -&gt; (w, z)) -&gt; x -&gt; w
munge f g = fst . g . f</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_6_typeclasses">6 Typeclasses</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_6_7_ord">6.7 Ord</h3>
<div class="sect3">
<h4 id="_intermission_exercises_7">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>will work, result <code><strong>5</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">max (length [1, 2, 3]) (length [8, 9, 10, 11, 12])</code></pre>
</div>
</div>
</li>
<li>
<p>will work, result <code><strong>LT</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">compare (3 * 4) (3 * 5)</code></pre>
</div>
</div>
</li>
<li>
<p>will not work, parameters are different type</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">compare "Julie" True</code></pre>
</div>
</div>
</li>
<li>
<p>will work, result <code><strong>False</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(5 + 3) &gt; (3 + 6)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_6_12_writing_instances_for_your_typeclasses">6.12 Writing instances for your typeclasses</h3>
<div class="sect3">
<h4 id="_intermission_exercises_8">Intermission: Exercises</h4>
<div class="paragraph">
<p>Write the <code><strong>Eq</strong></code> instance for the datatype provided</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>TisAnInteger</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data TisAnInteger =
    TisAn Integer

instance Eq TisAnInteger where
    (==) (TisAn a) (TisAn b) = a == b</code></pre>
</div>
</div>
</li>
<li>
<p>TwoIntegers</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data TwoIntegers =
    Two Integer Integer

instance Eq TwoIntegers where
    (==) (Two a1 a2) (Two b1 b2) = a1 == b1 &amp;&amp; a2 == b2</code></pre>
</div>
</div>
</li>
<li>
<p>StringOrInt</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data StringOrInt =
    TisAnInt Int
  | TisAString String

instance Eq StringOrInt where
    (==) (TisAnInt a) (TisAnInt b) = a == b
    (==) (TisAString a) (TisAString b) = a == b
    (==) _ _ = False</code></pre>
</div>
</div>
</li>
<li>
<p>Pair a</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Pair a =
    Pair a a

instance Eq a =&gt; Eq (Pair a) where
    (==) (Pair a1 a2) (Pair b1 b2) = a1 == b1 &amp;&amp; a2 == b2</code></pre>
</div>
</div>
</li>
<li>
<p>Tuple a b</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Tuple a b =
    Tuple a b

instance (Eq a, Eq b) =&gt; Eq (Tuple a b) where
    (==) (Tuple a1 a2) (Tuple b1 b2) = a1 == b1 &amp;&amp; a2 == b2</code></pre>
</div>
</div>
</li>
<li>
<p>Which a</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Which a =
    ThisOne a
  | ThatOne a

instance Eq a =&gt; Eq (Which a) where
    (==) (ThisOne a) (ThisOne b) = a == b
    (==) (ThatOne a) (ThatOne b) = a == b
    (==) _ _ = False</code></pre>
</div>
</div>
</li>
<li>
<p>EitherOr a b</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data EitherOr a b =
    Hello a
  | Goodbye b

instance (Eq a, Eq b) =&gt; Eq (EitherOr a b) where
    (==) (Hello a) (Hello b) = a == b
    (==) (Goodbye a) (Goodbye b) = a == b
    (==) _ _ = False</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_6_14_chapter_exercises">6.14 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_multiple_choice_2">Multiple choice</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>c) The <code><strong>Eq</strong></code> class makes equality tests possible</p>
</li>
<li>
<p>b) The typeclass <code><strong>Ord</strong></code> is a subclass of <code><strong>Eq</strong></code></p>
</li>
<li>
<p>a) Type of <code><strong>&gt;</strong></code> is <code><strong>Ord a &#8658; a &#8594; a &#8594; Bool</strong></code></p>
</li>
<li>
<p>c) the type of x is a tuple in <code><strong>x = divMod 16 12</strong></code></p>
</li>
<li>
<p>a) The typeclass <code><strong>Integral</strong></code> includes <code><strong>Int</strong></code> and <code><strong>Integer</strong></code> numbers - and <code>Word</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_does_it_typecheck">Does it typecheck?</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>data <code><strong>Person</strong></code> need to to be instance of <code><strong>Show</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Person = Person Bool deriving Show
printPerson :: Person -&gt; IO ()
printPerson person = putStrLn (show person)</code></pre>
</div>
</div>
</li>
<li>
<p>data <code><strong>Mood</strong></code> need to to be instance of <code><strong>Eq</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Mood = Blah
          | Woot deriving (Show, Eq)

settleDown x = if x == Woot
                then Blah
                else x</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>settleDown</strong></code></p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>inputs can be <code><strong>Woot</strong></code> or <code><strong>Blah</strong></code></p>
</li>
<li>
<p>type error <code>No instance for (Num Mood) arising from the literal ‘9’</code> - different types and <code>Mood</code> is not in <code>Num</code></p>
</li>
<li>
<p><code><strong>Blah &gt; Woot</strong></code> raises error, because <code><strong>Mood</strong></code> is not instance of <code><strong>Ord</strong></code></p>
</li>
</ol>
</div>
</li>
<li>
<p>following code type checks</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">type Subject = String
type Verb = String
type Object = String

data Sentence =
    Sentence Subject Verb Object
    deriving (Eq, Show)

s1 = Sentence "dogs" "drool"
s2 = Sentence "Julie" "loves" "dogs"</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_given_a_datatype_declaration_what_can_we_do">Given a datatype declaration, what can we do?</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Rocks =
    Rocks String deriving (Eq, Show)

data Yeah =
    Yeah Bool deriving (Eq, Show)

data Papu =
    Papu Rocks Yeah
    deriving (Eq, Show)</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Does not typecheck, <code><strong>Papu</strong></code> parameters are not well constructed.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">phew = Papu "chases" True
-- fix
phew = Papu (Rocks "chases") (Yeah True)</code></pre>
</div>
</div>
</li>
<li>
<p>Does typecheck.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">truth = Papu (Rocks "chomskydoz")
             (Yeah True)</code></pre>
</div>
</div>
</li>
<li>
<p>Does typecheck.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">equalityForall :: Papu -&gt; Papu -&gt; Bool
equalityForall p p' = p == p'</code></pre>
</div>
</div>
</li>
<li>
<p>Does not typecheck, <code><strong>Papu</strong></code> is not an instance of <code><strong>Ord</strong></code>.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">comparePapus :: Papu -&gt; Papu -&gt; Bool
comparePapus p p' = p &gt; p'</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_match_the_types">Match the types</h4>
<div class="paragraph">
<p>can you substitute signature</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Value <code>1</code> cannot be an needs at least <code><strong>Num</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">i :: Num a =&gt; a
i = 1

i :: a
-- No instance for (Num a) arising from the literal ‘1’</code></pre>
</div>
</div>
</li>
<li>
<p>Value <code>1.0</code> cannot be an instance on <code><strong>Num</strong></code>, it does not work with all the sub classes of <code><strong>Num</strong></code>. For example <code>1.0</code> cannot be <code><strong>Int</strong></code>.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: Float
f = 1.0

f :: Num a =&gt; a
-- error: Could not deduce (Fractional a) arising from the literal ‘1.0’ from the context (Num a)</code></pre>
</div>
</div>
</li>
<li>
<p>Value <code>1.0</code> works for class <code>Fractional</code> and all it&#8217;s subclasses and instances, which is also <code>Float</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: Float
f = 1.0

f :: Fractional a =&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>Value <code>1.0</code> works for class <code>RealFrac</code> and all it&#8217;s subclasses and instances.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: Float
f = 1.0

f :: RealFrac a =&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>identity function works for all values/instances of all classes</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">freud :: a -&gt; a
freud x = x

freud :: Ord a =&gt; a -&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>identity function works for type <code><strong>Int</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">freud' :: a -&gt; a
freud' x = x

freud' :: Int -&gt; Int</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myX</strong></code> is type <code><strong>Int</strong></code>, <code><strong>sigmund</strong></code> is then defined without type constraines, but the real type is <code><strong>a &#8594; Int</strong></code> so <code>a &#8594; a</code> breaks</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myX = 1 :: Int

sigmund :: Int -&gt; Int
sigmund x = myX

sigmund :: a -&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myX</strong></code> is type <code><strong>Int</strong></code>, <code><strong>sigmund'</strong></code> is then defined with <code><strong>Num</strong></code> type constrain, but the real type is <code><strong>a &#8594; Int</strong></code> so <code>Num a &#8658; a &#8594; a</code> breaks</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myX = 1 :: Int

sigmund' :: Int -&gt; Int
sigmund' x = myX

sigmund' :: Num a =&gt; a -&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>works, <code><strong>Int</strong></code> is instance of <code><strong>Ord</strong></code> and signature of <code><strong>jung</strong></code> matches that of <code><strong>sort</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">jung :: Ord a =&gt; [a] -&gt; a
jung xs = head (sort xs)

jung :: [Int] -&gt; Int</code></pre>
</div>
</div>
</li>
<li>
<p>works, signature of <code><strong>young</strong></code> is the same as signature of <code><strong>sort</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">young :: [Char] -&gt; Char
young xs = head (sort xs)

young :: Ord a =&gt; [a] -&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>breaks, <code><strong>signifier</strong></code> is more constrained - by <code><strong>mySort</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">mySort :: [Char] -&gt; [Char]
mySort = sort

signifier :: [Char] -&gt; Char
signifier xs = head (mySort xs)

signifier :: Ord a =&gt; [a] -&gt; a</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_type_kwon_do_2">Type-Kwon-Do</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>we need function that does at the end <code>Eq a &#8658; a &#8594; a &#8594; Bool</code>, there are multiple implementation, choosing the most basic one <code>(==)</code>. we can also just ignore all the params and always return <code>Bool</code> like <code>True</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">chk :: Eq b =&gt; (a -&gt; b) -&gt; a -&gt; b -&gt; Bool
chk f a b = (f a) == b</code></pre>
</div>
</div>
</li>
<li>
<p>the trick here is to use <code>fromInteger</code> to get <code>Num a</code>. wondering how can you make more generic type from more concrete type&#8230;&#8203;.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">arith :: Num b =&gt; (a -&gt; b) -&gt; Integer -&gt; a -&gt; b
arith f i a = (f a) + (fromInteger i)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_7_more_functional_patterns">7 More functional patterns</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_7_4_anonymous_functions">7.4 Anonymous functions</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>all are equal</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">mTh x y z = x * y * z
mTh x y = \z -&gt; x * y * z
mTh x = \y -&gt; \z -&gt; x * y * z
mTh = \x -&gt; \y -&gt; \z -&gt; x * y * z</code></pre>
</div>
</div>
</li>
<li>
<p>d) type of <code><strong>mTh 3</strong></code> is</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Num a =&gt; a -&gt; a -&gt; a</code></pre>
</div>
</div>
</li>
<li>
<p>as anonymous function</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">addOneIfOdd n = case odd n of
    True -&gt; (\x -&gt; x + 1) n
    False -&gt; n</code></pre>
</div>
</div>
</li>
<li>
<p>as anonymous function - two arguments</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">\x y -&gt; ((if x &gt; y then y else x) + 5)</code></pre>
</div>
</div>
</li>
<li>
<p>as anonymous function - three arguments nested</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">\f -&gt; \x -&gt; \y -&gt; f y x</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_7_5_pattern_matching">7.5 Pattern matching</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>given following declarations</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">k (x, y) = x
k1 = k ((4-1), 10)
k2 = k ("three", (1 + 2))
k3 = k (3, True)</code></pre>
</div>
</div>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>type of <code><strong>k</strong></code> is <code><strong>(a, b) &#8594; a</strong></code></p>
</li>
<li>
<p>type of <code><strong>k2</strong></code> is <code><strong>String</strong></code> and is different from <code><strong>k1</strong></code> and <code><strong>k3</strong></code></p>
</li>
<li>
<p><code><strong>k3</strong></code> and <code><strong>k1</strong></code> will return <code><strong>3</strong></code></p>
</li>
</ol>
</div>
</li>
<li>
<p>completed definitions</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: (a, b, c) -&gt; (d, e, f) -&gt; ((a, d), (c, f))
f (a, b, c) (d, e, f) = ((a, d), (c, f))</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_7_6_case_expressions">7.6 Case expressions</h3>
<div class="sect3">
<h4 id="_intermission_exercises_9">Intermission: Exercises</h4>
<div class="paragraph">
<p>rewrite <code><strong>if-then-else</strong></code> expressions into case expressions</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">functionC x y = if (x &gt; y) then x else y

functionC' x y = case x &gt; y of
    True -&gt; x
    False -&gt; y


ifEvenAdd2 n = if even n then (n+2) else n

ifEvenAdd2' n = case even n of
    True -&gt; n + 2
    False -&gt; n</code></pre>
</div>
</div>
<div class="paragraph">
<p>cover all cases (missing <code>EQ</code>)</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">nums x =
    case compare x 0 of
        LT -&gt; -1
        GT -&gt; 1
        EQ -&gt; 0</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_7_7_higher_order_functions">7.7 Higher-order functions</h3>
<div class="sect3">
<h4 id="_intermission_exercises_10">Intermission: Exercises</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">dodgy :: Num a =&gt; a -&gt; a -&gt; a
dodgy x y = x + y * 10

oneIsOne :: Num a =&gt; a -&gt; a
oneIsOne = dodgy 1

oneIsTwo :: Num a =&gt; a -&gt; a
oneIsTwo = (flip dodgy) 2</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>dodgy 1 0 == 1</code></p>
</li>
<li>
<p><code>dodgy 1 1 == 11</code></p>
</li>
<li>
<p><code>dodgy 2 2 == 22</code></p>
</li>
<li>
<p><code>dodgy 1 2 == 21</code></p>
</li>
<li>
<p><code>dodgy 2 1 == 12</code></p>
</li>
<li>
<p><code>oneIsOne 1 == 11</code></p>
</li>
<li>
<p><code>oneIsOne 2 == 21</code></p>
</li>
<li>
<p><code>oneIsTwo 2 == 22</code></p>
</li>
<li>
<p><code>oneIsOne 3 == 31</code></p>
</li>
<li>
<p><code>oneIsTwo 3 == 23</code></p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_7_8_guards">7.8 Guards</h3>
<div class="sect3">
<h4 id="_intermission_exercises_11">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>otherwise</code> does not change behaviour</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">avgGrade :: (Fractional a, Ord a) =&gt; a -&gt; Char
avgGrade x
    | y &gt;= 0.9 = 'A'
    | y &gt;= 0.8 = 'B'
    | y &gt;= 0.7 = 'C'
    | y &gt;= 0.59 = 'D'
    | otherwise = 'F'
    where y = x / 100</code></pre>
</div>
</div>
</li>
<li>
<p>if <code>y &gt;= 0.7</code> is first, that is where <code>y &gt;= 0.9 = 'A'</code> was, then <code>y &gt;= 0.9</code> never becomes <code>True</code> as it is always caught by <code>y &gt;= 0.7</code>. Passing <code>90</code> returns <code>C</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">avgGrade :: (Fractional a, Ord a) =&gt; a -&gt; Char
avgGrade x
    | y &gt;= 0.7 = 'C'
    | y &gt;= 0.9 = 'A'
    | y &gt;= 0.8 = 'B'
    | y &gt;= 0.59 = 'D'
    | otherwise = 'F'
    where y = x / 100</code></pre>
</div>
</div>
</li>
<li>
<p>b) <code><strong>True</strong></code> when <code><strong>xs</strong></code> is a palidrome</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">pal xs
    | xs == reverse xs = True
    | otherwise = False</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>pal</strong></code> can take <code><strong>Eq a &#8658; [a]</strong></code> as an argument</p>
</li>
<li>
<p><code><strong>pal :: Eq a &#8658; [a] &#8594; Bool</strong></code></p>
</li>
<li>
<p>function bellow returns c) (argument is a positive or negative number)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">numbers x
    | x &lt; 0 = -1
    | x == 0 = 0
    | x &gt; 0 = 1</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>numbers :: (Num a, Ord a) &#8658; a</strong></code></p>
</li>
<li>
<p><code><strong>numbers :: (Num a, Num a1, Ord a1) &#8658; a1 &#8594; a</strong></code></p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_7_10_pointfree_style">7.10 Pointfree style</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Arith2 where
add :: Int -&gt; Int -&gt; Int
add x y = x + y

addPF :: Int -&gt; Int -&gt; Int
addPF = (+)

addOne :: Int -&gt; Int
addOne = \x -&gt; x + 1

addOnePF :: Int -&gt; Int
addOnePF = (+1)

main :: IO ()
main = do
    print (0 :: Int) -- 0
    print (add 1 0) -- 1
    print (addOne 0) -- 1
    print (addOnePF 0) -- 1
    print ((addOne . addOne) 0) -- 2
    print ((addOnePF . addOne) 0) -- 2
    print ((addOne . addOnePF) 0) -- 2
    print ((addOnePF . addOnePF) 0) -- 2
    print (negate (addOne 0)) -- -1
    print ((negate . addOne) 0) -- -1
    print ((addOne . addOne . addOne . negate . addOne) 0) -- 2</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_7_12_chapter_exercises">7.12 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_multiple_choice_3">Multiple choice</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>d) polymorphic function may resolve to values of different types, depending on inputs</p>
</li>
<li>
<p>b) <code><strong>Char &#8594; [String]</strong></code> for <code><strong>g . f</strong></code> where <code><strong>f :: Char &#8594; String</strong></code> and <code><strong>g :: String
&#8594; [String]</strong></code></p>
</li>
<li>
<p>d) <code><strong>(Ord a, Num a) &#8658; a &#8594; Bool</strong></code> for <code><strong>f :: Ord a &#8658; a &#8594; a &#8594; Bool</strong></code> applied to one numeric argument</p>
</li>
<li>
<p>b) is a higher-order function - <code><strong>(a &#8594; b) &#8594; c</strong></code></p>
</li>
<li>
<p>a) <code><strong>f True :: Bool</strong></code> where <code><strong>f</strong></code> is</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">f :: a -&gt; a
f x = x</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_let_s_write_code">Let’s write code</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>this function</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">tensDigit :: Integral a =&gt; a -&gt; a
tensDigit x = d
    where xLast = x `div` 10
          d     = xLast `mod` 10</code></pre>
</div>
</div>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>using <code><strong>divMod</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">tensDigit :: Integral a =&gt; a -&gt; a
tensDigit x = d
    where xLast = fst $ divMod x 10
          d     = snd $ divMod xLast 10</code></pre>
</div>
</div>
</li>
<li>
<p>type signature is the same</p>
</li>
<li>
<p>hunderds</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">hunsD :: Integral a =&gt; a -&gt; a
hunsD x = d
    where x1 = fst $ divMod x 100
          d  = snd $ divMod x1 10</code></pre>
</div>
</div>
</li>
</ol>
</div>
</li>
<li>
<p>function <code><strong>a &#8594; a &#8594; Bool &#8594; a</strong></code></p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>case expression</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">foldBool :: a -&gt; a -&gt; Bool -&gt; a
foldBool x y z =
    case z of
    True -&gt; x
    False -&gt; y</code></pre>
</div>
</div>
</li>
<li>
<p>guards</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">foldBool :: a -&gt; a -&gt; Bool -&gt; a
foldBool x y z
    | z = x
    | otherwise = y</code></pre>
</div>
</div>
</li>
</ol>
</div>
</li>
<li>
<p>filled definition</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">g :: (a -&gt; b) -&gt; (a, c) -&gt; (b, c)
g f (x, y) = (f x, y)

-- *Main&gt; g show (1, 2)
-- ("1",2)</code></pre>
</div>
</div>
</li>
<li>
<p>look in the next point</p>
</li>
<li>
<p>pointfree version, <code><strong>roundTrip :: (Read a, Show a) &#8658; a &#8594; a</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Arith4 where

-- id :: a -&gt; a
-- id x = x

roundTrip :: (Show a, Read a) =&gt; a -&gt; a
roundTrip = read . show

main = do
    print (roundTrip 4)
    print (id 4)</code></pre>
</div>
</div>
</li>
<li>
<p>manually force <code><strong>Int</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Arith4 where

-- id :: a -&gt; a
-- id x = x

roundTrip :: (Show a, Read b) =&gt; a -&gt; b
roundTrip = read . show

main = do
    print ((roundTrip 4) :: Int)
    print (id 4)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_8_recursion">8 Recursion</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_8_2_factorial">8.2 Factorial</h3>
<div class="sect3">
<h4 id="_intermission_exercise">Intermission: Exercise</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">applyTimes 5 (+1) 5
(+1) (applyTimes (5 - 1) (+1) 5)
(+1) ((+1) (applyTimes (4 - 1) (+1) 5))
(+1) ((+1) ((+1) (applyTimes (3 - 1) (+1) 5)))
(+1) ((+1) ((+1) ((+1) (applyTimes (2 - 1) (+1) 5))))
(+1) ((+1) ((+1) ((+1) ((+1) (applyTimes (1 - 1) (+1) 5)))))
(+1) ((+1) ((+1) ((+1) ((+1) (5)))))</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_8_6_chapter_exercises">8.6 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_review_of_types">Review of types</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>d) <code><strong>[[Bool]]</strong></code> is type of <code><strong>[[True, False], [True, True], [False, True]]</strong></code></p>
</li>
<li>
<p>b) <code><strong>[[3 == 3], [6 &gt; 5], [3 &lt; 4]]</strong></code> is the same type as <code><strong>[[True, False], [True, True], [False, True]]</strong></code></p>
</li>
<li>
<p>d) all of the above</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">func :: [a] -&gt; [a] -&gt; [a]
func x y = x ++ y</code></pre>
</div>
</div>
</li>
<li>
<p>b) <code><strong>func "Hello" "World"</strong></code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_reviewing_currying">Reviewing currying</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">cattyConny :: String -&gt; String -&gt; String
cattyConny x y = x ++ " mrow " ++ y

-- fill in the types
flippy :: String -&gt; String -&gt; String
flippy = flip cattyConny

appedCatty :: String -&gt; String
appedCatty = cattyConny "woops"

frappe :: String -&gt; String
frappe = flippy "haha"</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>value of <code><strong>appedCatty "woohoo!"</strong></code> is <code><strong>"woops mrow woohoo!"</strong></code></p>
</li>
<li>
<p>value of <code><strong>frappe "1"</strong></code> is <code><strong>"1 mrow haha"</strong></code></p>
</li>
<li>
<p>value of <code><strong>frappe (appedCatty "2")</strong></code> is <code><strong>woops mrow 2 mrow haha"</strong></code></p>
</li>
<li>
<p>value of <code><strong>appedCatty (frappe "blue")</strong> is `<strong>"woops mrow blue mrow haha"</strong></code></p>
</li>
<li>
<p>value of <code><strong>cattyConny (frappe "pink") (cattyConny "green" (appedCatty "blue"))</strong></code> is <code><strong>"pink mrow haha mrow green mrow woops mrow blue"</strong></code></p>
</li>
<li>
<p>value of <code><strong>cattyConny (flippy "Pugs" "are") "awesome"</strong></code> is <code><strong>"are mrow Pugs mrow awesome"</strong></code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_recursion">Recursion</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>step of <code><strong>dividedBy 15 2</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">dividedBy :: Integral a =&gt; a -&gt; a -&gt; (a, a)
dividedBy num denom = go num denom 0
    where go n d count
            | n &lt; d = (count, n)
            | otherwise = go (n - d) d (count + 1)</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">dividedBy 15 2 =
go 15 2 0
| otherwise = go (15 - 2) 2 (0 + 1)
go 13 2 1
| otherwise = go (13 - 2) 2 (1 + 1)
go 11 2 2
| otherwise = go (11 - 2) 2 (2 + 1)
go 9 2 3
| otherwise = go (9 - 2) 2 (3 + 1)
go 7 2 4
| otherwise = go (7 - 2) 2 (4 + 1)
go 5 2 5
| otherwise = go (5 - 2) 2 (5 + 1)
go 3 2 6
| otherwise = go (3 - 2) 2 (6 + 1)
go 1 2 7
| 1 &lt; 2 = (7, 1)</code></pre>
</div>
</div>
</li>
<li>
<p>recursive sum function</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">recSum :: (Eq a, Num a) =&gt; a -&gt; a
recSum n = go n 0
    where go n acc
            | n == 0 = acc
            | otherwise = go (n - 1) (acc + n)</code></pre>
</div>
</div>
</li>
<li>
<p>recursive multiplication</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">recMul :: (Integral a) =&gt; a -&gt; a -&gt; a
recMul n m = go n m 0
    where go n m acc
            | m == 0 = acc
            | otherwise = go n (m - 1) (acc + n)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_fixing_dividedby">Fixing dividedBy</h4>
<div class="paragraph">
<p>Type of divideBy changed to match DividedResult.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data DividedResult =
      Result Integer
    | DividedByZero deriving Show

dividedBy :: Integer -&gt; Integer -&gt; DividedResult
dividedBy num denom
    | denom == 0 = DividedByZero
    | otherwise = go (abs num) (abs denom) 0 ((signum num) * (signum denom))
    where go n d count s
            | n &lt; d = Result (s * count)
            | otherwise = go (n - d) d (count + 1) s</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_mccarthy_91_function">McCarthy 91 function</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">mc91 n
  | n &gt; 100 = n - 10
  | otherwise = (mc91 . mc91) (n + 11)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_numbers_into_words">Numbers into words</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module WordNumber where

import Data.List (intersperse)

digitToWord :: Int -&gt; String
digitToWord n =
    case n of
        0 -&gt; "zero"
        1 -&gt; "one"
        2 -&gt; "two"
        3 -&gt; "three"
        4 -&gt; "four"
        5 -&gt; "five"
        6 -&gt; "six"
        7 -&gt; "seven"
        8 -&gt; "eight"
        9 -&gt; "nine"

digits :: Int -&gt; [Int]
digits n = go n []
    where go a xs
            | a &gt; 9 = go (div a 10) ((mod a 10):xs)
            | otherwise = a:xs
            where

wordNumber :: Int -&gt; String
wordNumber = concat . intersperse "-" . map digitToWord . digits</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_9_lists">9 Lists</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_9_5_using_ranges_to_construct_lists">9.5 Using ranges to construct lists</h3>
<div class="sect3">
<h4 id="_exercise">Exercise</h4>
<div class="paragraph">
<p>The trick here was to use <code>fromEnum</code> and <code>toEnum</code> to get <code>Int</code> and avoid using <code>Ord</code> constrain in the signature. Got this insight from reading the <code>Enum</code> class source code - <a href="http://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Enum.html#Enum" class="bare">http://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Enum.html#Enum</a></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myEnumFromTo :: Enum a =&gt; a -&gt; a -&gt; [a]
myEnumFromTo x y
      | xi &gt; yi = []
      | otherwise = x : myEnumFromToi (succ xi) yi
      where xi = fromEnum x
            yi = fromEnum y
            myEnumFromToi a b
                | a &gt; b = []
                | otherwise = (toEnum a) : myEnumFromToi (succ a) b</code></pre>
</div>
</div>
<div class="paragraph">
<p>Writing my own <code>enumFromTo</code> for the following types is kind a of arbitrary since I did <code>myEnumFromTo</code>.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">eftBool :: Bool -&gt; Bool -&gt; [Bool]
eftBool = undefined

eftOrd :: Ordering -&gt; Ordering -&gt; [Ordering]
eftOrd = undefined

eftInt :: Int -&gt; Int -&gt; [Int]
eftInt = undefined

eftChar :: Char -&gt; Char -&gt; [Char]
eftChar = undefined</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_9_6_extracting_portions_of_lists">9.6 Extracting portions of lists</h3>
<div class="sect3">
<h4 id="_intermission_exercises_12">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>make <code><strong>words</strong></code> function using <code><strong>dropWhile</strong></code> and <code><strong>takeWhile</strong></code></p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>first attempt</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myWords :: [Char] -&gt; [[Char]]
myWords [] = []
myWords a@(x:xs)
    | x == ' ' = myWords xs
    | otherwise = (takeWhile (\c -&gt; c /= ' ') a) : myWords (dropWhile (\c -&gt; c /= ' ') a)</code></pre>
</div>
</div>
</li>
<li>
<p>no need for lambdas</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myWords :: [Char] -&gt; [[Char]]
myWords [] = []
myWords a@(x:xs)
    | x == ' ' = myWords xs
    | otherwise = (takeWhile (/= ' ') a) : myWords (dropWhile (/= ' ') a)</code></pre>
</div>
</div>
</li>
<li>
<p>we can turn it into <code>case</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myWords :: [Char] -&gt; [[Char]]
myWords [] = []
myWords xs = case az of
                      [] -&gt; []
                      az -&gt; az : myWords (dropWhile (/= ' ') wsz)
               where wsz = (dropWhile (== ' ') xs)
                     az  = (takeWhile (/= ' ') wsz)</code></pre>
</div>
</div>
</li>
<li>
<p>simplyfy more</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myWords :: [Char] -&gt; [[Char]]
myWords [] = []
myWords xs = case dropWhile (== ' ') xs of
                      [] -&gt; []
                      az -&gt; w : myWords (dropWhile (/= ' ') az)
                            where w = takeWhile (/= ' ') az</code></pre>
</div>
</div>
</li>
<li>
<p>this one is very close to the version in <code>Prelude</code>, using <code>break</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myWords :: [Char] -&gt; [[Char]]
myWords [] = []
myWords xs = case dropWhile (== ' ') xs of
                      [] -&gt; []
                      az -&gt; w : myWords rest
                            where (w, rest) = break (== ' ') az</code></pre>
</div>
</div>
</li>
<li>
<p>and version from the book in the 9.14 Answers chapter. Pretty neat, did not think about matching the space as a pattern.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myWords :: String -&gt; [String]
myWords [] = []
myWords (' ':xs) = myWords xs
myWords xs =  takeWhile (/= ' ') xs:myWords (dropWhile (/= ' ') xs)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</li>
<li>
<p>break <code><strong>String</strong></code> on newlines</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module PoemLines where

firstSen = "Tyger Tyger, burning bright\n"
secondSen = "In the forests of the night\n"
thirdSen = "What immortal hand or eye\n"
fourthSen = "Could frame thy fearful symmetry?"
sentences = firstSen ++ secondSen ++ thirdSen ++ fourthSen

-- putStrLn sentences -- should print
-- Tyger Tyger, burning bright
-- In the forests of the night
-- What immortal hand or eye
-- Could frame thy fearful symmetry?

-- Implement this
myLines :: String -&gt; [String]
myLines [] = []
myLines xs = case dropWhile (== '\n') xs of
                      [] -&gt; []
                      az -&gt; w : myLines rest
                            where (w, rest) = break (== '\n') az

-- This is what we want 'myLines sentences' to equal
shouldEqual =
  [ "Tyger Tyger, burning bright"
  , "In the forests of the night"
  , "What immortal hand or eye"
  , "Could frame thy fearful symmetry?"
  ]

-- The main function here is a small test
-- to ensure you've written your function
-- correctly.
main :: IO ()
main =
  print $ "Are they equal? "
    ++ show (myLines sentences == shouldEqual)</code></pre>
</div>
</div>
</li>
<li>
<p>parametrized <code>myWords</code> and <code>myLines</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">separate :: Char -&gt; [Char] -&gt; [[Char]]
separate _ [] = []
separate sep xs = case dropWhile (== sep) xs of
                      [] -&gt; []
                      az -&gt; w : separate sep rest
                            where (w, rest) = break (== sep) az

-- using purely takeWhile and dropWhile
separate' :: Char -&gt; [Char] -&gt; [[Char]]
separate' _ [] = []
separate' sep xs = w : separate' sep ws
  where w = takeWhile (/= sep) xs
        ws = dropWhile (== sep) (drop (length w) xs)

myWords :: [Char] -&gt; [[Char]]
myWords = separate ' '


myLines :: String -&gt; [String]
myLines = separate '\n'</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_9_7_list_comprehensions">9.7 List comprehensions</h3>
<div class="sect3">
<h4 id="_adding_predicates">Adding predicates</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">mySqr = [x^2 | x &lt;- [1..10]]
-- result
[1,4,9,16,25,36,49,64,81,100]

[x | x &lt;- mySqr, rem x 2 == 0]
-- result
[4,16,36,64,100]

[(x, y) | x &lt;- mySqr, y &lt;- mySqr, x &lt; 50, y &gt; 50]
-- result
[(1,64),(1,81),(1,100),(4,64),(4,81),(4,100),(9,64),(9,81),(9,100),(16,64),(16,81),(16,100),(25,64),(25,81),(25,100),(36,64),(36,81),(36,100),(49,64),(49,81),(49,100)]

take 5 [(x, y) | x &lt;- mySqr, y &lt;- mySqr, x &lt; 50, y &gt; 50]
-- result
[(1,64),(1,81),(1,100),(4,64),(4,81)]</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_list_comprehensions_with_strings">List comprehensions with Strings</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">Prelude&gt; let mySqr = [x^2 | x &lt;- [1..5]]
Prelude&gt; let myCube = [y^3 | y &lt;- [1..5]]</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>tuples of <code><strong>mySqr</strong></code> and <code><strong>myCube</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">[(x, y) | x &lt;- mySqr, y &lt;- myCube]
-- [(1,1),(1,8),(1,27),(1,64),(1,125),(4,1),(4,8),(4,27),(4,64),(4,125),(9,1),(9,8),(9,27),(9,64),(9,125),(16,1),(16,8),(16,27),(16,64),(16,125),(25,1),(25,8),(25,27),(25,64),(25,125)]</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>x</strong></code> and <code><strong>y</strong></code> from previous point that are less than 50</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">[(x, y) | x &lt;- mySqr, y &lt;- myCube, x &lt; 50, y &lt; 50]
-- [(1,1),(1,8),(1,27),(4,1),(4,8),(4,27),(9,1),(9,8),(9,27),(16,1),(16,8),(16,27),(25,1),(25,8),(25,27)]</code></pre>
</div>
</div>
</li>
<li>
<p>number of tuples from previuos point</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">length [(x, y) | x &lt;- mySqr, y &lt;- myCube, x &lt; 50, y &lt; 50]
-- 15</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_9_8_spines_and_non_strict_evaluation">9.8 Spines and non-strict evaluation</h3>
<div class="sect3">
<h4 id="_intermission_exercises_13">Intermission: Exercises</h4>

</div>
<div class="sect3">
<h4 id="_will_it_blow_up">Will it blow up?</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>yes, it gets evaluated to <code><strong>undefined</strong></code> because of <code>x^y</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">[x^y | x &lt;- [1..5], y &lt;- [2, undefined]]</code></pre>
</div>
</div>
</li>
<li>
<p>no, only first element of list get evaluated</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 1 $ [x^y | x &lt;- [1..5], y &lt;- [2, undefined]]</code></pre>
</div>
</div>
</li>
<li>
<p>yes, sum breaks on <code><strong>undefined</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">sum [1, undefined, 3]</code></pre>
</div>
</div>
</li>
<li>
<p>no, <code><strong>length</strong></code> ignores values</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">length [1, 2, undefined]</code></pre>
</div>
</div>
</li>
<li>
<p>yes, <code><strong>undefined</strong></code> is part of spine</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">length $ [1, 2, 3] ++ undefined</code></pre>
</div>
</div>
</li>
<li>
<p>no, evaluates to second list element</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 1 $ filter even [1, 2, 3, undefined]</code></pre>
</div>
</div>
</li>
<li>
<p>yes, <code><strong>take 1</strong></code> forces <code><strong>filter</strong></code> to evaluate until <code><strong>undefined</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 1 $ filter even [1, 3, undefined]</code></pre>
</div>
</div>
</li>
<li>
<p>no, only first element evaluated</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 1 $ filter odd [1, 3, undefined]</code></pre>
</div>
</div>
</li>
<li>
<p>no, only first two elemnts evaluated</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 2 $ filter odd [1, 3, undefined]</code></pre>
</div>
</div>
</li>
<li>
<p>yes, trird element is <code><strong>undefined</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 3 $ filter odd [1, 3, undefined]</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_is_it_in_normal_form">Is it in normal form?</h4>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
not sure
</td>
</tr>
</table>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>WHHNF</code> and <code>NF</code>, all evaluated <code><strong>[1, 2, 3, 4, 5]</strong></code></p>
</li>
<li>
<p><code>WHNF</code> because of <code><strong>_</strong></code> in <code><strong>1 : 2 : 3 : 4 : _</strong></code></p>
</li>
<li>
<p><code>neither</code>, not data constructor <code><strong>enumFromTo 1 10</strong></code></p>
</li>
<li>
<p><code>neither</code>, not data constructor <code><strong>length [1, 2, 3, 4, 5]</strong></code></p>
</li>
<li>
<p><code>neither</code>, not data constructor <code><strong>sum (enumFromTo 1 10)</strong></code></p>
</li>
<li>
<p><code>neither</code>, not data constructor <code><strong>['a'..'m'] ++ ['n'..'z']</strong></code></p>
</li>
<li>
<p><code>WHFN</code>, not all evaluated <code><strong>(_, 'b')</strong></code></p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_9_9_transforming_lists_of_values">9.9 Transforming lists of values</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>will return bottom, <code>take 1</code> evaluates <code>undefined</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 1 $ map (+1) [undefined, 2, 3]</code></pre>
</div>
</div>
</li>
<li>
<p>returns <code>2</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 1 $ map (+1) [1, undefined, 3]</code></pre>
</div>
</div>
</li>
<li>
<p>bottom, second element is <code>undefined</code> and is evaluated by <code>take 2</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">take 2 $ map (+1) [1, undefined, 3]</code></pre>
</div>
</div>
</li>
<li>
<p>function transforms <code>String</code> into a list of <code>Bool</code> depending if character is vovel, type in code</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">itIsMystery :: String -&gt; [Bool]
itIsMystery xs = map (\x -&gt; elem x "aeiou") xs</code></pre>
</div>
</div>
</li>
<li>
<p>results</p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p><code><strong>map (^2) [1..10]</strong></code> evaluates to <code>[1,4,9,16,25,36,49,64,81,100]</code></p>
</li>
<li>
<p><code><strong>map minimum [[1..10], [10..20], [20..30]]</strong></code> evaluates to <code>[1,10,20]</code></p>
</li>
<li>
<p><code><strong>map sum [[1..5], [1..5], [1..5]]</strong></code> evaluates to <code>[15,15,15]</code></p>
</li>
</ol>
</div>
</li>
<li>
<p>rewrite</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Bool (bool)

foldBool :: [Integer] -&gt; [Integer]
foldBool = map (\x -&gt; bool x (-x) (x == 3))</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_9_10_filtering_lists_of_values">9.10 Filtering lists of values</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>filter (\x &#8594; (rem x 3) == 0) [1..30]</strong></code></p>
</li>
<li>
<p><code><strong>(length . filter (\ x &#8594; (rem x 3) == 0)) [1 .. 30]</code></strong></p>
</li>
<li>
<p><code><strong>myFilter = filter (\x &#8594; not (elem x ["the", "a", "an"])) . words</strong></code></p>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_9_11_zipping_lists">9.11 Zipping lists</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>zip</code> implementation, using a little trick that any empty list falls through to the all-catch pattern. Could be written on more lines explicitly matching the empty lists.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">zip' :: [a] -&gt; [b] -&gt; [(a, b)]
zip' (x:xs) (y:ys) = (x, y) : zip' xs ys
zip' _ _ = []</code></pre>
</div>
</div>
</li>
<li>
<p><code>zipWith</code> implementation</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">zipWith' :: (a -&gt; b -&gt; c) -&gt; [a] -&gt; [b] -&gt; [c]
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
zipWith' _ _ _ = []</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_9_12_chapter_exercises">9.12 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_data_char">Data.Char</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>isUpper :: Char &#8594; Bool</strong></code>, <code><strong>toUpper :: Char &#8594; Char</strong></code></p>
</li>
<li>
<p><code><strong>let fUp = filter (\x &#8594; isUpper x)</strong></code></p>
</li>
<li>
<p>capitalize first letter</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (toUpper)

myCap :: [Char] -&gt; [Char]
myCap (x:xs) = toUpper x : xs
myCap _ = ""</code></pre>
</div>
</div>
</li>
<li>
<p>capitalize all letters</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (toUpper)

myCap :: [Char] -&gt; [Char]
myCap (x:xs) = toUpper x : myCap xs
myCap "" = ""</code></pre>
</div>
</div>
</li>
<li>
<p>capitalize and return first letter using <code><strong>head</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (toUpper)

fstCap :: [Char] -&gt; Char
fstCap xs = toUpper $ head xs</code></pre>
</div>
</div>
</li>
<li>
<p>previous function as composed and then pointfree</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (toUpper)

fstCapCom :: [Char] -&gt; Char
fstCapCom xs = (toUpper . head) xs

fstCapPf :: [Char] -&gt; Char
fstCapPf = toUpper . head</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_ciphers">Ciphers</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (ord, chr, isAlpha)

caesar :: String -&gt; Int -&gt; String
caesar [] _ = []
caesar (x:xs) n
  | isAlpha x = docyp x n (+) : caesar xs n
  | otherwise = x : caesar xs n


unCaesar :: String -&gt; Int -&gt; String
unCaesar [] _ = []
unCaesar (x:xs) n
  | isAlpha x = docyp x n (-) : unCaesar xs n
  | otherwise = x: unCaesar xs n

docyp :: Char -&gt; Int -&gt; (Int -&gt; Int -&gt; Int) -&gt; Char
docyp x n f = chr $ f (ord x - base) n `mod` r + base
  where base = ord 'a'
        r = 26

t = "abc xyz"
shift = 5

cipherOk = (unCaesar (caesar t shift) shift) == t</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_writing_your_own_standard_functions">Writing your own standard functions</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>myOr</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myOr :: [Bool] -&gt; Bool
myOr [] = False
myOr (x:xs) = if x == True then True else myOr xs

myOr' :: [Bool] -&gt; Bool
myOr' [] = False
myOr' (x:xs)
    | x = x
    | otherwise = myOr xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myAny</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myAny :: (a -&gt; Bool) -&gt; [a] -&gt; Bool
myAny f [] = False
myAny f (x:xs) = if f x == True then True else myAny f xs

myAny' :: (a -&gt; Bool) -&gt; [a] -&gt; Bool
myAny' _ [] = False
myAny' f (x:xs)
    | f x = True
    | otherwise = myAny f xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myElem</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myElem :: Eq a =&gt; a -&gt; [a] -&gt; Bool
myElem _ [] = False
myElem a (x:xs) = if a == x then True else myElem a xs

myElem' :: Eq a =&gt; a -&gt; [a] -&gt; Bool
myElem' _ [] = False
myElem' a (x:xs)
    | a == x = True
    | otherwise = myElem a xs

myElem'' :: Eq a =&gt; a -&gt; [a] -&gt; Bool
myElem'' _ [] = False
myElem'' a xs = any (\x -&gt; a == x) xs

myElem''' :: Eq a =&gt; a -&gt; [a] -&gt; Bool
myElem''' _ [] = False
myElem''' a xs = any (a ==) xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myReverse</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myReverse :: [a] -&gt; [a]
myReverse xs = go [] xs
  where go ys [] = ys
        go ys (x:xs) = go (x : ys) xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>squish</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">squish :: [[a]] -&gt; [a]
squish [] = []
squish (x:xs) = x ++ squish xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>squishMap</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">squishMap :: (a -&gt; [b]) -&gt; [a] -&gt; [b]
squishMap _ [] = []
squishMap f (x:xs) = f x ++ squishMap f xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>squishAgain</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">squishMap :: (a -&gt; [b]) -&gt; [a] -&gt; [b]
squishMap _ [] = []
squishMap f (x:xs) = f x ++ squishMap f xs

squishAgain :: [[a]] -&gt; [a]
squishAgain xs = squishMap (\x -&gt; x) xs

squishAgain' :: [[a]] -&gt; [a]
squishAgain' xs = squishMap id xs</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myMaximumBy</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myMaximumBy :: (a -&gt; a -&gt; Ordering) -&gt; [a] -&gt; a
myMaximumBy _ [] = undefined
myMaximumBy _ (x:[]) = x
myMaximumBy f (x:xs) = go f x xs
  where go f b (x:xs)
          | f b x == GT = go f b xs
          | otherwise = go f x xs
        go f b [] = b</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>myMinimumBy</strong></code>, <code><strong>myMaximum</strong></code>, <code><strong>myMinimum</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myMaximumBy :: (a -&gt; a -&gt; Ordering) -&gt; [a] -&gt; a
myMaximumBy f (x:xs) = go f x xs
  where go f b (x:xs)
          | f b x == GT = go f b xs
          | otherwise = go f x xs
        go f b [] = b

myMinimumBy :: (a -&gt; a -&gt; Ordering) -&gt; [a] -&gt; a
myMinimumBy f (x:xs) = go f x xs
  where go f b (x:xs)
          | f b x == LT = go f b xs
          | otherwise = go f x xs
        go f b [] = b

myMaximum :: (Ord a) =&gt; [a] -&gt; a
myMaximum xs = myMaximumBy (\a b -&gt; compare a b) xs

myMinimum :: (Ord a) =&gt; [a] -&gt; a
myMinimum xs = myMinimumBy (\a b -&gt; compare a b) xs</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_10_folding_lists">10 Folding lists</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_10_5_fold_left">10.5 Fold left</h3>
<div class="sect3">
<h4 id="_intermission_exercises_14">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>b) and c) have the same result, a) has error</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">foldr (*) 1 [1..5]
-- b)
foldl (flip (*)) 1 [1..5]
-- c)
foldl (*) 1 [1..5]</code></pre>
</div>
</div>
</li>
<li>
<p>evaluation steps of <code>foldl (flip (*)) 1 [1..3]</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">foldl (flip (*)) 1 [1..3]
 = foldl (flip (*)) (1 * 1) [2,3]
 = foldl (flip (*)) (2 * (1 * 1)) [3]
 = foldl (flip (*)) (3 * (2 * (1 * 1))) []
 = (3 * (2 * (1 * 1)))</code></pre>
</div>
</div>
</li>
<li>
<p>c) one difference between <code><strong>foldr</strong></code> and <code><strong>foldl</strong></code> is that <code><strong>foldr</strong></code>, but not <code><strong>foldl</strong></code>, associates to the right</p>
</li>
<li>
<p>a) folds are catamorphisms, they are used to reduce structure</p>
</li>
<li>
<p>fixed functions</p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p><code>foldr (++) "" ["woot", "WOOT", "woot"]</code></p>
</li>
<li>
<p><code>foldr max "" ["fear","is","the","little","death"]</code></p>
</li>
<li>
<p><code>foldr (&amp;&amp;) True [False, True]</code></p>
</li>
<li>
<p><code>foldr (||) True [False, True]</code> always return <code>True</code></p>
</li>
<li>
<p><code>foldl (\x y &#8594; x ++ show y) "" [1..5]</code></p>
</li>
<li>
<p><code>foldr (flip const) 'a' [1..5]</code></p>
</li>
<li>
<p><code>foldr (flip const) 0 "tacos"</code></p>
</li>
<li>
<p><code>foldl const 0 "burritos"</code></p>
</li>
<li>
<p><code>foldl const 'z' [1..5]</code></p>
</li>
</ol>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_10_6_how_to_write_fold_functions">10.6 How to write fold functions</h3>
<div class="sect3">
<h4 id="_intermission_exercises_15">Intermission: Exercises</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Time

data DatabaseItem = DbString String
                  | DbNumber Integer
                  | DbDate UTCTime
                  deriving (Eq, Ord, Show)

theDatabase :: [DatabaseItem]
theDatabase =
  [ DbDate (UTCTime
            (fromGregorian 1911 5 1)
            (secondsToDiffTime 34123))
  , DbNumber 9001
  , DbString "Hello, world!"
  , DbDate (UTCTime
              (fromGregorian 1921 5 1)
              (secondsToDiffTime 34123))
  ]

-- tried the same with filter and map, not woth it. fold is the way
filterDbDate :: [DatabaseItem] -&gt; [UTCTime]
filterDbDate = foldr f []
  where f (DbDate a) b = a : b
        f _ b = b

filterDbNumber :: [DatabaseItem] -&gt; [Integer]
filterDbNumber = foldr f []
  where f (DbNumber a) b = a : b
        f _ b = b

-- I need a base, not ideal, but UTCTime long in the past will do now
mostRecent :: [DatabaseItem] -&gt; UTCTime
mostRecent = foldr f (UTCTime (fromGregorian 0 1 1) (secondsToDiffTime 0))
  where f (DbDate a) b
          | a &gt; b = a
          | otherwise = b
        f _ b = b

sumDb :: [DatabaseItem] -&gt; Integer
sumDb = foldr f 0
  where f (DbNumber a) b = a + b
        f _ b = b

avgDb :: [DatabaseItem] -&gt; Double
avgDb = average . filterDbNumber
  where average [] = 0
        average xs = fromIntegral (sum xs) / fromIntegral (length xs)</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_10_9_scans">10.9 Scans</h3>
<div class="paragraph">
<p>The <code>fibs</code> using <code>scanl</code> is a little bit of a mind bender at the beginning. I wrote out the evaluation <a href="https://gist.github.com/lukleh/67cf0a78205d3f6bd2d9" class="bare">https://gist.github.com/lukleh/67cf0a78205d3f6bd2d9</a></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">fibs = 1 : scanl (+) 1 fibs

-- 1)
fibs20 = take 20 fibs

-- 2)
fibsLT100 = takeWhile (&lt; 100) fibs

-- 3)
factorials = scanl (*) 1 [1..]</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_10_10_chapter_exercises">10.10 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_warm_up_and_review">Warm-up and review</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>tuples</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">stops = "pbtdkg"
vowels = "aeiou"

-- a)
svs stops vowels = [(s,v,s') | s &lt;- stops, v &lt;- vowels, s' &lt;- stops]

-- b)
svsP stops vowels = [(s,v,s') | s &lt;- stops, v &lt;- vowels, s' &lt;- stops, s == 'p']

-- c)
nouns = ["apple", "banana", "orange"]
verbs = ["turns", "peals", "eats"]
nvn nouns verbs = [(n,v,n') | n &lt;- nouns, v &lt;- verbs, n' &lt;- nouns]</code></pre>
</div>
</div>
</li>
<li>
<p>following function return average size (round to integer) of word in a sentece (string)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">seekritFunc ::  String -&gt; Int
seekritFunc x =
  div (sum (map length (words x)))
      (length (words x))</code></pre>
</div>
</div>
</li>
<li>
<p>returing <code><strong>Fractional</strong></code> values</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">seekritFunc ::  Fractional a =&gt; String -&gt; a
seekritFunc x =
  fromIntegral (sum (map length (words x))) / fromIntegral (length (words x))</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_rewriting_functions_using_folds">Rewriting functions using folds</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>myOr</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myOr :: [Bool] -&gt; Bool
myOr = foldr (||) False</code></pre>
</div>
</div>
</li>
<li>
<p>myAny</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myAny f = foldr (\ x y -&gt; f x || y) False</code></pre>
</div>
</div>
</li>
<li>
<p>myElem</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myElem :: Eq a =&gt; a -&gt; [a] -&gt; Bool
myElem a = foldr (\ x y -&gt; (a == x) || y) False</code></pre>
</div>
</div>
</li>
<li>
<p>myReverse</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myReverse :: [a] -&gt; [a]
myReverse = foldl (flip (:)) []</code></pre>
</div>
</div>
</li>
<li>
<p>myMap</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myMap :: (a -&gt; b) -&gt; [a] -&gt; [b]
myMap f xs = foldr (\a b -&gt; f a : b) [] xs

-- answer from the book is nicer
myMap' f = foldr ((:) . f) []</code></pre>
</div>
</div>
</li>
<li>
<p>myFilter</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myFilter :: (a -&gt; Bool) -&gt; [a] -&gt; [a]
myFilter pr = foldr f []
  where f a b
          | pr a = a : b
          | otherwise = b</code></pre>
</div>
</div>
</li>
<li>
<p>squish</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">squish :: [[a]] -&gt; [a]
squish = foldr (++) []</code></pre>
</div>
</div>
</li>
<li>
<p>squishMap</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">squishMap :: (a -&gt; [b]) -&gt; [a] -&gt; [b]
squishMap f = foldr (\a b -&gt; f a ++ b) []

-- again, answer from the book is nicer
squishMap' f = foldr ((++) . f) []</code></pre>
</div>
</div>
</li>
<li>
<p>squishAgain using squishMap</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">squishMap :: (a -&gt; [b]) -&gt; [a] -&gt; [b]
squishMap f = foldr (\a b -&gt; f a ++ b) []

squishAgain :: [[a]] -&gt; [a]
squishAgain = squishMap id</code></pre>
</div>
</div>
</li>
<li>
<p>myMaximumBy</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myMaximumBy :: (a -&gt; a -&gt; Ordering) -&gt; [a] -&gt; a
myMaximumBy _ []     = undefined
myMaximumBy _ [x]    = x
myMaximumBy f (x:xs) = foldl fo x xs
  where fo a b
          | f a b == GT = a
          | otherwise = b</code></pre>
</div>
</div>
</li>
<li>
<p>myMinimumBy</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myMinimumBy :: (a -&gt; a -&gt; Ordering) -&gt; [a] -&gt; a
myMinimumBy _ []     = undefined
myMinimumBy _ [x]    = x
myMinimumBy f (x:xs) = foldl fo x xs
  where fo a b
          | f a b == LT = a
          | otherwise = b</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_11_algebraic_datatypes">11 Algebraic datatypes</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_11_4_data_constructors_and_values">11.4 Data constructors and values</h3>
<div class="paragraph">
<p>For data types</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data DogueDeBordeaux doge = DogueDeBordeaux doge

data Doggies a =
      Husky a
    | Mastiff a
    deriving (Eq, Show)</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>Doggies</strong></code> is type constructor</p>
</li>
<li>
<p>kind of <code><strong>Doggies</strong></code> is <code><strong>* -> *</strong></code></p>
</li>
<li>
<p>kind of <code><strong>Doggies String</strong></code> is <code><strong>*</strong></code></p>
</li>
<li>
<p>type of <code><strong>Husky 10</strong></code> is <code><strong>Num a &#8658; Doggies a</strong></code></p>
</li>
<li>
<p>type of <code><strong>Husky (10 :: Integer)</strong></code> is <code><strong>Doggies Integer</strong></code></p>
</li>
<li>
<p>type of <code><strong>Mastiff "Scooby Doo"</strong></code> is <code><strong>Doggies String</strong></code></p>
</li>
<li>
<p><code><strong>DogueDeBordeaux</strong></code> is both type and data constructor</p>
</li>
<li>
<p>type of <code><strong>DogueDeBordeaux</strong></code> is <code><strong>doge &#8594; DogueDeBordeaux doge</strong></code></p>
</li>
<li>
<p>type of <code><strong>DogueDeBordeaux "doggie!"</strong></code> is <code><strong>DogueDeBordeaux String</strong></code></p>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_11_5_what_s_a_type_and_what_s_data">11.5 What’s a type and what’s data?</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Price = Price Integer deriving (Eq, Show)

data Manufacturer =
    Mini
  | Mazda
  | Tata
  deriving (Eq, Show)

data Airline =
    PapuAir
  | CatapultsR'Us
  | TakeYourChancesUnited
  deriving (Eq, Show)

data Vehicle =
    Car Manufacturer Price
  | Plane Airline
  deriving (Eq, Show)

myCar = Car Mini (Price 14000)
urCar = Car Mazda (Price 20000)
clownCar = Car Tata (Price 7000)
doge = Plane PapuAir</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>type of <code><strong>myCar</strong></code> is <code><strong>Vehicle</strong></code></p>
</li>
<li>
<p>define functions</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">isCar :: Vehicle -&gt; Bool
isCar (Car _ _ ) = True
isCar _ = False

isPlane :: Vehicle -&gt; Bool
isPlane (Plane _) = True
isPlane _ = False

areCars :: [Vehicle] -&gt; [Bool]
areCars = map isCar</code></pre>
</div>
</div>
</li>
<li>
<p>define function (error on non Car)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">getManu :: Vehicle -&gt; Manufacturer
getManu (Car m _)= m</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>Plane Airline</strong></code> for <code><strong>getManu</strong></code> error is <code>Non-exhaustive patterns in function getManu</code>. You can add all catching pattern, but it would have to end up in error anyway, as there is no <code>Manufacturer</code> for non-Car value.</p>
</li>
<li>
<p>add size for <code><strong>Plane</strong></code>, can be done similary as <code><strong>Price</strong></code> with <code><strong>Double</strong></code> instead of <code><strong>Integer</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Price = Price Integer deriving (Eq, Show)
data Size = Size Double deriving (Eq, Show)

data Manufacturer =
    Mini
  | Mazda
  | Tata
  deriving (Eq, Show)

data Airline =
    PapuAir
  | CatapultsR'Us
  | TakeYourChancesUnited
  deriving (Eq, Show)

data Vehicle =
    Car Manufacturer Price
  | Plane Airline Size
  deriving (Eq, Show)

myCar = Car Mini (Price 14000)
urCar = Car Mazda (Price 20000)
clownCar = Car Tata (Price 7000)
doge = Plane PapuAir (Size 100)

isPlane :: Vehicle -&gt; Bool
isPlane (Plane _ _) = True
isPlane _ = False</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_11_7_what_makes_these_datatypes_algebraic">11.7 What makes these datatypes algebraic?</h3>
<div class="sect3">
<h4 id="_intermission_exercises_16">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>cardinality 1 <code><strong>data PugType = PugData</strong></code></p>
</li>
<li>
<p>cardinality 3</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Airline =
      PapuAir
    | CatapultsR'Us
    | TakeYourChancesUnited</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>Int16</strong></code> has cardinality <code>65535</code></p>
</li>
<li>
<p><code><strong>Int</strong></code> is instance of <code><strong>Bounded</strong></code>, therefore cardinality can be determined. <code><strong>Integer</strong></code> does not have bounds</p>
</li>
<li>
<p><code><strong>Int8</strong></code> has <code>256</code> values, which corresponds to <code>2 ^ 8 = 256</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_simple_datatypes_with_nullary_data_constructors">Simple datatypes with nullary data constructors</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Example = MakeExample deriving Show</code></pre>
</div>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>MakeExample</strong></code> has type <code><strong>Example</strong></code>. <code><strong>:t Example</strong></code> gives error <code>Not in scope: data constructor ‘Example’</code></p>
</li>
<li>
<p><code><strong>:i Example</strong></code> shows that it is instance of <code><strong>Show</strong></code> typeclass</p>
</li>
<li>
<p><code><strong>:t MakeExample</strong></code> gives <code>Int &#8594; Example</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_newtype">newtype</h4>
<div class="paragraph">
<p>type synonym does not work</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">class TooMany a where
  tooMany :: a -&gt; Bool

instance TooMany Int where
  tooMany n = n &gt; 42

newtype Goats = Goats Int deriving Show

instance TooMany Goats where
  tooMany (Goats n) = n &gt; 43

-- error
-- Illegal instance declaration for ‘TooMany GoatInt’
--       (All instance types must be of the form (T t1 ... tn)
--        where T is not a synonym.
--        Use TypeSynonymInstances if you want to disable this.)
--     In the instance declaration for ‘TooMany GoatInt’
--
-- type GoatInt = Int
-- instance TooMany GoatInt where
--   tooMany n = n &gt; 44</code></pre>
</div>
</div>
<div class="paragraph">
<p>GHC pragma <code>GeneralizedNewtypeDeriving</code> works for <code>tooMany (Goats 45)</code> even without declaring an instance. Reusing <code>Int</code> instance.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE GeneralizedNewtypeDeriving #-}

class TooMany a where
  tooMany :: a -&gt; Bool

instance TooMany Int where
  tooMany n = n &gt; 42

newtype Goats = Goats Int deriving (Eq, Show, TooMany)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_intermission_exercises_17">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>without <code><strong>newtype</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE FlexibleInstances #-}

class TooMany a where
  tooMany :: a -&gt; Bool

instance TooMany (Int, String) where
  tooMany (n, s) = n &gt; 42</code></pre>
</div>
</div>
<div class="paragraph">
<p>with <code><strong>newtype</strong></code></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">class TooMany a where
  tooMany :: a -&gt; Bool

newtype Goats = Goats (Int, String) deriving Show

instance TooMany Goats where
  tooMany (Goats (n, s)) = n &gt; 42</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>TooMany</strong></code> instance for <code><strong>(Int, Int)</strong></code>, sum the values</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">class TooMany a where
  tooMany :: a -&gt; Bool

newtype Goats = Goats (Int, Int) deriving Show

1 = 0

instance TooMany Goats where
  tooMany (Goats (n, n')) = (n + n') &gt; 42</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>TooMany</strong></code> instance for <code><strong>(Num a, TooMany a) &#8658; (a, a)</strong></code></p>
<div class="admonitionblock note">
<table>
<tr>
<td class="icon">
<i class="fa icon-note" title="Note"></i>
</td>
<td class="content">
<code>TooMany a</code> as class constraint means we know what to do with <code>toomany x</code>. If we use <code>(n + n') &gt; 42</code> as the implementation, then we get error as there is no <code>Ord</code> for <code>TooMany</code>.
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE FlexibleInstances #-}

class TooMany a where
  tooMany :: a -&gt; Bool

instance TooMany Int where
  tooMany n = n &gt; 42

instance (Num a, TooMany a) =&gt; TooMany (a, a) where
  tooMany (n, n') =  tooMany (n + n')</code></pre>
</div>
</div>
</li>
</ol>
</div>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
All of the following breaks. Ambiguous type or could not deduce class constraint.
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE FlexibleInstances #-}

class TooMany a where
  tooMany :: a -&gt; Bool

instance (Num a, Integral a, TooMany a) =&gt; TooMany (a, a) where
  tooMany (n, n') = odd (n + n')


instance (Num a, Integral a) =&gt; TooMany (a, a) where
  tooMany (n, n') = odd (n + n')


instance (Num a, Ord a, TooMany a) =&gt; TooMany (a, a) where
  tooMany (n, n') = (n + n') &gt; 42


instance (Num a, TooMany a) =&gt; TooMany (a, a) where
  tooMany (n, n') = (n + n') &gt; 42


instance Num a =&gt; TooMany (a, a) where
  tooMany (n, n') = (n + n') &gt; 42


instance (Num a, Ord a) =&gt; TooMany (a, a) where
  tooMany (n, n') = (n + n') &gt; 42</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_8_sum_types">11.8 Sum types</h3>
<div class="sect3">
<h4 id="_intermission_exercises_18">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>cardinality is 4. <code>Bool</code> is 2 and sum type adds</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BigSmall =
      Big Bool
    | Small Bool
    deriving (Eq, Show)</code></pre>
</div>
</div>
</li>
<li>
<p>cardinality is 258. <code>Int8</code> is 256, <code>Bool</code> is 2, sum type adds. <code>let myNumba = Numba (-128)</code> breaks, details in <a href="https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/syntax-extns.html" class="bare">https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/syntax-extns.html</a> <code>NegativeLiterals</code>. Number out of <code>Int8</code> range gives error <code>Literal 1000 is out of the Int8 range -128..127</code> for <code>1000 :: Int8</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Int

data NumberOrBool =
      Numba Int8
    | BoolyBool Bool
    deriving (Eq, Show)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_9_product_types">11.9 Product types</h3>
<div class="sect3">
<h4 id="_intermission_jammin_exercises">Intermission: Jammin Exercises</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">-- 1.
module Jammin where

-- 8.
import Data.List (sortBy, groupBy,maximumBy)

data Fruit =
    Peach
  | Plum
  | Apple
  | Blackberry
  deriving (Eq, Show, Ord) -- 4.

data JamJars =
  Jam {fruit :: Fruit, jars :: Int}  -- 2.
  deriving (Eq, Show, Ord) -- 4.

-- 3. cardinality is 4 (Fruit) * cardinality of Int

row1 = Jam {fruit = Plum, jars = 4} -- construct using record syntax
row2 = Jam Peach 1
row3 = Jam Plum 4
row4 = Jam Blackberry 8
row5 = Jam Apple 4
row6 = Jam Apple 7
allJam = [row1, row2, row3, row4, row5, row6]

-- 5.
rowJars :: [JamJars] -&gt; [Int]
rowJars = map jars

-- 6.
jarsCount :: [JamJars] -&gt; Int
jarsCount = sum . rowJars

-- 7.
mostRow :: [JamJars] -&gt; JamJars
mostRow = maximumBy (\j1 j2 -&gt; compare (jars j1) (jars j2))

-- 9.
compareKind :: JamJars -&gt; JamJars -&gt; Ordering
compareKind (Jam k _) (Jam k' _) = compare k k'
sortJams :: [JamJars] -&gt; [JamJars]
sortJams = sortBy compareKind

-- 10.
groupJam :: [JamJars] -&gt; [[JamJars]]
groupJam = groupBy (\j1 j2 -&gt; fruit j1 == fruit j2) . sortJams

-- different way
-- import Data.Function (on)
-- groupJam = groupBy (==) on (fruit) . sortJams</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_10_normal_form">11.10 Normal form</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Fiction = Fiction deriving Show
data Nonfiction = Nonfiction deriving Show
data BookType = FictionBook Fiction
            | NonfictionBook Nonfiction
            deriving Show

type AuthorName = String
data Author = Author (AuthorName, BookType)</code></pre>
</div>
</div>
<div class="paragraph">
<p><code><strong>BookType</strong></code> gone</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">type AuthorName = String
data Author =
      Fiction AuthorName
    | Nonfiction AuthorName
    deriving (Eq, Show)</code></pre>
</div>
</div>
<div class="sect3">
<h4 id="_exercises">Exercises</h4>
<div class="paragraph">
<p>this code</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data FlowerType = Gardenia
                | Daisy
                | Rose
                | Lilac
                deriving Show

type Gardener = String

data Garden =
    Garden Gardener FlowerType
    deriving Show</code></pre>
</div>
</div>
<div class="paragraph">
<p><code>Garden</code> in normal form</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">type Gardener = String

data Garden =
      Gardenia Gardener
    | Daisy Gardener
    | Rose Gardener
    | Lilac Gardener
    deriving Show</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_11_constructing_and_deconstructing_values">11.11 Constructing and deconstructing values</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data OperatingSystem = GnuPlusLinux
                      | OpenBSDPlusNevermindJustBSDStill
                      | Mac
                      | Windows
                      deriving (Eq, Show)

data ProgrammingLanguage =  Haskell
                            | Agda
                            | Idris
                            | PureScript
                            deriving (Eq, Show)

data Programmer = Programmer { os :: OperatingSystem
                             , lang :: ProgrammingLanguage }
                             deriving (Eq, Show)

allOperatingSystems :: [OperatingSystem]
allOperatingSystems =
    [ GnuPlusLinux
    , OpenBSDPlusNevermindJustBSDStill
    , Mac
    , Windows
    ]

allLanguages :: [ProgrammingLanguage]
allLanguages = [Haskell, Agda, Idris, PureScript]

allProgrammers :: [Programmer]
allProgrammers = [Programmer {os = o, lang = l} | o &lt;- allOperatingSystems, l &lt;- allLanguages]

-- this should be True to be correct
passed = length allProgrammers == length allOperatingSystems * length allLanguages</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_12_function_type_is_exponential">11.12 Function type is exponential</h3>
<div class="sect3">
<h4 id="_exponentiation_in_what_order">Exponentiation in what order?</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Quantum =
    Yes
  | No
  | Both
  deriving (Eq, Show)


convert :: Quantum -&gt; Bool

convert1 Yes = True
convert1 No = True
convert1 Both = True

convert2 Yes = True
convert2 No = True
convert2 Both = False

convert3 Yes = True
convert3 No = False
convert3 Both = False

convert4 Yes = False
convert4 No = False
convert4 Both = False

convert5 Yes = False
convert5 No = False
convert5 Both = True

convert6 Yes = False
convert6 No = True
convert6 Both = True

convert7 Yes = False
convert7 No = True
convert7 Both = False

convert8 Yes = True
convert8 No = False
convert8 Both = True</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_intermission_exercises_19">Intermission: Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>4 + 4 = 8</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Quad =
      One
    | Two
    | Three
    | Four
    deriving (Eq, Show)
eQuad :: Either Quad Quad
eQuad = ???</code></pre>
</div>
</div>
</li>
<li>
<p><code>4 * 4 = 16</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">prodQuad :: (Quad, Quad)</code></pre>
</div>
</div>
</li>
<li>
<p><code>4 ^ 4 = 256</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">funcQuad :: Quad -&gt; Quad</code></pre>
</div>
</div>
</li>
<li>
<p><code>2 * 2 * 2 = 16</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">prodTBool :: (Bool, Bool, Bool)</code></pre>
</div>
</div>
</li>
<li>
<p><code>(2 ^ 2) ^ 2 = 16</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">gTwo :: Bool -&gt; Bool -&gt; Bool</code></pre>
</div>
</div>
</li>
<li>
<p><code>(4 ^ 4) ^ 2 = 65536</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">fTwo :: Bool -&gt; Quad -&gt; Quad</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_15_binary_tree">11.15 Binary Tree</h3>
<div class="sect3">
<h4 id="_write_map_for_binarytree">Write map for BinaryTree</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BinaryTree a =
    Leaf
    | Node (BinaryTree a) a (BinaryTree a)
    deriving (Eq, Ord, Show)

-- Retain the original structure of the tree.

mapTree :: (a -&gt; b) -&gt; BinaryTree a -&gt; BinaryTree b
mapTree _ Leaf = Leaf
mapTree f (Node left a right) =
  Node (mapTree f left) (f a) (mapTree f right)

testTree' :: BinaryTree Integer
testTree' =
  Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf)

mapExpected =
  Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf)

-- acceptance test for mapTree
mapOkay =
  if mapTree (+1) testTree' == mapExpected
  then print "yup okay!"
  else error "test failed!"</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_convert_binary_trees_to_lists">Convert binary trees to lists</h4>
<div class="paragraph">
<p>Simple solution</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BinaryTree a =
    Leaf
    | Node (BinaryTree a) a (BinaryTree a)
    deriving (Eq, Ord, Show)

preorder :: BinaryTree a -&gt; [a]
preorder Leaf = []
preorder (Node left a right) =  a : (preorder left ++ preorder right)

inorder :: BinaryTree a -&gt; [a]
inorder Leaf = []
inorder (Node left a right) =  inorder left ++ [a] ++ inorder right

postorder :: Ord a =&gt; BinaryTree a -&gt; [a]
postorder Leaf = []
postorder (Node left a right) =  postorder left ++ postorder right ++ [a]

testTree :: BinaryTree Integer
testTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf)

testPreorder :: IO ()
testPreorder =
  if preorder testTree == [2, 1, 3]
  then putStrLn "Preorder fine!"
  else putStrLn "Bad news bears."

testInorder :: IO ()
testInorder =
  if inorder testTree == [1, 2, 3]
  then putStrLn "Inorder fine!"
  else putStrLn "Bad news bears."

testPostorder :: IO ()
testPostorder =
  if postorder testTree == [1, 3, 2]
  then putStrLn "Postorder fine!"
  else putStrLn "postorder failed check"

main :: IO ()
main = do
  testPreorder
  testInorder
  testPostorder</code></pre>
</div>
</div>
<div class="paragraph">
<p>Eventually cooler and better solution</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BinaryTree a =
    Leaf
    | Node (BinaryTree a) a (BinaryTree a)
    deriving (Eq, Ord, Show)


preorder :: BinaryTree a -&gt; [a]
preorder bt = flattenPre bt []

flattenPre :: BinaryTree a -&gt; [a] -&gt; [a]
flattenPre Leaf l = l
flattenPre (Node left a right) l = a : flattenPre left (flattenPre right l)


inorder :: BinaryTree a -&gt; [a]
inorder bt = flattenIn bt []

flattenIn :: BinaryTree a -&gt; [a] -&gt; [a]
flattenIn Leaf l = l
flattenIn (Node left a right) l = flattenIn left (a : (flattenIn right l))

postorder :: Ord a =&gt; BinaryTree a -&gt; [a]
postorder bt =  flattenPost bt []

flattenPost :: BinaryTree a -&gt; [a] -&gt; [a]
flattenPost Leaf l = l
flattenPost (Node left a right) l = flattenPost left (flattenPost right (a:l))

testTree :: BinaryTree Integer
testTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf)

testPreorder :: IO ()
testPreorder =
  if preorder testTree == [2, 1, 3]
  then putStrLn "Preorder fine!"
  else putStrLn "Bad news bears."

testInorder :: IO ()
testInorder =
  if inorder testTree == [1, 2, 3]
  then putStrLn "Inorder fine!"
  else putStrLn "Bad news bears."

testPostorder :: IO ()
testPostorder =
  if postorder testTree == [1, 3, 2]
  then putStrLn "Postorder fine!"
  else putStrLn "postorder failed check"

main :: IO ()
main = do
  testPreorder
  testInorder
  testPostorder</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_write_foldr_for_binarytree">Write foldr for BinaryTree</h4>
<div class="paragraph">
<p>The big shift was to realize that the folding function needs to take 3 arguments, not the usual 2 as seen in folds so far.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">foldTree :: (a -&gt; b -&gt; b -&gt; b) -&gt; b -&gt; BinaryTree a -&gt; b
foldTree _ acc Leaf = acc
foldTree f acc (Node left a right) = f a (foldTree f acc left) (foldTree f acc right)</code></pre>
</div>
</div>
<div class="paragraph">
<p>The book gives this signature <code>foldTree :: (a &#8594; b &#8594; b) &#8594; b &#8594; BinaryTree a &#8594; b</code> though :/, let&#8217;s do as the book says.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">foldTree :: (a -&gt; b -&gt; b) -&gt; b -&gt; BinaryTree a -&gt; b
foldTree _ acc Leaf = acc
foldTree f acc bt = foldr f acc (flattenIn bt [])


flattenIn :: BinaryTree a -&gt; [a] -&gt; [a]
flattenIn Leaf l = l
flattenIn (Node left a right) l = flattenIn left (a : (flattenIn right l))</code></pre>
</div>
</div>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
But this way you cannot recreate the original tree!!!
</td>
</tr>
</table>
</div>
</div>
<div class="sect3">
<h4 id="_rewrite_map_for_binarytree">Rewrite map for BinaryTree</h4>
<div class="paragraph">
<p>3 parameter fold first</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BinaryTree a =
    Leaf
    | Node (BinaryTree a) a (BinaryTree a)
    deriving (Eq, Ord, Show)

foldTree :: (a -&gt; b -&gt; b -&gt; b) -&gt; b -&gt; BinaryTree a -&gt; b
foldTree _ acc Leaf = acc
foldTree f acc (Node left a right) = f a (foldTree f acc left) (foldTree f acc right)


mapTree' :: (a -&gt; b) -&gt; BinaryTree a -&gt; BinaryTree b
mapTree' f bt = foldTree mk Leaf bt
  where mk a l r = Node l (f a) r

-- do test also
testTree :: BinaryTree Integer
testTree =
  Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf)

mapExpected =
  Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf)

mapOkay =
  if mapTree (+1) testTree == mapExpected
  then print "yup okay!"
  else error "test failed!"</code></pre>
</div>
</div>
<div class="paragraph">
<p>2 parameter fold - BROKEN</p>
</div>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
as mentioned above, this fold ruines the structure
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BinaryTree a =
    Leaf
    | Node (BinaryTree a) a (BinaryTree a)
    deriving (Eq, Ord, Show)

foldTree :: (a -&gt; b -&gt; b) -&gt; b -&gt; BinaryTree a -&gt; b
foldTree _ acc Leaf = acc
foldTree f acc bt = foldr f acc (inorder bt)

inorder :: BinaryTree a -&gt; [a]
inorder bt = flattenIn bt []

flattenIn :: BinaryTree a -&gt; [a] -&gt; [a]
flattenIn Leaf l = l
flattenIn (Node left a right) l = flattenIn left (a : (flattenIn right l))

mapTree' :: (a -&gt; b) -&gt; BinaryTree a -&gt; BinaryTree b
mapTree' f bt = foldTree mk Leaf bt
  where mk a t = Node l (f a) r

-- do test also
testTree :: BinaryTree Integer
testTree =
  Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf)

mapExpected =
  Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf)

mapOkay =
  if mapTree (+1) testTree == mapExpected
  then print "yup okay!"
  else error "test failed!"</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_11_16_chapter_exercises">11.16 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_multiple_choice_4">Multiple choice</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>a) <code><strong>Weekday</strong></code> is a type with five data constructors</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Weekday =
      Monday
    | Tuesday
    | Wednesday
    | Thursday
    | Friday</code></pre>
</div>
</div>
</li>
<li>
<p>c) type of <code><strong>f Friday = "Miller Time"</strong></code> is <code><strong>f :: Weekday &#8594; String</strong></code></p>
</li>
<li>
<p>b) Types defined with the <code><strong>data</strong></code> keyword must begin with a capital letter</p>
</li>
<li>
<p>c) The function <code><strong>g xs = xs !! (length xs - 1)</strong></code> delivers the final element of <code><strong>xs</strong></code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_ciphers_2">Ciphers</h4>
<div class="paragraph">
<p>Vigenère cipher</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char

vigenere :: String -&gt; String -&gt; String
vigenere xs ys = vigenere' xs (cycle ys)

vigenere' [] _ = ""
vigenere' (' ':xs) cyp        = ' ' : vigenere' xs cyp
vigenere' (x:xs)   cyp@(y:ys) = docyp x y : vigenere' xs ys
  where base      = ord 'A'
        r         = 26
        dist c    = ord c - base
        docyp x y = chr $ (dist x + dist y) `mod` r + base

main = print $ vigenere "MEET AT DAWN" "ALLY" == "MPPR AE OYWY"</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_as_patterns">As-patterns</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>isSubsequenceOf</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">isSubsequenceOf :: (Eq a) =&gt; [a] -&gt; [a] -&gt; Bool
isSubsequenceOf [] [] = True
isSubsequenceOf [] ys = True
isSubsequenceOf _ []  = False
isSubsequenceOf ax@(x:xs) (y:ys)
  | x == y = isSubsequenceOf xs ys
  | otherwise = isSubsequenceOf ax ys</code></pre>
</div>
</div>
</li>
<li>
<p><code><strong>capitalizeWords</strong></code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (toUpper)

capitalizeWords :: String -&gt; [(String, String)]
capitalizeWords xs = map f $ words xs
  where f as@(s:st) = (as, toUpper s : st)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_language_exercises">Language exercises</h4>
<div class="admonitionblock caution">
<table>
<tr>
<td class="icon">
<i class="fa icon-caution" title="Caution"></i>
</td>
<td class="content">
This one was more tricky - review?
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (toUpper, isAlpha)
import Data.List (groupBy)
import Data.Function (on)

capitalizeWord :: String -&gt; String
capitalizeWord [] = []
capitalizeWord (x:xs)
    | isAlpha x = toUpper x : xs
    | otherwise = x : capitalizeWord xs

capitalizeParagraph :: String -&gt; String
capitalizeParagraph xs = concatMap capitalizeWord $ groupBy ((==) `on` (=='.')) xs</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_phone_exercise">Phone exercise</h4>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
don&#8217;t know!
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-|
 ---------------------------
 | 1      | 2 ABC | 3 DEF  |
 ___________________________
 | 4 GHI  | 5 JKL | 6 MNO  |
 ---------------------------
 | 7 PQRS | 8 TUV | 9 WXYZ |
 ---------------------------
 | * ^    | 0 + _ | # .,   |
 ---------------------------
-}

import Data.List (maximumBy)

data DaPhone = Sommat

convo :: [String]
convo = ["Wanna play 20 questions",
  "Ya",
  "U 1st haha",
  "Lol ok. Have u ever tasted alcohol lol",
  "Lol ya",
  "Wow ur cool haha. Ur turn",
  "Ok. Do u think I am pretty Lol",
  "Lol ya",
  "Haha thanks just making sure rofl ur turn"]

-- validButtons = "1234567890*#"
type Digit = Char

-- valid presses = [1..4]
type Presses = Int


cellPhonesDead :: DaPhone -&gt; String -&gt; [(Digit, Presses)]
cellPhonesDead = undefined

fingerTaps :: [(Digit, Presses)] -&gt; Presses
fingerTaps = sum . map snd

popularest :: String -&gt; Char
popularest = snd maximumBy fst . frequency

-- from SO
frequency :: Ord a =&gt; [a] -&gt; [(Int,a)]
frequency list = map (\l -&gt; (length l, head l)) (group (sort list))

reverseTaps :: Char -&gt; (Digit, Presses)
reverseTaps = undefined
-- reverseTaps 'a' == [('2', 1)]
-- reverseTaps 'A' == [('*', 1), ('2', 1)]

coolestLtr :: [String] -&gt; Char
coolestLtr = snd . maximumBy fst . maximumBy fst . map frequency

coolestWord :: [String] -&gt; String
coolestWord = snd . maximumBy fst . map frequency . map words</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_hutton_s_razor">Hutton’s Razor</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Expr
  = Lit Integer
  | Add Expr Expr

eval :: Expr -&gt; Integer
eval (Lit i) = i
eval (Add exp1 exp2) = eval exp1 + eval exp2


printExpr :: Expr -&gt; String
printExpr (Lit i) = show i
printExpr (Add exp1 exp2) = printExpr exp1 ++ " + " ++ printExpr exp2</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_12_signaling_adversity">12 Signaling adversity</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_12_5_chapter_exercises">12.5 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_determine_the_kinds">Determine the kinds</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code><strong>id :: a &#8594; a</strong></code> kind of <code><strong>a</strong></code> is <code><strong>*</strong></code></p>
</li>
<li>
<p><code><strong>r :: a &#8594; f a</strong></code> kind of <code><strong>a</strong></code> is <code><strong>*</strong></code>, kind of <code><strong>f a</strong></code> is <code><strong>* -> *</strong></code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_string_processing">String processing</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Replace "the" with "a".</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.List (intercalate)

notThe :: String -&gt; Maybe String
notThe s
  | s == "the" = Nothing
  | otherwise = Just s

replaceThe :: String -&gt; String
replaceThe str = intercalate " " $ map athe $ fmap notThe $ words str
  where athe Nothing = "a"
        athe (Just x) = x</code></pre>
</div>
</div>
</li>
<li>
<p>recursive count</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">countTheBeforeVowel :: String -&gt; Integer
countTheBeforeVowel s = f 0 $ words s

isVowel :: Char -&gt; Bool
isVowel x = x `elem` "aeiou"

f :: Integer -&gt; [String] -&gt; Integer
f n (x:y:ys)
  | x == "the" &amp;&amp; isVowel (head y) = f (n + 1) (y:ys)
  | otherwise = f n ys
f n _ = n</code></pre>
</div>
</div>
</li>
<li>
<p>number of vowels in a word - changed the siganture to <code>Int</code> instead of <code>Integer</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">countVowels :: String -&gt; Int
countVowels = length . wordVowels

isVowel :: Char -&gt; Bool
isVowel x = x `elem` "aeiou"

wordVowels :: String -&gt; String
wordVowels = filter isVowel</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_validate_the_word">Validate the word</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">newtype Word' =
  Word' String
  deriving (Eq, Show)

vowels = "aeiou"

mkWord :: String -&gt; Maybe Word'
mkWord w = if lv &lt; lc then Just (Word' w) else Nothing
  where lv = length $ filter ((flip elem) vowels) w
        lc = length w - lv</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_it_s_only_natural">It’s only Natural</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Nat =
  Zero
  | Succ Nat
  deriving (Eq, Show)

natToInteger :: Nat -&gt; Integer
natToInteger Zero = 0
natToInteger (Succ n) = 1 + natToInteger n

integerToNat :: Integer -&gt; Maybe Nat
integerToNat i
  | i &lt; 0 = Nothing
  | otherwise = Just (tn i)
  where tn i
          | i == 0 = Zero
          | otherwise = Succ (tn (i - 1))</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_small_library_for_maybe">Small library for Maybe</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>boolean check</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">isJust :: Maybe a -&gt; Bool
isJust Nothing = False
isJust _ = True

isNothing :: Maybe a -&gt; Bool
isNothing = not . isJust</code></pre>
</div>
</div>
</li>
<li>
<p>Maybe catamorphism</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">mayybee :: b -&gt; (a -&gt; b) -&gt; Maybe a -&gt; b
mayybee b _ Nothing = b
mayybee _ f (Just a) = f a</code></pre>
</div>
</div>
</li>
<li>
<p>fallback</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">mayybee :: b -&gt; (a -&gt; b) -&gt; Maybe a -&gt; b
mayybee b _ Nothing = b
mayybee _ f (Just a) = f a

fromMaybe :: a -&gt; Maybe a -&gt; a
fromMaybe a m = mayybee a id m</code></pre>
</div>
</div>
</li>
<li>
<p>Converting between List and Maybe</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">listToMaybe :: [a] -&gt; Maybe a
listToMaybe [] = Nothing
listToMaybe (x:_) = Just x

maybeToList :: Maybe a -&gt; [a]
maybeToList Nothing = []
maybeToList (Just a) = [a]</code></pre>
</div>
</div>
</li>
<li>
<p>drop the Nothing values from our list</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">catMaybes :: [Maybe a] -&gt; [a]
catMaybes [] = []
catMaybes (Nothing:xs) = catMaybes xs
catMaybes (Just a:xs) = a : catMaybes xs

-- using fold
catMaybes' :: [Maybe a] -&gt; [a]
catMaybes' [] = []
catMaybes' xs = foldr f [] xs
  where f Nothing xs'  = xs'
        f (Just a) xs' = a : xs'</code></pre>
</div>
</div>
</li>
<li>
<p>flipMaybe</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">flipMaybe :: [Maybe a] -&gt; Maybe [a]
flipMaybe [] = Just []
flipMaybe xs = foldr f (Just []) xs
  where f _ Nothing = Nothing
        f Nothing _ = Nothing
        f (Just a) (Just b) = Just (a:b)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_small_library_for_either">Small library for Either</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>use foldr</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">lefts' :: [Either a b] -&gt; [a]
lefts' = foldr f []
  where f (Left a) xs = a : xs
        f (Right b) xs = xs

-- lefts' [Left 1, Left 2]
-- [1, 2]
-- lefts' [Right 0, Left 5, Right 4]
-- [5]</code></pre>
</div>
</div>
</li>
<li>
<p>use foldr well, same as last one (don&#8217;t see the point much, just use a instead of b)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">rights' :: [Either a b] -&gt; [b]
rights' = foldr f []
  where f (Left a) xs = xs
        f (Right b) xs = b : xs

-- rights' [Left 1, Left 2]
-- []
-- rights' [Right 0, Left 5, Right 4]
-- [0, 4]</code></pre>
</div>
</div>
</li>
<li>
<p>partitionEithers</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">partitionEithers' :: [Either a b] -&gt; ([a], [b])
partitionEithers' = foldr f ([], [])
  where f (Left a) (xs, ys) = (a:xs, ys)
        f (Right b) (xs, ys) = (xs, b:ys)</code></pre>
</div>
</div>
</li>
<li>
<p>eitherMaybe</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">eitherMaybe' :: (b -&gt; c) -&gt; Either a b -&gt; Maybe c
eitherMaybe' _ (Left _) = Nothing
eitherMaybe' f (Right b) = Just (f b)

-- eitherMaybe' even (Right 2)
-- eitherMaybe' even (Left 2)</code></pre>
</div>
</div>
</li>
<li>
<p>either'</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">either' :: (a -&gt; c) -&gt; (b -&gt; c) -&gt; Either a b -&gt; c
either' fl _ (Left a) = fl a
either' _ fr (Right b) = fr b

-- either' even odd (Left 2)
-- either' even odd (Right 2)</code></pre>
</div>
</div>
</li>
<li>
<p>use either'</p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
I don&#8217;t see the point :(
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">either' :: (a -&gt; c) -&gt; (b -&gt; c) -&gt; Either a b -&gt; c
either' fl _ (Left a) = fl a
either' _ fr (Right b) = fr b

eitherMaybe'' :: (b -&gt; c) -&gt; Either a b -&gt; Maybe c
eitherMaybe'' _ (Left _) = Nothing
eitherMaybe'' f eb = Just (either' undefined f eb)

-- eitherMaybe'' even (Right 2)
-- eitherMaybe'' even (Left 2)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_write_your_own_iterate_and_unfoldr">Write your own iterate and unfoldr</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>myIterate using recursion</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myIterate :: (a -&gt; a) -&gt; a -&gt; [a]
myIterate f a = a : myIterate f (f a)</code></pre>
</div>
</div>
</li>
<li>
<p>myUnfoldr</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myUnfoldr :: (b -&gt; Maybe (a, b)) -&gt; b -&gt; [a]
myUnfoldr f b = case f b of
                Nothing -&gt; []
                Just (x, y) -&gt; x : myUnfoldr f y</code></pre>
</div>
</div>
</li>
<li>
<p>myIterate into betterIterate using myUnfoldr</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myUnfoldr :: (b -&gt; Maybe (a, b)) -&gt; b -&gt; [a]
myUnfoldr f b = case f b of
                Nothing -&gt; []
                Just (x, y) -&gt; x : myUnfoldr f y

betterIterate :: (a -&gt; a) -&gt; a -&gt; [a]
betterIterate f x = myUnfoldr (\x -&gt; Just (x, f x)) x</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_finally_something_other_than_a_list">Finally something other than a list!</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data BinaryTree a =
    Leaf
  | Node (BinaryTree a) a (BinaryTree a)
  deriving (Eq, Ord, Show)


unfold :: (a -&gt; Maybe (a,b,a)) -&gt; a -&gt; BinaryTree b
unfold f b = case f b of
                Nothing -&gt; Leaf
                Just (x, y, z) -&gt; Node (unfold f x) y (unfold f z)

treeBuild :: Integer -&gt; BinaryTree Integer
treeBuild n = unfold f 0
  where f m
          | m == n = Nothing
          | otherwise = Just (m + 1, m, m + 1)</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_13_building_projects_in_haskell">13 Building projects in Haskell</h2>
<div class="sectionbody">
<div class="paragraph">
<p>Files at <a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch13" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch13</a></p>
</div>
<div class="paragraph">
<p><a href="https://github.com/commercialhaskell/stack/blob/master/doc/faq.md" class="bare">https://github.com/commercialhaskell/stack/blob/master/doc/faq.md</a></p>
</div>
<div class="paragraph">
<p><a href="https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md" class="bare">https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md</a></p>
</div>
<div class="paragraph">
<p><a href="http://docs.haskellstack.org/en/stable/README.html" class="bare">http://docs.haskellstack.org/en/stable/README.html</a></p>
</div>
<div class="sect3">
<h4 id="_differences_between_cabal_and_stack">Differences between cabal and stack</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>stack new proj</code> instead of <code>mkdir proj; cd proj; cabal init</code></p>
</li>
<li>
<p><code>stack</code> creates <code>Lib</code> automatically</p>
</li>
<li>
<p><code>cabal sandbox init</code> no need</p>
</li>
<li>
<p><code>stack build</code></p>
</li>
<li>
<p><code>stack exec proj-exe</code></p>
</li>
<li>
<p><code>stack ghci</code> or <code>stack repl</code> - they appear to be identical</p>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_13_3_working_with_a_basic_project">13.3 Working with a basic project</h3>
<div class="paragraph">
<p>All the changes over the whole chapter at <a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch13/hello" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch13/hello</a></p>
</div>
</div>
<div class="sect2">
<h3 id="_13_7_more_on_importing_modules">13.7 More on importing modules</h3>
<div class="sect3">
<h4 id="_intermission_check_your_understanding">Intermission: Check your understanding</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>forever</code> and <code>when</code></p>
</li>
<li>
<p>all the import without <code>qualified</code> keyword</p>
</li>
<li>
<p>everything exported in <code>Database.Blacktip.Types</code></p>
</li>
<li>
<p>details</p>
<div class="olist loweralpha">
<ol class="loweralpha" type="a">
<li>
<p>just look for what is after the <code>as</code> keyword in the imports</p>
</li>
<li>
<p><code>Filesystem</code></p>
</li>
<li>
<p><code>Control.Monad</code></p>
</li>
</ol>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_13_9_do_syntax_and_io">13.9 do syntax and IO</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>error as expected</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">main :: IO Bool
main = do c &lt;- getChar
          c' &lt;- getChar
          c == c'</code></pre>
</div>
</div>
</li>
<li>
<p>consumes two characters and prints <code>True</code> or <code>False</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">main :: IO Bool
main = do c &lt;- getChar
          c' &lt;- getChar
          return (c == c')</code></pre>
</div>
</div>
</li>
<li>
<p>consumes two characters and prints <code>True</code> if true, or nothing.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">main :: IO ()
main = do c &lt;- getChar
          c' &lt;- getChar
          if c == c'
          then putStrLn "True"
          else return ()</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_13_15_chapter_exercises">13.15 Chapter exercises</h3>
<div class="sect3">
<h4 id="_hangman_game_logic">Hangman game logic</h4>
<div class="paragraph">
<p>Sources at <a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch13/hangman" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch13/hangman</a></p>
</div>
<div class="paragraph">
<p>To count only incorrect guesses, I have modified <code>gameOver</code> condition to <code>if (length guessed - length (filter isJust discovered)) &gt; 7 then</code></p>
</div>
</div>
<div class="sect3">
<h4 id="_modifying_code">Modifying code</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Caesar and Vigenere cyphers taking input from user</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (ord, chr, isAlpha)

caesar :: String -&gt; Int -&gt; String
caesar [] _ = []
caesar (x:xs) n
  | isAlpha x = docyp x n (+) : caesar xs n
  | otherwise = x : caesar xs n


unCaesar :: String -&gt; Int -&gt; String
unCaesar [] _ = []
unCaesar (x:xs) n
  | isAlpha x = docyp x n (-) : unCaesar xs n
  | otherwise = x: unCaesar xs n

docyp :: Char -&gt; Int -&gt; (Int -&gt; Int -&gt; Int) -&gt; Char
docyp x n f = chr $ f (ord x - base) n `mod` r + base
  where base = ord 'a'
        r = 26

t = "abc xyz"
shift = 5

cipherOk = unCaesar (caesar t shift) shift == t

main :: IO ()
main = do
  putStr "input caesar shift: "
  cyp &lt;- getLine
  putStr "input text: "
  str &lt;- getLine
  putStrLn $ "encrypted text: " ++ caesar str (read cyp :: Int)</code></pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char

vigenere :: String -&gt; String -&gt; String
vigenere xs ys = vigenere' xs (cycle ys)

vigenere' :: String -&gt; String -&gt; String
vigenere' [] _ = ""
vigenere' xs [] = xs
vigenere' (x:xs) cyp@(y:ys)
  | x == ' ' = x : vigenere' xs cyp
  | otherwise = docyp x y : vigenere' xs ys
  where base = ord 'A'
        r = 26
        dist c = ord c - base
        docyp a b = chr $ (dist a + dist b) `mod` r + base

main :: IO ()
main = do
  putStr "input vigenere cypher: "
  cyp &lt;- getLine
  putStr "input text: "
  str &lt;- getLine
  putStrLn $ "encrypted text: " ++ vigenere str cyp</code></pre>
</div>
</div>
</li>
<li>
<p>using <code>exitSuccess</code> in palindrome</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad
import System.Exit (exitSuccess)

palindrome :: IO ()
palindrome = forever $ do
  putStr "type text to check for palindrome: "
  line1 &lt;- getLine
  case line1 == reverse line1 of
    True -&gt; do
              putStrLn "It's a palindrome!"
              exitSuccess
    False -&gt; putStrLn "Nope!"

main :: IO ()
main = palindrome</code></pre>
</div>
</div>
</li>
<li>
<p>palindrome on sentences</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad
import System.Exit (exitSuccess)
import Data.Char (toLower, isLetter)

norm :: String -&gt; String
norm = map toLower . filter isLetter

palindrome :: IO ()
palindrome = forever $ do
  putStr "type text to check for palindrome: "
  line1 &lt;- getLine
  case norm line1 == reverse (norm line1) of
    True -&gt; do
              putStrLn "It's a palindrome!"
              exitSuccess
    False -&gt; putStrLn "Nope!"

main :: IO ()
main = palindrome</code></pre>
</div>
</div>
</li>
<li>
<p><code>gimmePerson</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">type Name = String
type Age = Integer

data Person = Person Name Age deriving Show

data PersonInvalid = NameEmpty
  | AgeTooLow
  | PersonInvalidUnknown String
  deriving (Eq, Show)

mkPerson :: Name
          -&gt; Age
          -&gt; Either PersonInvalid Person
mkPerson name age
  | name /= "" &amp;&amp; age &gt; 0 = Right $ Person name age
  | name == "" = Left NameEmpty
  | age &lt;= 0 = Left AgeTooLow
  | otherwise = Left $ PersonInvalidUnknown $
                      "Name was: " ++ show name ++
                      " Age was: " ++ show age

gimmePerson :: IO ()
gimmePerson = do
  putStr "age: "
  age &lt;- getLine
  putStr "name: "
  name &lt;- getLine
  case mkPerson name (read age :: Integer) of
    Right p -&gt; putStrLn $ "Yay! Successfully got a person:" ++ show p
    Left NameEmpty -&gt; putStrLn "Empty name"
    Left AgeTooLow -&gt; putStrLn "Age must be bigger than 0"
    Left (PersonInvalidUnknown err) -&gt; putStrLn $ "Unknown invalid: " ++ err</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_14_testing">14 Testing</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_14_3_conventional_testing">14.3 Conventional testing</h3>
<div class="paragraph">
<p><a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/addition" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/addition</a></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Addition where

import Test.Hspec
import Test.QuickCheck (property)

someFunc :: IO ()
someFunc = putStrLn "some Func"

dividedBy :: Integral a =&gt; a -&gt; a -&gt; (a, a)
dividedBy num denom = go num denom 0
  where go n
          d count
          | n &lt; d = (count, n)
          | otherwise = go (n - d) d (count + 1)

recMul :: (Eq a, Num a) =&gt; a -&gt; a -&gt; a
recMul n m = go n m 0
    where go n' m' acc
            | m' == 0 = acc
            | otherwise = go n' (m' - 1) (acc + n')


main :: IO ()
main = hspec $ do
  describe "Addition" $ do
    it "1 + 1 is greater than 1" $ do
      (1 + 1) &gt; 1 `shouldBe` True
    it "2 + 2 is equal to 4" $ do
      2 + 2 `shouldBe` 4
    it "15 divided by 3 is 5" $ do
      dividedBy 15 3 `shouldBe` (5, 0)
    it "22 divided by 5 is 4 remainder 2" $ do
      dividedBy 22 5 `shouldBe` (4, 2)
    it "5 multiplied by 3 is 15" $ do
      recMul 5 3 `shouldBe` 15
    it "10 multiplied by 0 is 0" $ do
      recMul 10 0 `shouldBe` 0
    it "x + 1 is always greater than x" $ do
      property $ \x -&gt; x + 1 &gt; (x :: Int)</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_14_5_morse_code">14.5 Morse code</h3>
<div class="paragraph">
<p><a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/morsecode" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/morsecode</a></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Main where

import qualified Data.Map as M
import Morse
import Test.QuickCheck

allowedChars :: [Char]
allowedChars = M.keys letterToMorse

allowedMorse :: [String]
allowedMorse = M.elems letterToMorse

charGen :: Gen Char
charGen = elements allowedChars

morseGen :: Gen Morse
morseGen = elements allowedMorse

prop_thereAndBackAgain :: Property
prop_thereAndBackAgain =
  forAll charGen
  (\c -&gt; ((charToMorse c) &gt;&gt;= morseToChar) == Just c)

main :: IO ()
main = quickCheck prop_thereAndBackAgain</code></pre>
</div>
</div>
<div class="paragraph">
<p>I have <code>morsecode</code> instead of <code>morse</code> and loadding tests is <code>stack ghci morsecode:morsecode-test</code></p>
</div>
</div>
<div class="sect2">
<h3 id="_14_7_chapter_exercises">14.7 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_validating_numbers_into_words">Validating numbers into words</h4>
<div class="paragraph">
<p><a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/wordnumber" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/wordnumber</a></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Main where

import Test.Hspec
import WordNumber (digitToWord, digits, wordNumber)

main :: IO ()
main = hspec $ do
  describe "digitToWord does what we want" $ do
    it "returns zero for 0" $ do
      digitToWord 0 `shouldBe` "zero"
    it "returns one for 1" $ do
      digitToWord 1 `shouldBe` "one"
  describe "digits does what we want" $ do
    it "returns [1] for 1" $ do
      digits 1 `shouldBe` [1]
    it "returns [1, 0, 0] for 100" $ do
      digits 100 `shouldBe` [1, 0, 0]
  describe "wordNumber does what we want" $ do
    it "returns one-zero-zero for 100" $ do
      wordNumber 100 `shouldBe` "one-zero-zero"
    it "returns nine-zero-zero-one for 9001" $ do
      wordNumber 9001 `shouldBe` "nine-zero-zero-one"</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_using_quickcheck">Using QuickCheck</h4>
<div class="admonitionblock caution">
<table>
<tr>
<td class="icon">
<i class="fa icon-caution" title="Caution"></i>
</td>
<td class="content">
had to use <code>Test.QuickCheck.Function</code> in point 8 to make it work
</td>
</tr>
</table>
</div>
<div class="paragraph">
<p>Run tests: <code>stack test</code></p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>propHalf <code>+++ OK, passed 100 tests.</code></p>
</li>
<li>
<p>propSort <code>+++ OK, passed 100 tests.</code></p>
</li>
<li>
<p>plusAssociative <code>+++ OK, passed 100 tests.</code></p>
<div class="paragraph">
<p>plusCommutative <code>+++ OK, passed 100 tests.</code></p>
</div>
</li>
<li>
<p>multiAssociative <code>+++ OK, passed 100 tests.</code></p>
<div class="paragraph">
<p>multiCommutative <code>+++ OK, passed 100 tests.</code></p>
</div>
</li>
<li>
<p>propQuotRem <code>+++ OK, passed 100 tests.</code></p>
<div class="paragraph">
<p>propDivMod <code>+++ OK, passed 100 tests.</code></p>
</div>
</li>
<li>
<p>powerAssociative</p>
<div class="literalblock">
<div class="content">
<pre>*** Failed! Falsifiable (after 1 test):
0
0
0</pre>
</div>
</div>
<div class="paragraph">
<p>powerCommutative</p>
</div>
<div class="literalblock">
<div class="content">
<pre>*** Failed! Falsifiable (after 2 tests):
1
0</pre>
</div>
</div>
</li>
<li>
<p>propReverse <code>+++ OK, passed 100 tests.</code></p>
</li>
<li>
<p>applyProp <code>+++ OK, passed 100 tests.</code></p>
<div class="paragraph">
<p>composeProp <code>+++ OK, passed 100 tests.</code></p>
</div>
</li>
<li>
<p>inConcatProp</p>
<div class="literalblock">
<div class="content">
<pre>*** Failed! Falsifiable (after 2 tests and 2 shrinks):
"a"
"b"</pre>
</div>
</div>
<div class="paragraph">
<p>concatProp <code>+++ OK, passed 100 tests.</code></p>
</div>
</li>
<li>
<p>lenTakeProb</p>
<div class="literalblock">
<div class="content">
<pre>*** Failed! Falsifiable (after 3 tests and 1 shrink):
2
""</pre>
</div>
</div>
</li>
<li>
<p>idProp <code>+++ OK, passed 100 tests.</code></p>
</li>
</ol>
</div>
<div class="paragraph">
<p><a href="https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/usingquickcheck" class="bare">https://github.com/lukleh/haskell-book-exercises/tree/gh-pages/ch14/usingquickcheck</a></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
-- import Test.QuickCheck.Instances.List (anyList)
import Test.QuickCheck.Modifiers (NonZero)
import Test.QuickCheck.Function (apply, Fun(..))

import Data.List (sort)

-- 1.
half :: Fractional a =&gt; a -&gt; a
half x = x / 2

halfIdentity :: Fractional a =&gt; a -&gt; a
halfIdentity = (*2) . half

propHalf :: Float -&gt; Bool
propHalf x = halfIdentity x == x

-- 2.
listOrdered :: (Ord a) =&gt; [a] -&gt; Bool
listOrdered xs = snd $ foldr go (Nothing, True) xs
  where go _ status@(_, False) = status
        go y (Nothing, t) = (Just y, t)
        go y (Just x, t) = (Just y, x &gt;= y)

propSort :: [Int] -&gt; Bool
propSort xs
  | listOrdered xs = xs == (sort xs)
  | otherwise = xs /= (sort xs)

-- 3.
plusAssociative :: Int -&gt; Int -&gt; Int -&gt; Bool
plusAssociative x y z =
  x + (y + z) == (x + y) + z

plusCommutative :: Int -&gt; Int -&gt; Bool
plusCommutative x y =
  x + y == y + x

-- 4.
multiAssociative :: Int -&gt; Int -&gt; Int -&gt; Bool
multiAssociative x y z =
  x * (y * z) == (x * y) * z

multiCommutative :: Int -&gt; Int -&gt; Bool
multiCommutative x y =
  x * y == y * x

-- 5.
propQuotRem :: NonZero Int -&gt; NonZero Int -&gt; Bool
propQuotRem (NonZero x) (NonZero y) =
  (quot x y)*y + (rem x y) == x

propDivMod :: NonZero Int -&gt; NonZero Int -&gt; Bool
propDivMod (NonZero x) (NonZero y) =
  (div x y)*y + (mod x y) == x

-- 6.
powerAssociative :: Int -&gt; Int -&gt; Int -&gt; Bool
powerAssociative x y z = x ^ (y ^ z) == (x ^ y) ^ z

powerCommutative :: Int -&gt; Int -&gt; Bool
powerCommutative x y = x ^ y == y ^ x

-- 7.
propReverse :: [Int] -&gt; Bool
propReverse xs = (reverse . reverse) xs == xs

-- 8.
applyProp :: Fun Int Int -&gt; Int -&gt; Bool
applyProp (Fun _ f) a = (f $ a) == (f a)

composeProp :: Fun Char Double -&gt; Fun Int Char -&gt; Int -&gt; Bool
composeProp (Fun _ f) (Fun _ g) x = (f . g) x == f (g x)
-- alternatively with apply :: Fun a b -&gt; a -&gt; b
-- composeProp f g x = ((apply f) . (apply g)) x == (apply f) ((apply g) x)

-- 9.
inConcatProp :: String -&gt; String -&gt; Bool
inConcatProp xs ys = foldr (:) xs ys == (++) xs ys

concatProp :: [String] -&gt; Bool
concatProp xs = foldr (++) [] xs == concat xs

-- 10.
lenTakeProb :: Int -&gt; String -&gt; Bool
lenTakeProb n xs = length (take n xs) == n

-- 11.
idProp :: Int -&gt; Bool
idProp x = (read (show x)) == x


main :: IO ()
main = do
  quickCheck propHalf
  quickCheck propSort
  quickCheck plusAssociative
  quickCheck plusCommutative
  quickCheck multiAssociative
  quickCheck multiCommutative
  quickCheck propQuotRem
  quickCheck propDivMod
  quickCheck powerAssociative
  quickCheck powerCommutative
  quickCheck propReverse
  quickCheck applyProp
  quickCheck composeProp
  quickCheck inConcatProp
  quickCheck concatProp
  quickCheck lenTakeProb
  quickCheck idProp</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_failure">Failure</h4>
<div class="paragraph">
<p>Floating point precission cannot guarantee equality</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (quickCheck, verboseCheck)

square x = x * x

squareIdentity :: Double -&gt; Double
squareIdentity = square . sqrt

squareProp x = squareIdentity x == x

main = do
  quickCheck squareProp</code></pre>
</div>
</div>
<div class="literalblock">
<div class="content">
<pre>*Main&gt; main
*** Failed! Falsifiable (after 2 tests and 1037 shrinks):
2.225078033262077e-308</pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_idempotence">Idempotence</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (quickCheck, verboseCheck)
import Data.Char (toUpper, toLower)
import Data.List (sort)


twice f = f . f
fourTimes = twice . twice

capitalizeWord :: String -&gt; String
capitalizeWord w
  | null w = w
  | otherwise = [toUpper firstLetter] ++ map toLower others
  where ([firstLetter], others) = splitAt 1 w

propCapitalize :: String -&gt; Bool
propCapitalize x =
  (capitalizeWord x == twice capitalizeWord x) &amp;&amp; (capitalizeWord x == fourTimes capitalizeWord x)

propSort :: [Int] -&gt; Bool
propSort x =
  (sort x == twice sort x) &amp;&amp; (sort x == fourTimes sort x)


main = do
  quickCheck propCapitalize
  quickCheck propSort</code></pre>
</div>
</div>
<div class="literalblock">
<div class="content">
<pre>+++ OK, passed 100 tests.
+++ OK, passed 100 tests.</pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_make_a_gen_random_generator_for_the_datatype">Make a Gen random generator for the datatype</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (sample, oneof, frequency, Gen)

data Fool =
      Fulse
    | Frue
    deriving (Eq, Show)

genFool :: Gen Fool
genFool = oneof [Fulse, Frue]

genFoolMoreFulse :: Gen Fool
genFoolMoreFulse = frequency [(2, return Fulse),
                              (1, return Frue)]</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_hangman_testing">Hangman testing</h4>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
not done, will have to come back to this later
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">fillInCharacter :: Puzzle -&gt; Char -&gt; Puzzle
fillInCharacter (Puzzle word filledInSoFar s) c =
  Puzzle word newFilledInSoFar (c : s)
  where zipper guessed wordChar guessChar =
          if wordChar == guessed
          then Just wordChar
          else guessChar
        newFilledInSoFar =
          zipWith (zipper c) word filledInSoFar

handleGuess :: Puzzle -&gt; Char -&gt; IO Puzzle
handleGuess puzzle guess = do
  putStrLn $ "Your guess was: " ++ [guess]
  case (charInWord puzzle guess
      , alreadyGuessed puzzle guess) of
    (_, True) -&gt; do
      putStrLn "You already guessed that\
                \ character, pick something else!"
      return puzzle
    (True, _) -&gt; do
      putStrLn "This character was in the word,\
                \ filling in the word accordingly"
      return (fillInCharacter puzzle guess)
    (False, _) -&gt; do
      putStrLn "This character wasn't in\
                \ the word, try again."
      return (fillInCharacter puzzle guess)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_validating_ciphers">Validating ciphers</h4>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
need to do proper generators
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char (ord, chr, isAlpha)
import Test.QuickCheck (quickCheck, verboseCheck, Gen)

caesar :: String -&gt; Int -&gt; String
caesar [] _ = []
caesar (x:xs) n
  | isAlpha x = docyp x n (+) : caesar xs n
  | otherwise = x : caesar xs n


unCaesar :: String -&gt; Int -&gt; String
unCaesar [] _ = []
unCaesar (x:xs) n
  | isAlpha x = docyp x n (-) : unCaesar xs n
  | otherwise = x: unCaesar xs n

docyp :: Char -&gt; Int -&gt; (Int -&gt; Int -&gt; Int) -&gt; Char
docyp x n f = chr $ f (ord x - base) n `mod` range + base
  where base = ord 'a'
        range = 26


-- vigenere "MEET AT DAWN" "ALLY" = "ALLY AL LYAL"

vigenere :: String -&gt; String -&gt; String
vigenere [] _ = ""
vigenere xs ys = vigenere' xs (cycle (map ord ys)) where
  vigenere' (x:xs) cyp@(n:ns)
    | isAlpha x = docyp x n (+) : vigenere' xs ns
      | otherwise = x : vigenere' xs cyp

unVigenere :: String -&gt; String -&gt; String
unVigenere [] _ = ""
unVigenere xs ys = unVigenere' xs (cycle (map ord ys)) where
  unVigenere' (x:xs) cyp@(n:ns)
    | isAlpha x = docyp x n (+) : unVigenere' xs ns
      | otherwise = x : unVigenere' xs cyp


-- capitalGen :: Gen Char
-- capitalGen = elements [A..Z]

-- propCaesar :: Property
-- propCaesar =
--   forAll capitalGen
--   (\c -&gt; (unCaesar (caesar text shift) shift) == text)


propCaesar :: String -&gt; Int -&gt; Bool
propCaesar text shift = (unCaesar (caesar text shift) shift) == text

propVigenere :: String -&gt; String -&gt; Bool
propVigenere text code = (unVigenere (vigenere text code) code) == text

main :: IO ()
main = do
  verboseCheck propCaesar
  verboseCheck propVigenere</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_15_monoid_semigroup">15 Monoid, Semigroup</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_15_10_reusing_algebras_by_asking_for_algebras">15.10 Reusing algebras by asking for algebras</h3>
<div class="sect3">
<h4 id="_exercise_2">Exercise</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Optional a =
    Nada
  | Only a
  deriving (Eq, Show)

instance Monoid a =&gt; Monoid (Optional a) where
  mempty                      = Nada
  mappend Nada      (Only a)  = Only a
  mappend Nada      Nada      = Nada
  mappend (Only a)  Nada      = Only a
  mappend (Only a)  (Only b)  = Only (mappend a b)</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_15_11_madness">15.11 Madness</h3>
<div class="paragraph">
<p>I guess the <code>madlibbinBetter'</code> is "better", but nothing to blow my mind as of now.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid

type Verb = String
type Adjective = String
type Adverb = String
type Noun = String
type Exclamation = String

madlibbin' :: Exclamation
              -&gt; Adverb
              -&gt; Noun
              -&gt; Adjective
              -&gt; String
madlibbin' e adv noun adj =
    e &lt;&gt; "! he said " &lt;&gt;
    adv &lt;&gt; " as he jumped into his car " &lt;&gt;
    noun &lt;&gt; " and drove off with this " &lt;&gt;
    adj &lt;&gt; " wife."


madlibbinBetter' :: Exclamation
                    -&gt; Adverb
                    -&gt; Noun
                    -&gt; Adjective
                    -&gt; String
madlibbinBetter' e adv noun adj = mconcat [e, "! he said ", adv, " as he jumped into his car ", noun, " and drove off with this ", adj, " wife."]</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_15_12_better_living_through_quickcheck">15.12 Better living through QuickCheck</h3>
<div class="sect3">
<h4 id="_intermission_exercise_2">Intermission: Exercise</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Test.QuickCheck

data Optional a =
    Nada
  | Only a
  deriving (Eq, Show)

monoidAssoc :: (Eq m, Monoid m) =&gt; m -&gt; m -&gt; m -&gt; Bool
monoidAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

monoidLeftIdentity :: (Eq m, Monoid m) =&gt; m -&gt; Bool
monoidLeftIdentity a = (mempty &lt;&gt; a) == a

monoidRightIdentity :: (Eq m, Monoid m) =&gt; m -&gt; Bool
monoidRightIdentity a = (a &lt;&gt; mempty) == a

newtype First' a =
  First' { getFirst' :: Optional a }
  deriving (Eq, Show)

instance Arbitrary a =&gt; Arbitrary (First' a) where
  arbitrary = do
    x &lt;- arbitrary
    frequency [ (1, return (First' (Only x)))
              , (1, return (First' Nada))]

instance Monoid (First' a) where
  mempty = First' Nada
  mappend (First' (Only x)) _ = First' (Only x)
  mappend (First' Nada) (First' (Only x)) = First' (Only x)
  mappend _ _ = First' Nada

firstMappend :: First' a -&gt; First' a -&gt; First' a
firstMappend = mappend

type FirstMappend =
     First' String
  -&gt; First' String
  -&gt; First' String
  -&gt; Bool

main :: IO ()
main = do
  quickCheck (monoidAssoc :: FirstMappend)
  quickCheck (monoidLeftIdentity :: First' String -&gt; Bool)
  quickCheck (monoidRightIdentity :: First' String -&gt; Bool)</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_15_14_chapter_exercises">15.14 Chapter exercises</h3>
<div class="sect3">
<h4 id="_semigroup_exercises">Semigroup exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>data Trivial = Trivial deriving (Eq, Show)</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Trivial = Trivial deriving (Eq, Show)

instance Semigroup Trivial where
  _ &lt;&gt; _ = Trivial

instance Arbitrary Trivial where
  arbitrary = return Trivial

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type TrivialAssoc = Trivial -&gt; Trivial -&gt; Trivial -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: TrivialAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Identity a = Identity a</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))

newtype Identity a = Identity a deriving (Eq, Show)

instance Semigroup a =&gt; Semigroup (Identity a) where
  (Identity a) &lt;&gt; (Identity b) = Identity (a &lt;&gt; b)

instance Arbitrary a =&gt; Arbitrary (Identity a) where
  arbitrary = do
    a &lt;- arbitrary
    return (Identity a)

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type IdentityAssoc = Identity String -&gt; Identity String -&gt; Identity String -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: IdentityAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Two a b = Two a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Two a b = Two a b deriving (Eq, Show)

instance (Semigroup a, Semigroup b) =&gt; Semigroup (Two a b) where
  (Two a b) &lt;&gt; (Two c d) = Two (a &lt;&gt; c) (b &lt;&gt; d)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Two a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    return (Two a b)

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type TwoAssoc = Two String Ordering -&gt; Two String Ordering -&gt; Two String Ordering -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: TwoAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Three a b c = Three a b c</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Three a b c = Three a b c deriving (Eq, Show)

instance (Semigroup a, Semigroup b, Semigroup c) =&gt; Semigroup (Three a b c) where
  (Three a b c) &lt;&gt; (Three a1 b1 c1) = Three (a &lt;&gt; a1) (b &lt;&gt; b1) (c &lt;&gt; c1)

instance (Arbitrary a, Arbitrary b, Arbitrary c) =&gt; Arbitrary (Three a b c) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    c &lt;- arbitrary
    return (Three a b c)

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type ThreeAssoc = Three String Ordering String -&gt; Three String Ordering String -&gt; Three String Ordering String -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: ThreeAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Four a b c d = Four a b c d</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;), Sum)

data Four a b c d = Four a b c d deriving (Eq, Show)

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) =&gt; Semigroup (Four a b c d) where
  (Four a b c d) &lt;&gt; (Four a1 b1 c1 d1) = Four (a &lt;&gt; a1) (b &lt;&gt; b1) (c &lt;&gt; c1) (d &lt;&gt; d1)

instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =&gt; Arbitrary (Four a b c d) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    c &lt;- arbitrary
    d &lt;- arbitrary
    return (Four a b c d)

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type FourAssoc = Four String Ordering String String -&gt; Four String Ordering String String -&gt; Four String Ordering String String -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: FourAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype BoolConj = BoolConj Bool</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))

newtype BoolConj = BoolConj Bool deriving (Eq, Show)

instance Semigroup BoolConj where
  (BoolConj a) &lt;&gt; (BoolConj b) = BoolConj (a &amp;&amp; b)

instance Arbitrary BoolConj where
  arbitrary = do
    a &lt;- arbitrary
    elements [(BoolConj a), (BoolConj a)]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type BoolConjAssoc = BoolConj -&gt; BoolConj -&gt; BoolConj -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: BoolConjAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype BoolDisj = BoolDisj Bool</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))

newtype BoolDisj = BoolDisj Bool deriving (Eq, Show)

instance Semigroup BoolDisj where
  (BoolDisj a) &lt;&gt; (BoolDisj b) = BoolDisj (a || b)

instance Arbitrary BoolDisj where
  arbitrary = do
    a &lt;- arbitrary
    elements [(BoolDisj a), (BoolDisj a)]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type BoolDisjAssoc = BoolDisj -&gt; BoolDisj -&gt; BoolDisj -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: BoolDisjAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Or a b = Fst a | Snd b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Or a b = Fst a | Snd b deriving (Eq, Show)

instance (Semigroup a, Semigroup b) =&gt; Semigroup (Or a b) where
  (Snd a) &lt;&gt; _ = Snd a
  _ &lt;&gt; (Snd a) = (Snd a)
  _ &lt;&gt; b = b

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Or a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [(Fst a), (Snd b)]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type OrAssoc = Or String Ordering -&gt; Or String Ordering -&gt; Or String Ordering -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: OrAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Combine a b = Combine { unCombine :: (a &#8594; b) }</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
could not break the <code>CoArbitrary</code>
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;), Sum(Sum, getSum))

newtype Combine a b = Combine { unCombine :: (a -&gt; b) }

instance Semigroup b =&gt; Semigroup (Combine a b) where
  Combine {unCombine=f} &lt;&gt; Combine {unCombine=g} = Combine (f &lt;&gt; g)

-- instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Combine a b) where
--   arbitrary = do
--     a &lt;- arbitrary
--     b &lt;- arbitrary
--     elements [(Fst a), (Snd b)]

-- instance CoArbitrary a =&gt; CoArbitrary (Combine a b) where
--   coarbitrary Combine { unCombine = (a -&gt; b) }  = variant 0
--   coarbitrary (Just x) = variant 1 . coarbitrary x

-- semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
-- semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

-- type CombineAssoc = Combine String Ordering -&gt; Combine String Ordering -&gt; Combine String Ordering -&gt; Bool

-- main :: IO ()
-- main =
--   quickCheck (semigroupAssoc :: CombineAssoc)

f = Combine $ \n -&gt; Sum (n + 1)
g = Combine $ \n -&gt; Sum (n - 1)

main = do
  print $ unCombine (f &lt;&gt; g ) $ 0
  print $ unCombine (f &lt;&gt; g ) $ 1
  print $ unCombine (f &lt;&gt; f ) $ 1
  print $ unCombine (g &lt;&gt; f ) $ 1</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Comp a = Comp { unComp :: (a &#8594; a) }</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
probably correct, do not undestand
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;), Sum(..))

newtype Comp a = Comp { unComp :: (a -&gt; a) }

instance Semigroup a =&gt; Semigroup (Comp a) where
  Comp {unComp=f} &lt;&gt; Comp {unComp=g} = Comp (f &lt;&gt; g)


f = Comp $ \(Sum n) -&gt; Sum (n + 1)
g = Comp $ \(Sum n) -&gt; Sum (n - 1)

main = do
  print $ unComp (f &lt;&gt; g ) $ 0
  print $ unComp (f &lt;&gt; g ) $ 1
  print $ unComp (f &lt;&gt; f ) $ 1
  print $ unComp (g &lt;&gt; f ) $ 1</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Validation a b = Failure a | Success b deriving (Eq, Show)</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Validation a b =
  Failure a | Success b
  deriving (Eq, Show)

instance Semigroup a =&gt;
  Semigroup (Validation a b) where
    (Failure a) &lt;&gt; (Failure b)  = Failure (a &lt;&gt; b)
    (Failure a) &lt;&gt; _            = Failure a
    _           &lt;&gt; (Failure a)  = Failure a
    a           &lt;&gt; _            = a

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Validation a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [(Success a), (Failure b)]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type ValidationAssoc = Validation String Ordering -&gt; Validation String Ordering -&gt; Validation String Ordering -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: ValidationAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype AccumulateRight a b = AccumulateRight (Validation a b) deriving (Eq, Show)</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Validation a b =
  Failure a | Success b
  deriving (Eq, Show)

newtype AccumulateRight a b =
  AccumulateRight (Validation a b)
  deriving (Eq, Show)

instance Semigroup b =&gt;
  Semigroup (AccumulateRight a b) where
    (AccumulateRight (Success a)) &lt;&gt; (AccumulateRight (Success b))  = AccumulateRight (Success (a &lt;&gt; b))
    (AccumulateRight (Failure a)) &lt;&gt; _                              = AccumulateRight (Failure a)
    _                             &lt;&gt; (AccumulateRight (Failure a))  = AccumulateRight (Failure a)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (AccumulateRight a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [(AccumulateRight (Success a)), (AccumulateRight (Failure b))]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type AccumulateRightAssoc = AccumulateRight String Ordering -&gt; AccumulateRight String Ordering -&gt; AccumulateRight String Ordering -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: AccumulateRightAssoc)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype AccumulateBoth a b = AccumulateBoth (Validation a b) deriving (Eq, Show)</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))

data Validation a b =
  Failure a | Success b
  deriving (Eq, Show)

newtype AccumulateBoth a b =
  AccumulateBoth (Validation a b)
  deriving (Eq, Show)

instance (Semigroup a, Semigroup b) =&gt;
  Semigroup (AccumulateBoth a b) where
    (AccumulateBoth (Success a)) &lt;&gt; (AccumulateBoth (Success b))  = AccumulateBoth (Success (a &lt;&gt; b))
    (AccumulateBoth (Failure a)) &lt;&gt; (AccumulateBoth (Failure b))  = AccumulateBoth (Failure (a &lt;&gt; b))
    _                            &lt;&gt; (AccumulateBoth (Failure a))  = AccumulateBoth (Failure a)
    (AccumulateBoth (Failure a)) &lt;&gt; _                             = AccumulateBoth (Failure a)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (AccumulateBoth a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [(AccumulateBoth (Success a)), (AccumulateBoth (Failure b))]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

type AccumulateBothAssoc = AccumulateBoth String Ordering -&gt; AccumulateBoth String Ordering -&gt; AccumulateBoth String Ordering -&gt; Bool

main :: IO ()
main =
  quickCheck (semigroupAssoc :: AccumulateBothAssoc)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_monoid_exercises">Monoid exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>data Trivial = Trivial deriving (Eq, Show)</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))
import Data.Monoid (Monoid)

data Trivial = Trivial deriving (Eq, Show)

instance Semigroup Trivial where
  _ &lt;&gt; _ = Trivial

instance Monoid Trivial where
  mempty = Trivial
  mappend = (&lt;&gt;)

instance Arbitrary Trivial where
  arbitrary = return Trivial

type TrivialAssoc = Trivial -&gt; Trivial -&gt; Trivial -&gt; Bool

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

monoidLeftIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidLeftIdentity a = (mempty &lt;&gt; a) == a

monoidRightIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidRightIdentity a = (a &lt;&gt; mempty) == a

main :: IO ()
main = do
  quickCheck (semigroupAssoc :: TrivialAssoc)
  quickCheck (monoidLeftIdentity :: Trivial -&gt; Bool)
  quickCheck (monoidRightIdentity :: Trivial -&gt; Bool)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Identity a = Identity a deriving (Eq, Show)</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))
import Data.Monoid (Monoid)

newtype Identity a = Identity a deriving (Eq, Show)

instance Semigroup a =&gt; Semigroup (Identity a) where
  (Identity a) &lt;&gt; (Identity b) = Identity (a &lt;&gt; b)

instance (Semigroup a, Monoid a) =&gt; Monoid (Identity a) where
  mempty = Identity mempty
  mappend = (&lt;&gt;)

instance Arbitrary a =&gt; Arbitrary (Identity a) where
  arbitrary = do
    a &lt;- arbitrary
    return (Identity a)

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

monoidLeftIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidLeftIdentity a = (mempty &lt;&gt; a) == a

monoidRightIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidRightIdentity a = (a &lt;&gt; mempty) == a

type IdentityAssoc = Identity String -&gt; Identity String -&gt; Identity String -&gt; Bool

main :: IO ()
main = do
  quickCheck (semigroupAssoc :: IdentityAssoc)
  quickCheck (monoidLeftIdentity :: Identity String -&gt; Bool)
  quickCheck (monoidRightIdentity :: Identity String -&gt; Bool)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Two a b = Two a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck)
import Data.Semigroup (Semigroup, (&lt;&gt;))
import Data.Monoid (Monoid)

data Two a b = Two a b deriving (Eq, Show)

instance (Semigroup a, Semigroup b) =&gt; Semigroup (Two a b) where
  (Two a b) &lt;&gt; (Two c d) = Two (a &lt;&gt; c) (b &lt;&gt; d)

instance (Semigroup a, Monoid a, Semigroup b, Monoid b) =&gt; Monoid (Two a b) where
  mempty = Two mempty mempty
  mappend = (&lt;&gt;)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Two a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    return (Two a b)

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

monoidLeftIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidLeftIdentity a = (mempty &lt;&gt; a) == a

monoidRightIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidRightIdentity a = (a &lt;&gt; mempty) == a

type TwoAssoc = Two String Ordering -&gt; Two String Ordering -&gt; Two String Ordering -&gt; Bool

main :: IO ()
main = do
  quickCheck (semigroupAssoc :: TwoAssoc)
  quickCheck (monoidLeftIdentity :: Two String Ordering -&gt; Bool)
  quickCheck (monoidRightIdentity :: Two String Ordering -&gt; Bool)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype BoolConj = BoolConj Bool</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))
import Data.Monoid (Monoid)

newtype BoolConj = BoolConj Bool deriving (Eq, Show)

instance Semigroup BoolConj where
  (BoolConj a) &lt;&gt; (BoolConj b) = BoolConj (a &amp;&amp; b)

instance Monoid BoolConj where
  mempty = BoolConj True
  mappend = (&lt;&gt;)

instance Arbitrary BoolConj where
  arbitrary = do
    a &lt;- arbitrary
    elements [(BoolConj a), (BoolConj a)]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

monoidLeftIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidLeftIdentity a = (mempty &lt;&gt; a) == a

monoidRightIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidRightIdentity a = (a &lt;&gt; mempty) == a

type BoolConjAssoc = BoolConj -&gt; BoolConj -&gt; BoolConj -&gt; Bool

main :: IO ()
main = do
  quickCheck (semigroupAssoc :: BoolConjAssoc)
  quickCheck (monoidLeftIdentity :: BoolConj -&gt; Bool)
  quickCheck (monoidRightIdentity :: BoolConj -&gt; Bool)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype BoolDisj = BoolDisj Bool</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;))
import Data.Monoid (Monoid)

newtype BoolDisj = BoolDisj Bool deriving (Eq, Show)

instance Semigroup BoolDisj where
  (BoolDisj a) &lt;&gt; (BoolDisj b) = BoolDisj (a || b)

instance Monoid BoolDisj where
  mempty = BoolDisj False
  mappend = (&lt;&gt;)

instance Arbitrary BoolDisj where
  arbitrary = do
    a &lt;- arbitrary
    elements [(BoolDisj a), (BoolDisj a)]

semigroupAssoc :: (Eq m, Semigroup m) =&gt; m -&gt; m -&gt; m -&gt; Bool
semigroupAssoc a b c = (a &lt;&gt; (b &lt;&gt; c)) == ((a &lt;&gt; b) &lt;&gt; c)

monoidLeftIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidLeftIdentity a = (mempty &lt;&gt; a) == a

monoidRightIdentity :: (Eq m, Monoid m, Semigroup m) =&gt; m -&gt; Bool
monoidRightIdentity a = (a &lt;&gt; mempty) == a

type BoolDisjAssoc = BoolDisj -&gt; BoolDisj -&gt; BoolDisj -&gt; Bool

main :: IO ()
main = do
  quickCheck (semigroupAssoc :: BoolDisjAssoc)
  quickCheck (monoidLeftIdentity :: BoolDisj -&gt; Bool)
  quickCheck (monoidRightIdentity :: BoolDisj -&gt; Bool)</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Combine a b = Combine { unCombine :: (a &#8594; b) }</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
could not break the <code>CoArbitrary</code>
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;), Sum(Sum, getSum))
import Data.Monoid (Monoid)

newtype Combine a b = Combine { unCombine :: (a -&gt; b) }

instance Semigroup b =&gt; Semigroup (Combine a b) where
  Combine {unCombine=f} &lt;&gt; Combine {unCombine=g} = Combine (f &lt;&gt; g)

instance (Semigroup b, Monoid b) =&gt; Monoid (Combine a b) where
  mempty = Combine mempty
  mappend = (&lt;&gt;)

f = Combine $ \n -&gt; Sum (n + 1)
g = Combine $ \n -&gt; Sum (n - 1)

main = do
  print $ unCombine (f &lt;&gt; g ) $ 0
  print $ unCombine (f &lt;&gt; g ) $ 1
  print $ unCombine (f &lt;&gt; f ) $ 1
  print $ unCombine (g &lt;&gt; f ) $ 1
  print $ unCombine (mappend mempty f) 0 == unCombine f 0</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Comp a = Comp { unComp :: (a &#8594; a) }</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
how come <code>unComp f 0</code> does not break?
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, quickCheck, elements)
import Data.Semigroup (Semigroup, (&lt;&gt;), Sum(..))
import Data.Monoid (Monoid)

newtype Comp a = Comp { unComp :: (a -&gt; a) }

instance Semigroup a =&gt; Semigroup (Comp a) where
  Comp {unComp=f} &lt;&gt; Comp {unComp=g} = Comp (f &lt;&gt; g)

instance (Semigroup a, Monoid a) =&gt; Monoid (Comp a) where
  mempty = Comp id
  mappend = (&lt;&gt;)


f = Comp $ \(Sum n) -&gt; Sum (n + 1)
g = Comp $ \(Sum n) -&gt; Sum (n - 1)

main = do
  print $ unComp (f &lt;&gt; g ) $ 0
  print $ unComp (f &lt;&gt; g ) $ 1
  print $ unComp (f &lt;&gt; f ) $ 1
  print $ unComp (g &lt;&gt; f ) $ 1
  print $ unComp (mappend mempty f) 0 == unComp f 0</code></pre>
</div>
</div>
</li>
<li>
<p><code>newtype Mem s a&#8230;&#8203;.</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
awkward, what is this for? and again, no <code>CoArbitrary</code>
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid (Monoid, (&lt;&gt;))

newtype Mem s a =
  Mem {
    runMem :: s -&gt; (a,s)
  }

instance Monoid a =&gt; Monoid (Mem s a) where
  mempty = Mem $ \s -&gt; (mempty, s)
  mappend Mem {runMem = f} Mem {runMem = g} = Mem $ \x -&gt; let (a, b) = g x
                                                              (c, d) = f b
                                                          in (a &lt;&gt; c, d)


f' = Mem $ \s -&gt; ("hi", s + 1)
main = do
  print $ runMem (f' &lt;&gt; mempty) 0
  print $ runMem (mempty &lt;&gt; f') 0
  print $ (runMem mempty 0 :: (String, Int))
  print $ runMem (f' &lt;&gt; mempty) 0 == runMem f' 0
  print $ runMem (mempty &lt;&gt; f') 0 == runMem f' 0</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_16_functor">16 Functor</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_16_4_let_s_talk_about_f_baby">16.4 Let’s talk about f , baby</h3>
<div class="sect3">
<h4 id="_intermission_exercises_20">Intermission: Exercises</h4>
<div class="paragraph">
<p>because kind of <code>(&#8594;)</code> is <code>(&#8594;) :: * &#8594; * &#8594; *</code> the following is</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>kind of <code>a</code> if <code>*</code></p>
</li>
<li>
<p><code>b</code> has kind <code>* &#8594; *</code>, <code>T</code> has kind <code>* &#8594; *</code></p>
</li>
<li>
<p><code>c</code> has kind <code>* &#8594; * &#8594; *</code></p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_16_7_commonly_used_functors">16.7 Commonly used functors</h3>
<div class="sect3">
<h4 id="_the_functors_are_stacked_and_that_s_a_fact">The functors are stacked and that’s a fact</h4>
<div class="paragraph">
<p>little write out of what happens when we compose functors</p>
</div>
<div class="literalblock">
<div class="content">
<pre>replaceWithP = const 'p'

:t replaceWithP
replaceWithP :: b -&gt; Char

lms = [Just "Ave", Nothing, Just "woohoo"]

now we try try to this:
(fmap . fmap) replaceWithP lms
and the result is:
[Just 'p',Nothing,Just 'p']

let's disect this:

:t (fmap . fmap)
(Functor f, Functor f1) =&gt; (a -&gt; b) -&gt; f (f1 a) -&gt; f (f1 b)

fmap :: Functor f =&gt; (m -&gt; n) -&gt; f m -&gt; f n

fmap :: Functor g =&gt; (x -&gt; y) -&gt; g x -&gt; g y


(x -&gt; y) -&gt; g x -&gt; g y
apply: replaceWithP :: b -&gt; Char
result is:
g b -&gt; g Char
that is (b -&gt; Char) substitued in (g x -&gt; g y)

(m -&gt; n) -&gt; f m -&gt; f n
apply: (g b -&gt; g Char)
result is:
f (g b) -&gt; f (g Char)
that is (b -&gt; Char) substitued in (f m -&gt; f n)


f (g b) -&gt; f (g Char)
apply: lms
result is:
f unwraps the list
g unwraps the Maybe
replaceWithP is applied to the value

voilà, it does work as advertised :)

three compositions go one more level deeper
(fmap . fmap . fmap)
as we can also fmap over String</pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_one_more_round_for_the_p_funkshun">One more round for the P-Funkshun</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">replaceWithP :: b -&gt; Char
replaceWithP = const 'p'

lms :: [Maybe [Char]]
lms = [Just "Ave", Nothing, Just "woohoo"]

-- Just making the argument more specific
replaceWithP' :: [Maybe [Char]] -&gt; Char
replaceWithP' = replaceWithP

-- Prelude&gt; :t fmap replaceWithP
-- fmap replaceWithP :: Functor f =&gt; f a -&gt; f Char

liftedReplace :: Functor f =&gt; f a -&gt; f Char
liftedReplace = fmap replaceWithP

liftedReplace' :: [Maybe [Char]] -&gt; [Char]
liftedReplace' = liftedReplace

-- Prelude&gt; :t (fmap . fmap) replaceWithP
-- (fmap . fmap) replaceWithP
--   :: (Functor f1, Functor f) =&gt; f (f1 a) -&gt; f (f1 Char)
twiceLifted :: (Functor f1, Functor f) =&gt; f (f1 a) -&gt; f (f1 Char)
twiceLifted = (fmap . fmap) replaceWithP

-- Making it more specific
twiceLifted' :: [Maybe [Char]] -&gt; [Maybe Char]
twiceLifted' = twiceLifted
-- f ~ []
-- f1 ~ Maybe

-- Prelude&gt; :t (fmap . fmap . fmap) replaceWithP
-- (fmap . fmap . fmap) replaceWithP
--   :: (Functor f2, Functor f1, Functor f) =&gt;
--      f (f1 (f2 a)) -&gt; f (f1 (f2 Char))
thriceLifted :: (Functor f2, Functor f1, Functor f) =&gt; f (f1 (f2 a)) -&gt; f (f1 (f2 Char))
thriceLifted = (fmap . fmap . fmap) replaceWithP

-- More specific or "concrete"
thriceLifted' :: [Maybe [Char]] -&gt; [Maybe [Char]]
thriceLifted' = thriceLifted
-- f ~ []
-- f1 ~ Maybe
-- f2 ~ []

main :: IO ()
main = do
  putStr "replaceWithP' lms:"
  print (replaceWithP' lms)

  putStr "liftedReplace lms:"
  print (liftedReplace lms)
  putStr "liftedReplace' lms:"
  print (liftedReplace' lms)
  putStr "twiceLifted lms:"
  print (twiceLifted lms)
  putStr "twiceLifted' lms:"
  print (twiceLifted' lms)
  putStr "thriceLifted lms:"
  print (thriceLifted lms)
  putStr "thriceLifted' lms:"
  print (thriceLifted' lms)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_intermission_lifting_exercises">Intermission: Lifting Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>a = fmap (+1) (read "[1]" :: [Int])</code></p>
</li>
<li>
<p><code>b = (fmap . fmap) (++ "lol") (Just ["Hi,", "Hello"])</code></p>
</li>
<li>
<p><code>c = fmap (*2) (\x &#8594; x - 2)</code> also <code>c = (*2) . (\x &#8594; x - 2)</code></p>
</li>
<li>
<p><code>d = fmap ((return '1' ++) . show) (\x &#8594; [x, 1..3])</code></p>
<div class="paragraph">
<p>also <code>d = ((return '1' ++) . show) . (\x &#8594; [x, 1..3])</code></p>
</div>
<div class="paragraph">
<p>and without <code>return</code> that I do not undestand here</p>
</div>
<div class="paragraph">
<p><code>d = fmap (("1" ++) . show) (\x &#8594; [x, 1..3])</code></p>
</div>
</li>
<li>
<p><code>e</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
WTF? have no clue
</td>
</tr>
</table>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_16_10_intermission_exercises">16.10 Intermission: Exercises</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>newtype Identity a = Identity a</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

newtype Identity a = Identity a

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

-- functorCompose :: (Eq (f c), Functor f) =&gt; (a -&gt; b) -&gt; (b -&gt; c) -&gt; f a -&gt; Bool
-- functorCompose f g x = (fmap g (fmap f x)) == (fmap (g . f) x)
-- Prelude&gt; let li x = functorCompose (+1) (*2) (x :: [Int])
-- Prelude&gt; quickCheck li
-- +++ OK, passed 100 tests.
functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Pair a = Pair a a</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

data Pair a = Pair a a

instance Functor Pair where
  fmap f (Pair a b) = Pair (f a) (f b)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Two a b = Two a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

data Two a b = Two a b

instance Functor (Two a) where
  fmap f (Two a b) = Two a (f b)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Three a b c = Three a b c</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

data Three a b c = Three a b c

instance Functor (Three a b) where
  fmap f (Three a b c) = Three a b (f c)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Three' a b = Three' a b b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

data Three' a b = Three' a b b

instance Functor (Three' a) where
  fmap f (Three' a b c) = Three' a (f b) (f c)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Four a b c d = Four a b c d</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

data Four a b c d = Four a b c d

instance Functor (Four a b c) where
  fmap f (Four a b c d) = Four a b c (f d)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Four' a b = Four' a a a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Function

data Four' a b = Four' a a a b

instance Functor (Four' a) where
  fmap f (Four' a b c d) = Four' a b c (f d)


functorIdentity :: (Functor f, Eq (f a)) =&gt; f a -&gt; Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) =&gt; f a -&gt; Fun a b -&gt; Fun b c -&gt; Bool
functorCompose x (Fun _ f) (Fun _ g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

type IntToInt = Fun Int Int
type IntFC = [Int] -&gt; IntToInt -&gt; IntToInt -&gt; Bool

main = do
  quickCheck $ \x -&gt; functorIdentity (x :: [Int])
  quickCheck (functorIdentity :: [Int] -&gt; Bool)
  quickCheck (functorCompose :: IntFC)</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Trivial = Trivial</code> has kind <code>*</code>, cannot be Functor</p>
</li>
</ol>
</div>
</div>
<div class="sect2">
<h3 id="_16_11_ignoring_possibilities">16.11 Ignoring possibilities</h3>
<div class="sect3">
<h4 id="_maybe_short_exercise">Maybe - Short Exercise</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Possibly a =
    LolNope
  | Yeppers a
  deriving (Eq, Show)

instance Functor Possibly where
  fmap _ LolNope = LolNope
  fmap f (Yeppers a) = Yeppers (f a)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_either_short_exercise">Either - Short Exercise</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>Functor</code> for <code>Either</code> like type</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)

instance Functor (Sum a) where
  fmap _ (First a) = First a
  fmap f (Second b) = Second (f b)</code></pre>
</div>
</div>
</li>
<li>
<p>Either has kind * &#8594; * &#8594; * , you cannot apply "second" argument first to get kind * &#8594; *</p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_16_17_chapter_exercises">16.17 Chapter exercises</h3>
<div class="sect3">
<h4 id="_is_valid_functor">Is valid Functor</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>no, kind <code>*</code></p>
</li>
<li>
<p>yes, kind <code>* &#8594; *</code></p>
</li>
<li>
<p>yes, kind <code>* &#8594; *</code>, similar to <code>Maybe</code></p>
</li>
<li>
<p>yes, <code>Mu f</code> kind is <code>* &#8594; *</code>, but making it Functor instance is kinda funky.</p>
</li>
<li>
<p>no, <code>data D =&#8230;&#8203;.</code> not a <code>* &#8594; *</code></p>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_rearrange_the_arguments">Rearrange the arguments</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>flip <code>a</code> and <code>b</code> in the <code>Sum</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Sum b a =
    First a
  | Second b

instance Functor (Sum e) where
  fmap f (First a) = First (f a)
  fmap f (Second b) = Second b</code></pre>
</div>
</div>
</li>
<li>
<p>flip <code>b</code> and <code>c</code> in the <code>Company</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Company a c b =
    DeepBlue a c
  | Something b

instance Functor (Company e e') where
  fmap f (Something b) = Something (f b)
  fmap _ (DeepBlue a c) = DeepBlue a c</code></pre>
</div>
</div>
</li>
<li>
<p>flip <code>a</code> and <code>b</code> in the <code>More</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data More b a =
    L a b a
  | R b a b
  deriving (Eq, Show)

instance Functor (More x) where
  fmap f (L a b a') = L (f a) b (f a')
  fmap f (R b a b') = R b (f a) b'</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_write_functor_instances">Write Functor instances</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>data Quant a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Quant a b =
    Finance
  | Desk a
  | Bloor b

instance Functor (Quant a) where
  fmap _ Finance = Finance
  fmap _ (Desk a) = Desk a
  fmap f (Bloor b) = Bloor (f b)</code></pre>
</div>
</div>
</li>
<li>
<p>simillar to <code>Constant</code> in the 16.12 chapter</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data K a b =
  K a

instance Functor (K a) where
  fmap _ (K a) = K a</code></pre>
</div>
</div>
</li>
<li>
<p><code>Flip</code> from earlier</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE FlexibleInstances #-}

newtype Flip f a b =
  Flip (f b a)
  deriving (Eq, Show)

newtype K a b =
  K a

-- should remind you of an
-- instance you've written before
instance Functor (Flip K a) where
  fmap f (Flip (K a)) = Flip (K (f a))</code></pre>
</div>
</div>
</li>
<li>
<p><code>EvilGoateeConst</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data EvilGoateeConst a b =
  GoatyConst b

instance Functor (EvilGoateeConst a) where
  fmap f (GoatyConst b) = GoatyConst (f b)</code></pre>
</div>
</div>
</li>
<li>
<p>virtually identical to <code>Wrap</code> earlier, <code>f</code> in <code>LiftItOut f a</code> needs to be <code>Functor</code> to make sense at all</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data LiftItOut f a =
  LiftItOut (f a)

instance Functor f =&gt; Functor (LiftItOut f) where
  fmap f (LiftItOut fa) = LiftItOut (fmap f fa)</code></pre>
</div>
</div>
</li>
<li>
<p>double fmap wrap</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Parappa f g a =
  DaWrappa (f a) (g a)

instance (Functor f, Functor g) =&gt; Functor (Parappa f g) where
  fmap f (DaWrappa fa ga) = DaWrappa (fmap f fa) (fmap f ga)</code></pre>
</div>
</div>
</li>
<li>
<p><code>IgnoreOne</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data IgnoreOne f g a b =
  IgnoringSomething (f a) (g b)

instance Functor g =&gt; Functor (IgnoreOne f g a) where
  fmap f (IgnoringSomething fa gb) = IgnoringSomething fa (fmap f gb)</code></pre>
</div>
</div>
</li>
<li>
<p><code>Notorious</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data Notorious g o a t =
  Notorious (g o) (g a) (g t)

instance Functor g =&gt; Functor (Notorious g o a) where
  fmap f (Notorious go ga gt) = Notorious go ga (fmap f gt)</code></pre>
</div>
</div>
</li>
<li>
<p><code>List</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data List a =
    Nil
  | Cons a (List a)

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons a la) = Cons (f a) (fmap f la)</code></pre>
</div>
</div>
</li>
<li>
<p>triple deep</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data GoatLord a =
    NoGoat
  | OneGoat a
  | MoreGoats (GoatLord a) (GoatLord a) (GoatLord a)

instance Functor GoatLord where
  fmap _ NoGoat = NoGoat
  fmap f (OneGoat a) = OneGoat (f a)
  fmap f (MoreGoats g1 g2 g3) = MoreGoats (fmap f g1) (fmap f g2) (fmap f g3)</code></pre>
</div>
</div>
</li>
<li>
<p>looks right, but not sure</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">data TalkToMe a =
    Halt
  | Print String a
  | Read (String -&gt; a)

instance Functor TalkToMe where
  fmap _ Halt = Halt
  fmap f (Print s a) = Print s (f a)
  fmap f (Read sa) = Read (fmap f sa)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_17_applicative">17 Applicative</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_17_5_applicative_in_use">17.5 Applicative in use</h3>
<div class="sect3">
<h4 id="_short_exercises">Short Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>add <code>&lt;$&gt;</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">added :: Maybe Integer
added = (+3) &lt;$&gt; (lookup 3 $ zip [1, 2, 3] [4, 5, 6])</code></pre>
</div>
</div>
</li>
<li>
<p>add <code>&lt;$&gt;</code> and <code>&lt;*&gt;</code>, longer version of <code>liftA2</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">y :: Maybe Integer
y = lookup 3 $ zip [1, 2, 3] [4, 5, 6]

z :: Maybe Integer
z = lookup 2 $ zip [1, 2, 3] [4, 5, 6]

tupled :: Maybe (Integer, Integer)
tupled = (,) &lt;$&gt; y &lt;*&gt; z</code></pre>
</div>
</div>
</li>
<li>
<p>add <code>&lt;$&gt;</code> and <code>&lt;*&gt;</code>, longer version of <code>liftA2</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.List (elemIndex)

x :: Maybe Int
x = elemIndex 3 [1, 2, 3, 4, 5]

y :: Maybe Int
y = elemIndex 4 [1, 2, 3, 4, 5]

max' :: Int -&gt; Int -&gt; Int
max' = max

maxed :: Maybe Int
maxed = max' &lt;$&gt; x &lt;*&gt; y</code></pre>
</div>
</div>
</li>
<li>
<p><code>(Maybe Int, Maybe Int) &#8594; Maybe Int</code> using <code>Sum</code>? dunno</p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
something is wrong here
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">xs = [1, 2, 3]
ys = [4, 5, 6]

x :: Maybe Integer
x = lookup 3 $ zip xs ys

y :: Maybe Integer
y = lookup 2 $ zip xs ys

summed :: Maybe Integer
summed = sum &lt;$&gt; (,) x y</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_identity_exercise">Identity Exercise</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">newtype Identity a = Identity a deriving (Eq, Ord, Show)

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Applicative Identity where
  pure x = Identity x
  (&lt;*&gt;) (Identity f) (Identity a) = Identity (f a)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_constant_exercise">Constant Exercise</h4>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
euuuuh, what?
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">newtype Constant a b =
  Constant { getConstant :: a }
  deriving (Eq, Ord, Show)

instance Functor (Constant a) where
  fmap _ (Constant a) = Constant a

instance Monoid a =&gt; Applicative (Constant a) where
  pure x = Constant x
  (&lt;*&gt;) (Constant a) (Constant b) = Constant (a b)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_maybe_applicative_exercise">Maybe Applicative Exercise</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>const &lt;$&gt; Just "Hello" &lt;*&gt; pure "World"</code> - pure in the context turns into Maybe</p>
</li>
<li>
<p><code>(,,,) &lt;$&gt; Just 90 &lt;*&gt; Just 10 &lt;*&gt; Just "Tierness" &lt;*&gt; pure [1, 2, 3]</code> - all has to be in Maybe, and me fmap to start with</p>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_17_8_ziplist_monoid">17.8 ZipList Monoid</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module Apl1 where

import Control.Applicative
import Data.Monoid
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

-- unfortunate orphan instances. Try to avoid these
-- in code you're going to keep or release.

instance Monoid a =&gt; Monoid (ZipList a) where
  mempty = pure mempty
  mappend = liftA2 mappend

instance Arbitrary a =&gt; Arbitrary (ZipList a) where
  arbitrary = ZipList &lt;$&gt; arbitrary

instance Arbitrary a =&gt; Arbitrary (Sum a) where
  arbitrary = Sum &lt;$&gt; arbitrary

instance Eq a =&gt; EqProp (ZipList a) where
  (=-=) = eq

-- I've made a copy from the base :)
instance Applicative ZipList where
  pure x = ZipList (repeat x)
  ZipList fs &lt;*&gt; ZipList xs = ZipList (zipWith id fs xs)

-- quickBatch $ monoid (ZipList [1 :: Sum Int])</code></pre>
</div>
</div>
<div class="sect3">
<h4 id="_list_applicative_exercise">List Applicative Exercise</h4>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
had to make somehow "limited" arbitrary, the infinite arbitrary is <code>arbitrary = Cons &lt;$&gt; arbitrary &lt;*&gt; arbitrary</code> and commented out
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

-- append :: List a -&gt; List a -&gt; List a
-- append Nil ys = ys
-- append (Cons x xs) ys = Cons x $ xs `append` ys

instance Monoid (List a) where
  mempty = Nil
  mappend a Nil = a
  mappend Nil a = a
  mappend (Cons x xs) ys = Cons x $ xs `mappend` ys

instance Arbitrary a =&gt; Arbitrary (List a) where
  -- arbitrary = Cons &lt;$&gt; arbitrary &lt;*&gt; arbitrary
  -- arbitrary = do
  --   x &lt;- arbitrary
  --   return (Cons x Nil)
  arbitrary = do
    x &lt;- arbitrary
    y &lt;- arbitrary
    return (Cons x (Cons y Nil))

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons a la) = Cons (f a) (fmap f la)

instance Applicative List where
  pure x = Cons x Nil
  (&lt;*&gt;) Nil _ = Nil
  (&lt;*&gt;) _ Nil = Nil
  (&lt;*&gt;) (Cons f b) ca = fmap f ca &lt;&gt; (b &lt;*&gt; ca)

instance Eq a =&gt; EqProp (List a) where (=-=) = eq

-- quickBatch $ applicative [("b", "w", 1)]
-- quickBatch $ applicative (Just ("b", "w", 1))
-- quickBatch $ applicative (Cons ("b", "w", 1) Nil)

functions = Cons (+1) (Cons (*2) Nil)
values = Cons 1 (Cons 2 Nil)
res = functions &lt;*&gt; values</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_exercise_3">Exercise</h4>
<div class="admonitionblock note">
<table>
<tr>
<td class="icon">
<i class="fa icon-note" title="Note"></i>
</td>
<td class="content">
the tests are taking a long time, compared to tests done so far
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

take' :: Int -&gt; List a -&gt; List a
take' 0 _ = Nil
take' _ Nil = Nil
take' n (Cons x xs) = Cons x (take' (n - 1) xs)

instance Monoid (List a) where
  mempty = Nil
  mappend a Nil = a
  mappend Nil a = a
  mappend (Cons x xs) ys = Cons x $ xs `mappend` ys

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons a la) = Cons (f a) (fmap f la)

instance Applicative List where
  pure x = Cons x Nil
  (&lt;*&gt;) Nil _ = Nil
  (&lt;*&gt;) _ Nil = Nil
  (&lt;*&gt;) (Cons f b) ca = fmap f ca &lt;&gt; (b &lt;*&gt; ca)

instance Arbitrary a =&gt; Arbitrary (List a) where
  arbitrary = Cons &lt;$&gt; arbitrary &lt;*&gt; arbitrary

newtype ZipList' a =
  ZipList' (List a)
  deriving (Eq, Show)

instance Arbitrary a =&gt; Arbitrary (ZipList' a) where
  arbitrary = ZipList' &lt;$&gt; arbitrary

instance Eq a =&gt; EqProp (ZipList' a) where
  xs =-= ys = xs' `eq` ys'
    where xs' = let (ZipList' l) = xs
                in take' 3000 l
          ys' = let (ZipList' l) = ys
                in take' 3000 l

instance Functor ZipList' where
  fmap f (ZipList' xs) = ZipList' $ fmap f xs

repeatList :: a -&gt; (List a)
repeatList x = xs
  where xs = Cons x xs

zipListWith :: (a -&gt; b -&gt; c) -&gt; (List a) -&gt; (List b) -&gt; (List c)
zipListWith _ Nil _ = Nil
zipListWith _ _ Nil = Nil
zipListWith f (Cons a as) (Cons b bs) = Cons (f a b) (zipListWith f as bs)

instance Applicative ZipList' where
  pure x = ZipList' (repeatList x)
  ZipList' fs &lt;*&gt; ZipList' xs = ZipList' (zipListWith id fs xs)

-- quickBatch $ applicative (ZipList' (Cons ("b", "w", 1) Nil))</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_exercise_4">Exercise</h4>
<div class="paragraph">
<p><code>Sum</code> and <code>Validation</code> <code>Applicative</code></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)

data Validation e a =
    Error e
  | Success a
  deriving (Eq, Show)

instance Functor (Sum a) where
  fmap _ (First a) = First a
  fmap f (Second a) = Second (f a)

instance Applicative (Sum a) where
  pure = Second
  (&lt;*&gt;) _ (First a) = First a
  (&lt;*&gt;) (First a) _ = First a
  (&lt;*&gt;) (Second f) (Second b) = Second (f b)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Sum a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [First a, Second b]

-- same as Sum/Either
instance Functor (Validation e) where
  fmap _ (Error e) = Error e
  fmap f (Success a) = Success (f a)

-- This is different
instance Monoid e =&gt; Applicative (Validation e) where
  pure = Success
  (&lt;*&gt;) (Error e) (Error e') = Error (e &lt;&gt; e')
  (&lt;*&gt;) _ (Error e) = Error e
  (&lt;*&gt;) (Error e) _ = Error e
  (&lt;*&gt;) (Success f) (Success b) = Success (f b)

instance (Eq a, Eq b) =&gt; EqProp (Sum a b) where (=-=) = eq

-- quickBatch $ applicative (Second ("b", "w", 1))
-- quickBatch $ applicative (Success ("b", "w", 1))</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_17_9_chapter_exercises">17.9 Chapter Exercises</h3>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
doing something wrong here, what do mean "specialize and test in REPL"? some hint, example?
</td>
</tr>
</table>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>[]</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(pure :: (a -&gt; [] a)) 4
[4]

((&lt;*&gt;) :: [] (a -&gt; b) -&gt; [] a -&gt; [] b) [(+1)] [1]
[2]</code></pre>
</div>
</div>
</li>
<li>
<p><code>IO</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">(pure :: a -&gt; IO a) "sdf"
"sdf"

((&lt;*&gt;) :: IO (a -&gt; b) -&gt; IO a -&gt; IO b) (return (+2)) (return 4)
6</code></pre>
</div>
</div>
</li>
<li>
<p><code>(,) a</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">((pure :: Monoid b =&gt; a -&gt; ((,) b) a) 4) :: (String, Int)
("",4)

((&lt;*&gt;) :: Monoid c =&gt; (,) c (a -&gt; b) -&gt; (,) c a -&gt; (,) c b) ("sdf", (+4)) ("sdf", 7)
("sdfsdf",11)</code></pre>
</div>
</div>
</li>
<li>
<p><code>(&#8594;) e</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">pure :: a -&gt; ((-&gt;) e) a
(&lt;*&gt;) :: ((-&gt;) e) (a -&gt; b) -&gt; ((-&gt;) e) a -&gt; ((-&gt;) e) b</code></pre>
</div>
</div>
</li>
</ol>
</div>
<div class="paragraph">
<p>For all of those, you need also <code>deriving Eq</code> so you can use quickcheck</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>newtype Identity a = Identity a deriving Show</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

newtype Identity a = Identity a deriving (Eq, Show)

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Applicative Identity where
  pure = Identity
  (&lt;*&gt;) (Identity f) x = fmap f x

instance Arbitrary a =&gt; Arbitrary (Identity a) where
  arbitrary = do
    a &lt;- arbitrary
    return (Identity a)

instance Eq a =&gt; EqProp (Identity a) where (=-=) = eq

-- quickBatch $ applicative (Identity ("b", "w", 1))</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Pair a = Pair a a deriving Show</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Pair a = Pair a a deriving (Eq, Show)

instance Functor Pair where
  fmap f (Pair a b) = Pair (f a) (f b)

instance Applicative Pair where
  pure x = Pair x x
  (&lt;*&gt;) (Pair f f') (Pair a a') = Pair (f a) (f' a')

instance Arbitrary a =&gt; Arbitrary (Pair a) where
  arbitrary = do
    a &lt;- arbitrary
    return (Pair a a)

instance Eq a =&gt; EqProp (Pair a) where (=-=) = eq

-- quickBatch $ applicative (Pair ("b", "w", 1) ("b", "w", 1))</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Two a b = Two a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Two a b = Two a b deriving (Eq, Show)

instance Functor (Two a) where
  fmap f (Two a b) = Two a (f b)

instance Monoid a =&gt; Applicative (Two a) where
  pure x = Two mempty x
  (&lt;*&gt;) (Two a f) (Two a' b) = Two (a &lt;&gt; a') (f b)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Two a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    return (Two a b)

instance (Eq a, Eq b) =&gt; EqProp (Two a b) where (=-=) = eq

-- quickBatch $ applicative (Two ("b", "w", [1]) ("b", ["w"], 1))
-- quickBatch $ applicative (undefined :: Two String (Int, Double, Char))</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Three a b c = Three a b c</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Three a b c = Three a b c deriving (Eq, Show)

instance Functor (Three a b) where
  fmap f (Three a b c) = Three a b (f c)

instance (Monoid a, Monoid b) =&gt; Applicative (Three a b) where
  pure x = Three mempty mempty x
  (&lt;*&gt;) (Three a b f) (Three a' b' c) = Three (a &lt;&gt; a') (b &lt;&gt; b') (f c)

instance (Arbitrary a, Arbitrary b, Arbitrary c) =&gt; Arbitrary (Three a b c) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    c &lt;- arbitrary
    return (Three a b c)

instance (Eq a, Eq b, Eq c) =&gt; EqProp (Three a b c) where (=-=) = eq

-- quickBatch $ applicative (Three ("b", "w", [1]) ("b", ["w"], [1]) (["b"], "w", 1))
-- quickBatch $ applicative (undefined :: Three String (String, String, [Int]) (Int, Double, Char))</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Three' a b = Three' a b b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Three' a b = Three' a b b deriving (Eq, Show)

instance Functor (Three' a) where
  fmap f (Three' a b b') = Three' a (f b) (f b')

instance Monoid a =&gt; Applicative (Three' a) where
  pure x = Three' mempty x x
  (&lt;*&gt;) (Three' a f f') (Three' a' b b') = Three' (a &lt;&gt; a') (f b) (f b')

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Three' a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    return (Three' a b b)

instance (Eq a, Eq b) =&gt; EqProp (Three' a b) where (=-=) = eq

-- error - the first value needs to me Monoid, but the 3rd value in the tuple is Num, no clear Monoid there
-- quickBatch $ applicative (Three' ("b", "w", 1) ("b", "w", 1) ("b", "w", 1))

-- quickBatch $ applicative (Three' "b" ("f", "f", 4) ("c", "h", 2))
-- quickBatch $ applicative (undefined :: Three' String (Int, Double, Char))</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Four a b c d = Four a b c d</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Four a b c d = Four a b c d deriving (Eq, Show)

instance Functor (Four a b c) where
  fmap f (Four a b c d) = Four a b c (f d)

instance (Monoid a, Monoid b, Monoid c) =&gt; Applicative (Four a b c) where
  pure = Four mempty mempty mempty
  (&lt;*&gt;) (Four a b c f) (Four a' b' c' d) = Four (a &lt;&gt; a') (b &lt;&gt; b') (c &lt;&gt; c') (f d)

instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =&gt; Arbitrary (Four a b c d) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    c &lt;- arbitrary
    d &lt;- arbitrary
    return (Four a b c d)

instance (Eq a, Eq b, Eq c, Eq d) =&gt; EqProp (Four a b c d) where (=-=) = eq

-- quickBatch $ applicative (Four "b" [1] "c" ("c", "h", 2))
-- quickBatch $ applicative (undefined :: Four String [Int] String (Int, Double, Char))</code></pre>
</div>
</div>
</li>
<li>
<p><code>data Four' a b = Four' a a a b</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative)

data Four' a b = Four' a a a b deriving (Eq, Show)

instance Functor (Four' a) where
  fmap f (Four' a b c d) = Four' a b c (f d)

instance Monoid a =&gt; Applicative (Four' a) where
  pure = Four' mempty mempty mempty
  (&lt;*&gt;) (Four' a b c f) (Four' a' b' c' d) = Four' (a &lt;&gt; a') (b &lt;&gt; b') (c &lt;&gt; c') (f d)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Four' a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    c &lt;- arbitrary
    d &lt;- arbitrary
    return (Four' a b c d)

instance (Eq a, Eq b) =&gt; EqProp (Four' a b) where (=-=) = eq

-- quickBatch $ applicative (Four' [2] [1] [1] ("c", "h", 2))
-- quickBatch $ applicative (undefined :: Four' String (Int, Double, Char))</code></pre>
</div>
</div>
</li>
</ol>
</div>
<div class="sect3">
<h4 id="_combinations">Combinations</h4>
<div class="paragraph">
<p>neat, but not sure how I would put some condition in</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative (liftA3)

stops, vowels :: String
stops = "pbtdkg"
vowels = "aeiou"

combos :: [a] -&gt; [b] -&gt; [c] -&gt; [(a, b, c)]
combos a b c = liftA3 (,,) a b c</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_18_monad">18 Monad</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_18_2_sorry_monad_is_not_a_burrito">18.2 Sorry — Monad is not a burrito</h3>
<div class="paragraph">
<p>Write <code>bind</code> using <code>fmap</code> and <code>join</code></p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad (join)

bind :: Monad m =&gt; (a -&gt; m b) -&gt; m a -&gt; m b
bind f x = join $ fmap f x

-- bind (\ x -&gt; [x,1]) [4,5,6]</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_18_4_examples_of_monad_use">18.4 Examples of Monad use</h3>
<div class="sect3">
<h4 id="_list">List</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">twiceWhenEven :: [Integer] -&gt; [Integer]
twiceWhenEven xs = do
  x &lt;- xs
  if even x
    then [x*x, x*x]
    else []

twiceWhenEven' :: [Integer] -&gt; [Integer]
twiceWhenEven' xs = do
  x &lt;- xs
  if even x
    then [x*x, x*x]
    else [x*x]</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_either">Either</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid (Monoid, (&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (applicative, monad)

data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Sum a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [First a, Second b]

instance Functor (Sum a) where
  fmap _ (First a) = First a
  fmap f (Second a) = Second (f a)

instance Applicative (Sum a) where
  pure = Second
  (&lt;*&gt;) _ (First a) = First a
  (&lt;*&gt;) (First a) _ = First a
  (&lt;*&gt;) (Second f) (Second b) = Second (f b)

instance Monad (Sum a) where
  return = pure
  (&gt;&gt;=) (First a) _ = First a
  (&gt;&gt;=) (Second a) f = f a

instance (Eq a, Eq b) =&gt; EqProp (Sum a b) where (=-=) = eq

-- quickBatch $ applicative (Second ("b", "w", 1))
-- quickBatch $ monad (Second ("b", "w", 1))</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_18_5_monad_laws">18.5 Monad laws</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module BadMonad where
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

data CountMe a =
  CountMe Integer a
  deriving (Eq, Show)

instance Functor CountMe where
  fmap f (CountMe i a) = CountMe (i+1) (f a)

instance Applicative CountMe where
  pure = CountMe 0
  CountMe n f &lt;*&gt; CountMe n' a = CountMe (n + n') (f a)

instance Monad CountMe where
  return = pure
  CountMe n a &gt;&gt;= f =
    let CountMe _ b = f a
    in CountMe (n+1) b

instance Arbitrary a =&gt; Arbitrary (CountMe a) where
  arbitrary = CountMe &lt;$&gt; arbitrary &lt;*&gt; arbitrary

instance Eq a =&gt; EqProp (CountMe a) where (=-=) = eq

main = do
  let trigger = undefined :: CountMe (Int, String, Int)
  quickBatch $ functor trigger
  quickBatch $ applicative trigger
  quickBatch $ monad trigger</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_18_7_chapter_exercises">18.7 Chapter Exercises</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>interesting</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

data Nope a =
  NopeDotJpg
  deriving (Show, Eq)

instance Functor Nope where
  fmap _ NopeDotJpg = NopeDotJpg

instance Applicative Nope where
  pure x = NopeDotJpg
  _ &lt;*&gt; _ = NopeDotJpg

instance Monad Nope where
  return = pure
  NopeDotJpg &gt;&gt;= f = NopeDotJpg

instance Arbitrary a =&gt; Arbitrary (Nope a) where
  arbitrary = return NopeDotJpg

instance Eq a =&gt; EqProp (Nope a) where (=-=) = eq

main = do
  let trigger = undefined :: Nope (Int, String, Int)
  quickBatch $ functor trigger
  quickBatch $ applicative trigger
  quickBatch $ monad trigger</code></pre>
</div>
</div>
</li>
<li>
<p>I took the <code>Either</code> example and just search/replace, <code>a</code> and <code>b</code> flipped, therefore <code>Left</code> and <code>Right</code> flipped too. Had to hide <code>Left</code> and <code>Right</code> not to collide with those from <code>Prelude</code>.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Prelude hiding (Left, Right)

import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

data PhhhbbtttEither b a =
    Left a
  | Right b
  deriving (Show, Eq)

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (PhhhbbtttEither a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    elements [Left b, Right a]

instance Functor (PhhhbbtttEither a) where
  fmap _ (Right a) = Right a
  fmap f (Left a) = Left (f a)

instance Applicative (PhhhbbtttEither a) where
  pure = Left
  (&lt;*&gt;) _ (Right a) = Right a
  (&lt;*&gt;) (Right a) _ = Right a
  (&lt;*&gt;) (Left f) (Left b) = Left (f b)

instance Monad (PhhhbbtttEither a) where
  return = pure
  (&gt;&gt;=) (Right a) _ = Right a
  (&gt;&gt;=) (Left a) f = f a

instance (Eq a, Eq b) =&gt; EqProp (PhhhbbtttEither a b) where (=-=) = eq

main = do
  let trigger = undefined :: PhhhbbtttEither String (Int, String, Int)
  quickBatch $ functor trigger
  quickBatch $ applicative trigger
  quickBatch $ monad trigger</code></pre>
</div>
</div>
</li>
<li>
<p>this went ok</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

newtype Identity a = Identity a
  deriving (Eq, Ord, Show)

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Applicative Identity where
  pure = Identity
  (&lt;*&gt;) (Identity f) (Identity a) = Identity (f a)

instance Monad Identity where
  return = pure
  (&gt;&gt;=) (Identity a) f = f a

instance Arbitrary a =&gt; Arbitrary (Identity a) where
  -- arbitrary = do
  --   a &lt;- arbitrary
  --   return (Identity a)
  arbitrary = Identity &lt;$&gt; arbitrary

instance Eq a =&gt; EqProp (Identity a) where (=-=) = eq

main = do
  let trigger = undefined :: Identity (Int, String, Int)
  quickBatch $ functor trigger
  quickBatch $ applicative trigger
  quickBatch $ monad trigger</code></pre>
</div>
</div>
</li>
<li>
<p>pretty cool, I had to fix the <code>Arbitrary</code> instance for <code>List</code>. I had it broken before.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Monoid
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

take' :: Int -&gt; List a -&gt; List a
take' 0 _ = Nil
take' _ Nil = Nil
take' n (Cons x xs) = Cons x (take' (n - 1) xs)

instance Monoid (List a) where
  mempty = Nil
  mappend a Nil = a
  mappend Nil a = a
  mappend (Cons x xs) ys = Cons x $ xs `mappend` ys

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons a la) = Cons (f a) (fmap f la)

instance Applicative List where
  pure x = Cons x Nil
  (&lt;*&gt;) Nil _ = Nil
  (&lt;*&gt;) _ Nil = Nil
  (&lt;*&gt;) (Cons f b) ca = fmap f ca &lt;&gt; (b &lt;*&gt; ca)

instance Monad List where
  return = pure
  (&gt;&gt;=) Nil _ = Nil
  (&gt;&gt;=) (Cons a la) f = f a &lt;&gt; (la &gt;&gt;= f)

instance Arbitrary a =&gt; Arbitrary (List a) where
  -- this breaks
  -- arbitrary = Cons &lt;$&gt; arbitrary &lt;*&gt; arbitrary
  arbitrary = do
    x &lt;- arbitrary
    y &lt;- arbitrary
    frequency [(1, return Nil),
               (10, return (Cons x y))]

instance Eq a =&gt; EqProp (List a) where
  xs =-= ys = xs' `eq` ys'
    where xs' = take' 3000 xs
          ys' = take' 3000 ys

main = do
  let trigger = undefined :: List (Int, String, Int)
  quickBatch $ functor trigger
  quickBatch $ applicative trigger
  quickBatch $ monad trigger</code></pre>
</div>
</div>
</li>
<li>
<p><code>let j :: Monad m &#8658; m (m a) &#8594; m a; j = join</code></p>
</li>
<li>
<p><code>let l1 :: Monad m &#8658; (a &#8594; b) &#8594; m a &#8594; m b; l1 = liftM</code></p>
</li>
<li>
<p><code>let l2 :: Monad m &#8658; (a &#8594; b &#8594; c) &#8594; m a &#8594; m b &#8594; m c; l2 = liftM2</code></p>
</li>
<li>
<p><code>let a :: Monad m &#8658; m a &#8594; m (a &#8594; b) &#8594; m b; a = flip ap</code></p>
</li>
<li>
<p>Kinda clunky and there is already <code>forM</code> that does that. Anyway, I cracked it. Good feeling.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">meh :: Monad m =&gt; [a] -&gt; (a -&gt; m b) -&gt; m [b]
meh [] _ = pure []
meh (x:xs) f = (++) &lt;$&gt; (fmap (\a -&gt; [a]) $ f x) &lt;*&gt; (meh xs f)

main = do
  print $ meh [1..10] (\x -&gt; if odd x then Just x else Just (x * 2))</code></pre>
</div>
</div>
</li>
<li>
<p>Still not totally clear about <code>join</code>, need to play with it more. And again <code>sequence</code> does just the same.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad (join)


meh :: Monad m =&gt; [a] -&gt; (a -&gt; m b) -&gt; m [b]
meh [] _ = pure []
meh (x:xs) f = (++) &lt;$&gt; (fmap (\a -&gt; [a]) $ f x) &lt;*&gt; (meh xs f)

flipType :: (Monad m) =&gt; [m a] -&gt; m [a]
flipType xs = meh xs (join . pure)

main = do
  print $ flipType [Just 2, Just 5, Just 10]</code></pre>
</div>
</div>
</li>
<li>
<p>and this a much better version, also now makes much more sense when I came back to it</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad (join)


meh :: Monad m =&gt; [a] -&gt; (a -&gt; m b) -&gt; m [b]
meh [] _ = pure []
meh (x:xs) f = (:) &lt;$&gt; (f x) &lt;*&gt; (meh xs f)

flipType :: (Monad m) =&gt; [m a] -&gt; m [a]
flipType xs = meh xs id

main = do
  print $ flipType [Just 2, Just 5, Just 10]</code></pre>
</div>
</div>
</li>
<li>
<p>I can just with <code>Applicative</code> and it works too. I did not use any monadic function here.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad (join)


meh :: Applicative m =&gt; [a] -&gt; (a -&gt; m b) -&gt; m [b]
meh [] _ = pure []
meh (x:xs) f = (:) &lt;$&gt; (f x) &lt;*&gt; (meh xs f)

flipType :: (Applicative m) =&gt; [m a] -&gt; m [a]
flipType xs = meh xs id

main = do
  print $ flipType [Just 2, Just 5, Just 10]</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_19_applying_structure">19 Applying structure</h2>
<div class="sectionbody">
<div class="paragraph">
<p>Yes, went through it, and will come back in the future.</p>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_20_foldable">20 Foldable</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_20_5_some_basic_derived_operations">20.5 Some basic derived operations</h3>
<div class="sect3">
<h4 id="_exercises_2">Exercises</h4>
<div class="paragraph">
<p>In all these, the key point to realise is that all the elements need to be monoids and we need the appropriate monoid to give the functionality we need.</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>sum</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (sum)
import Prelude hiding (sum)

sum :: (Foldable t, Num a) =&gt; t a -&gt; a
sum x = getSum $ foldMap Sum x

main = do
  print $ sum [1,2,3] == 6
  print $ sum (Just 3) == 3
  print $ sum Nothing == 0
  print $ fmap sum (Just [1,2,3]) == Just 6</code></pre>
</div>
</div>
</li>
<li>
<p><code>product</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (product)
import Prelude hiding (product)

product :: (Foldable t, Num a) =&gt; t a -&gt; a
product x = getProduct $ foldMap Product x

main = do
  print $ product [10,2,3]
  print $ product (Just 3)
  print $ product Nothing
  print $ fmap product (Just [10,2,3])</code></pre>
</div>
</div>
</li>
<li>
<p><code>elem</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (elem)
import Prelude hiding (elem)

elem :: (Foldable t, Eq a) =&gt; a -&gt; t a -&gt; Bool
elem el xs = getAny $ foldMap (\e -&gt; Any $ e == el ) xs

main = do
  print $ elem 2 (Just 3)
  print $ elem True (Right True)
  print $ fmap (elem 3) [Right 1, Right 2, Right 3]</code></pre>
</div>
</div>
</li>
<li>
<p><code>minimum</code> that does not break, we have <code>Maybe</code>. Had to look in the <code>Foldable</code> source code and discovered nice <code>Min</code> type that did not show in the docs because it is not exported &#8230;&#8203;. :/ So I&#8217;ve copied it.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (minimum)
import Prelude hiding (minimum)

newtype Min a = Min {getMin :: Maybe a}

instance Ord a =&gt; Monoid (Min a) where
  mempty = Min Nothing
  m `mappend` Min Nothing = m
  Min Nothing `mappend` n = n
  (Min m@(Just x)) `mappend` (Min n@(Just y))
    | x &lt;= y    = Min m
    | otherwise = Min n

-- original minumum sigranute, t is Foldable, it comes from class
-- minimum :: forall a. Ord a =&gt; t a -&gt; a
minimum :: (Foldable t, Ord a) =&gt; t a -&gt; Maybe a
minimum xs = getMin $ foldMap (\a -&gt; Min {getMin = Just a}) xs

main = do
  print $ minimum "julie"
  print $ fmap minimum (Just "julie")
  print $ fmap minimum [Just 'j', Just 'u', Just 'l']
  print $ fmap minimum [Just 4, Just 3, Nothing]
  -- print $ minimum (Left 3)
  -- works only in GHCI, don't know why
  -- ends up with
  -- No instance for (Ord a0) arising from a use of ‘minimum’
  -- but Either has Ord</code></pre>
</div>
</div>
</li>
<li>
<p><code>maximum</code> - same story as with <code>minimum</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (maximum)
import Prelude hiding (maximum)


newtype Max a = Max {getMax :: Maybe a}

instance Ord a =&gt; Monoid (Max a) where
  mempty = Max Nothing

  m `mappend` Max Nothing = m
  Max Nothing `mappend` n = n
  (Max m@(Just x)) `mappend` (Max n@(Just y))
    | x &gt;= y    = Max m
    | otherwise = Max n

maximum :: (Foldable t, Ord a) =&gt; t a -&gt; Maybe a
maximum xs = getMax $ foldMap (\a -&gt; Max {getMax = Just a}) xs

main = do
  print $ maximum "julie"
  print $ fmap maximum (Just "julie")
  print $ fmap maximum [Just 'j', Just 'u', Just 'l']
  print $ fmap maximum [Just 4, Just 3, Nothing]</code></pre>
</div>
</div>
</li>
<li>
<p><code>null</code>, okay, my line of toughts was that if it is empty, the length should be 0. The official sources think otherwise, not bad tough: <code>null = foldr (\_ _ &#8594; False) True</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (null)
import Prelude hiding (null)

null :: (Foldable t) =&gt; t a -&gt; Bool
null x = length x == 0

main = do
  print $ null (Left 3)
  print $ null []
  print $ null Nothing
  print $ null (1, 2)
  print $ fmap null [Just 1, Just 2, Nothing]</code></pre>
</div>
</div>
</li>
<li>
<p><code>length</code> I have learned the trick from 'null' source code :)</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (length)
import Prelude hiding (length)

length :: (Foldable t) =&gt; t a -&gt; Int
length xs = foldr (\a b -&gt; b + 1) 0 xs

main = do
  print $ length (1, 2)
  print $ length [(1, 2), (3, 4), (5, 6)]
  print $ fmap length [(1, 2), (3, 4), (5, 6)]
  print $ fmap length Just [1, 2, 3]
  print $ fmap length [Just 1, Just 2, Just 3]
  print $ fmap length [Just 1, Just 2, Nothing]</code></pre>
</div>
</div>
</li>
<li>
<p><code>toList</code> is just an old school <code>foldr</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (toList)
import Prelude hiding (toList)

toList :: (Foldable t) =&gt; t a -&gt; [a]
toList xs = foldr (:) [] xs

main = do
  print $ toList (Just 1)
  print $ map toList [Just 1, Just 2, Just 3]
  print $ concatMap toList [Just 1, Just 2, Just 3]
  print $ concatMap toList [Just 1, Just 2, Nothing]
  print $ toList (1, 2)</code></pre>
</div>
</div>
</li>
<li>
<p><code>fold</code>, thanks for the <code>foldMap</code> hint ;), after that the difference in the signatures made it all clear. neat</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (fold)
import Prelude hiding (fold)

-- foldMap :: Monoid m =&gt; (a -&gt; m) -&gt; t a -&gt; m

fold :: (Foldable t, Monoid m) =&gt; t m -&gt; m
fold xs = foldMap id xs

main = do
  print $ fold ["a", "b", "c"]</code></pre>
</div>
</div>
</li>
<li>
<p><code>foldMap</code>, the official code uses <code>foldMap f = foldr (mappend . f) mempty</code>. Okay, I&#8217;ve learned something here.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable hiding (foldMap)
import Prelude hiding (foldMap)

foldMap :: (Foldable t, Monoid m) =&gt; (a -&gt; m) -&gt; t a -&gt; m
foldMap f xs = foldr (\x y -&gt; f x &lt;&gt; y) mempty xs

main = do
  print $ foldMap Sum [1, 2, 3]</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_20_6_chapter_exercises">20.6 Chapter Exercises</h3>
<div class="paragraph">
<p>These exercises basically go from zero to three arguments to work with - in a way. The only way how to produce single value in multiple arguments was to <code>mappend</code> them. I hope this is right. Real life example would help.</p>
</div>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>Constant</code> This one is interesting, what decides the resulting type (and the value) is actually the function we are passing. The type of the function to be specific. Yeah, what else const as Foldable can be.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable

data Constant a b =
  Constant a

instance Foldable (Constant a) where
  foldMap _ _ = mempty

main = do
  print $ foldMap Sum (Constant 1)
  -- Sum {getSum = 0}
  print $ foldMap Any (Constant 1)
  -- Any {getAny = False}
  print $ foldMap (\x -&gt; Any True) (Constant 1)
  -- Any {getAny = False}</code></pre>
</div>
</div>
</li>
<li>
<p><code>Two</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable

data Two a b =
  Two a b

instance Foldable (Two a) where
  foldMap f (Two a b) = f b

main = do
  print $ foldMap Sum (Two 1 2)
  print $ foldMap Any (Two "a" False)</code></pre>
</div>
</div>
</li>
<li>
<p><code>Three</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable

data Three a b c =
  Three a b c

instance Foldable (Three a b) where
  foldMap f (Three a b c) = f c

main = do
  print $ foldMap Sum (Three "a" 1 2)
  print $ foldMap Any (Three 1 "a" False)</code></pre>
</div>
</div>
</li>
<li>
<p><code>Three'</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable

data Three' a b =
  Three' a b b

instance Foldable (Three' a) where
  foldMap f (Three' a b c) = f b &lt;&gt; f c

main = do
  print $ foldMap Sum (Three' "a" 1 2)
  print $ foldMap Any (Three' 1 True False)</code></pre>
</div>
</div>
</li>
<li>
<p><code>Four'</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable

data Four' a b =
  Four' a b b b

instance Foldable (Four' a) where
  foldMap f (Four' a b c d) = f b &lt;&gt; f c &lt;&gt; f c

main = do
  print $ foldMap Sum (Four' "a" 1 2 10)
  print $ foldMap Any (Four' 1 True False True)</code></pre>
</div>
</div>
</li>
</ol>
</div>
<div class="paragraph">
<p>Yaaaay, <code>filterF</code>. Got stuck because I messed up types in <code>foldMap</code>, had to peek in the answer, then I saw my mistake. Therefore, to have correct answers is crucial!!!</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid
import Data.Foldable

filterF :: (Applicative f, Foldable f, Monoid (f a)) =&gt; (a -&gt; Bool) -&gt; f a -&gt; f a
filterF f xs = foldMap fb xs
  where fb x = if f x -- (a -&gt; Bool), here I mixed the types before
                then mempty -- Monoid
                else pure x -- Applicative

main = do
  print $ filterF odd [1..10]</code></pre>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_21_traversable">21 Traversable</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_21_12_chapter_exercises">21.12 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_traversable_instances">Traversable instances</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Identity</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

newtype Identity a = Identity a
  deriving (Eq, Ord, Show)

type TI = Identity

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Foldable Identity where
  foldMap f (Identity a) = f a

instance Traversable Identity where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse f (Identity a) = Identity &lt;$&gt; f a

instance Arbitrary a =&gt; Arbitrary (Identity a) where
  arbitrary = do
    a &lt;- arbitrary
    return (Identity a)

instance Eq a =&gt; EqProp (Identity a) where (=-=) = eq

main = do
  let trigger = undefined :: TI (Int, Int, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
<li>
<p>Constant</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

newtype Constant a b =
  Constant { getConstant :: a }
  deriving (Eq, Ord, Show)

type TI a = Constant a

instance Functor (Constant a) where
  fmap _ (Constant a) = Constant a
  -- does not work, why?
  -- fmap _ c = c

instance Foldable (Constant a) where
  foldMap _ _ = mempty

instance Traversable (Constant a) where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse _ (Constant a) = pure $ Constant a

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Constant a b) where
  arbitrary = do
    a &lt;- arbitrary
    return (Constant a)

instance (Eq a, Eq b) =&gt; EqProp (Constant a b) where (=-=) = eq

main = do
  let trigger = undefined :: TI Int (Int, Int, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
<li>
<p>Maybe</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary, elements)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

data Optional a =
    Nada
  | Yep a
  deriving (Eq, Ord, Show)

instance Functor Optional where
  fmap _ Nada = Nada
  fmap f (Yep a) = Yep (f a)

instance Foldable Optional where
  foldMap _ Nada = mempty
  foldMap f (Yep a) = f a

instance Traversable Optional where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse _ Nada = pure $ Nada
  traverse f (Yep a) = Yep &lt;$&gt; f a

instance Arbitrary a =&gt; Arbitrary (Optional a) where
  arbitrary = do
    a &lt;- arbitrary
    elements [Nada, (Yep a)]

instance Eq a =&gt; EqProp (Optional a) where (=-=) = eq

main = do
  let trigger = undefined :: Optional (Int, Int, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
<li>
<p>List</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid ((&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary, frequency)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Ord, Show)

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons a la) = Cons (f a) (fmap f la)

instance Foldable List where
  foldMap _ Nil = mempty
  foldMap f (Cons a as) = f a &lt;&gt; foldMap f as

instance Traversable List where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse f Nil = pure Nil
  traverse f (Cons a as) = Cons &lt;$&gt; f a &lt;*&gt; traverse f as

instance Arbitrary a =&gt; Arbitrary (List a) where
  arbitrary = do
    x &lt;- arbitrary
    y &lt;- arbitrary
    frequency [(1, return Nil),
               (10, return (Cons x y))]

take' :: Int -&gt; List a -&gt; List a
take' 0 _ = Nil
take' _ Nil = Nil
take' n (Cons x xs) = Cons x (take' (n - 1) xs)

instance Eq a =&gt; EqProp (List a) where
  xs =-= ys = xs' `eq` ys'
    where xs' = take' 3000 xs
          ys' = take' 3000 ys

main = do
  let trigger = undefined :: List (Int, Int, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
<li>
<p>Tree</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Test.QuickCheck (Arbitrary, arbitrary)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

data Three a b c =
  Three a b c
  deriving (Eq, Ord, Show)

instance Functor (Three a b) where
  fmap f (Three a b c) = Three a b (f c)

instance Foldable (Three a b) where
  foldMap f (Three a b c) = f c

instance Traversable (Three a b) where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse f (Three a b c) = (Three a b) &lt;$&gt; f c

instance (Arbitrary a, Arbitrary b, Arbitrary c) =&gt; Arbitrary (Three a b c) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    c &lt;- arbitrary
    return (Three a b c)

instance (Eq a, Eq b, Eq c) =&gt; EqProp (Three a b c) where (=-=) = eq

main = do
  let trigger = undefined :: Three Int Int (Int, String, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
<li>
<p>Tree'</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid ((&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

data Three' a b =
  Three' a b b
  deriving (Eq, Ord, Show)

instance Functor (Three' a) where
  fmap f (Three' a b c) = Three' a (f b) (f c)

instance Foldable (Three' a) where
  foldMap f (Three' a b c) = (f b) &lt;&gt; (f c)

instance Traversable (Three' a) where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse f (Three' a b c) = (Three' a) &lt;$&gt; f b &lt;*&gt; f c

instance (Arbitrary a, Arbitrary b) =&gt; Arbitrary (Three' a b) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    return (Three' a b b)

instance (Eq a, Eq b) =&gt; EqProp (Three' a b) where (=-=) = eq

main = do
  let trigger = undefined :: Three' Int (Int, String, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
<li>
<p>S</p>
<div class="admonitionblock note">
<table>
<tr>
<td class="icon">
<i class="fa icon-note" title="Note"></i>
</td>
<td class="content">
tests are passing, but I kind of hacked it until it compiled. Also, hardcoded use of <code>[]</code> for the inner type. Don&#8217;t know how to generate one :(
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE FlexibleInstances #-}

import Data.Monoid ((&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

data S n a = S (n a) a
  deriving (Eq, Ord, Show)

instance Functor n =&gt; Functor (S n) where
  fmap f (S na a) = S (fmap f na) (f a)

instance Foldable n =&gt; Foldable (S n) where
  foldMap f (S na a) = (foldMap f na) &lt;&gt; (f a)

instance Traversable n =&gt; Traversable (S n) where
  -- traverse :: (Applicative f, Traversable t) =&gt; (a -&gt; f b) -&gt; t a -&gt; f (t b)
  traverse f (S na a) = S &lt;$&gt; traverse f na &lt;*&gt; f a

instance Arbitrary a =&gt; Arbitrary (S [] a) where
  arbitrary = do
    a &lt;- arbitrary
    b &lt;- arbitrary
    return (S [a] b)

instance Eq a =&gt; EqProp (S [] a) where (=-=) = eq

main = do
  let trigger = undefined :: S [] (Int, String, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
<div class="sect3">
<h4 id="_instances_for_tree">Instances for Tree</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Monoid ((&lt;&gt;))
import Test.QuickCheck (Arbitrary, arbitrary,frequency)
import Test.QuickCheck.Checkers (quickBatch, eq, (=-=), EqProp)
import Test.QuickCheck.Classes (traversable)

data Tree a =
    Empty
  | Leaf a
  | Node (Tree a) a (Tree a)
  deriving (Eq, Show)

instance Functor Tree where
  fmap _ Empty = Empty
  fmap f (Leaf a) = Leaf (f a)
  fmap f (Node tl a tr) = Node (fmap f tl) (f a) (fmap f tr)

-- foldMap is a bit easier and looks more natural,
-- but you can do foldr too for extra credit.
instance Foldable Tree where
  foldMap _ Empty = mempty
  foldMap f (Leaf a) = f a
  foldMap f (Node tl a tr) = (foldMap f tl) &lt;&gt; (f a) &lt;&gt; (foldMap f tr)
  -- the extra credit :)
  -- I need Monoid, but I cannot get it :/
  -- the Endo trick is now beyond me
  -- foldr f z Empty = z
  -- foldr f z (Leaf a) = f a z
  -- foldr f z (Node tl a tr) = (foldr f z tl) &lt;&gt; (f a z) &lt;&gt; (foldr f z tr)

instance Traversable Tree where
  traverse _ Empty = pure Empty
  traverse f (Leaf a) = Leaf &lt;$&gt; f a
  traverse f (Node tl a tr) = Node &lt;$&gt; (traverse f tl) &lt;*&gt; (f a) &lt;*&gt; (traverse f tr)

instance Arbitrary a =&gt; Arbitrary (Tree a) where
  arbitrary = do
    x &lt;- arbitrary
    l &lt;- arbitrary
    r &lt;- arbitrary
    frequency [(1, return Empty),
               (1, return (Leaf x)),
               (1, return (Node l x r))]

instance Eq a =&gt; EqProp (Tree a) where (=-=) = eq

main = do
  let trigger = undefined :: Tree (Int, String, [Int])
  quickBatch (traversable trigger)</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_22_reader">22 Reader</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_22_2_a_new_beginning">22.2 A new beginning</h3>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative

hurr :: Num a =&gt; a -&gt; a
hurr = (*2)

durr :: Num a =&gt; a -&gt; a
durr = (+10)

m :: Num a =&gt; a -&gt; a
m = hurr . durr

m' :: Integer -&gt; Integer
m' = fmap hurr durr

m2 :: Integer -&gt; Integer
m2 = (+) &lt;$&gt; hurr &lt;*&gt; durr

m3 :: Integer -&gt; Integer
m3 = liftA2 (+) hurr durr

hurrDurr :: Integer -&gt; Integer
hurrDurr = do
    a &lt;- hurr
    b &lt;- durr
    return (a + b)</code></pre>
</div>
</div>
<div class="sect3">
<h4 id="_short_exercise">Short Exercise</h4>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Data.Char
import Control.Applicative (liftA2)

cap :: [Char] -&gt; [Char]
cap xs = map toUpper xs

rev :: [Char] -&gt; [Char]
rev xs = reverse xs

composed :: [Char] -&gt; [Char]
composed = cap . rev

fmapped :: [Char] -&gt; [Char]
fmapped = fmap cap rev

tupled :: [Char] -&gt; ([Char], [Char])
tupled = (,) &lt;$&gt; cap &lt;*&gt; rev

tupled' :: [Char] -&gt; ([Char], [Char])
tupled' = liftA2 (,) cap rev

tupled_do :: [Char] -&gt; ([Char], [Char])
tupled_do = do
  a &lt;- rev
  b &lt;- cap
  return (a, b)

tupled_bind :: [Char] -&gt; ([Char], [Char])
tupled_bind = rev &gt;&gt;= \x1 -&gt; cap &gt;&gt;= \x2 -&gt; return (x1, x2)</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_22_5_but_uh_reader">22.5 But uh, Reader?</h3>
<div class="sect3">
<h4 id="_exercise_5">Exercise</h4>
<div class="paragraph">
<p>It is correct, but cannot make it compile. Even after installing <code>mtl</code> package, I get <code>Not in scope: data constructor 'Reader'</code>.</p>
</div>
<div class="paragraph">
<p>So i added the <code>newtype Reader</code> definition by hand. I tought this is generally available</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">newtype Reader r a = Reader { runReader :: r -&gt; a }

ask :: Reader a a
ask = Reader id</code></pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_22_6_functions_have_an_applicative_too">22.6 Functions have an Applicative too</h3>
<div class="sect3">
<h4 id="_exercise_6">Exercise</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>myLiftA2</code>, I feel like I am cheating.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">myLiftA2 :: Applicative f =&gt;  (a -&gt; b -&gt; c) -&gt; f a -&gt; f b -&gt; f c
myLiftA2 a b c = a &lt;$&gt; b &lt;*&gt; c</code></pre>
</div>
</div>
</li>
<li>
<p><code>asks</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">newtype Reader r a = Reader { runReader :: r -&gt; a }

asks :: (r -&gt; a) -&gt; Reader r a
asks f = Reader f</code></pre>
</div>
</div>
</li>
<li>
<p><code>Applicative</code>, had to also make <code>Functor</code> for it :|</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">-- you'll need this pragma
{-# LANGUAGE InstanceSigs #-}

newtype Reader r a = Reader { runReader :: r -&gt; a }

instance Functor (Reader r) where
  fmap f (Reader ra) = Reader $ (f . ra)

instance Applicative (Reader r) where
  pure :: a -&gt; Reader r a
  pure a = Reader $ \r -&gt; a

  (&lt;*&gt;) :: Reader r (a -&gt; b)
        -&gt; Reader r a
        -&gt; Reader r b

  (Reader rab) &lt;*&gt; (Reader ra) =
    Reader $ \r -&gt; rab r (ra r)</code></pre>
</div>
</div>
</li>
<li>
<p>I would explain it as implementation of <code>Reader</code>.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE InstanceSigs #-}

import Control.Applicative (liftA2)

newtype Reader r a = Reader { runReader :: r -&gt; a }

instance Functor (Reader r) where
  fmap f (Reader ra) = Reader $ (f . ra)

instance Applicative (Reader r) where
  pure :: a -&gt; Reader r a
  pure a = Reader $ \r -&gt; a

  (&lt;*&gt;) :: Reader r (a -&gt; b)
        -&gt; Reader r a
        -&gt; Reader r b

  (Reader rab) &lt;*&gt; (Reader ra) =
    Reader $ \r -&gt; rab r (ra r)

newtype HumanName =
  HumanName String
  deriving (Eq, Show)

newtype DogName =
  DogName String
  deriving (Eq, Show)

newtype Address =
  Address String
  deriving (Eq, Show)

data Person =
  Person {
    humanName :: HumanName
  , dogName :: DogName
  , address :: Address
  } deriving (Eq, Show)

data Dog =
  Dog {
    dogsName :: DogName
  , dogsAddress :: Address
  } deriving (Eq, Show)

getDogR :: Reader Person Dog
getDogR = Reader $ liftA2 Dog dogName address</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_22_7_the_monad_of_functions">22.7 The Monad of functions</h3>
<div class="sect3">
<h4 id="_exercise_7">Exercise</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p>Reader Monad</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE InstanceSigs #-}

newtype Reader r a = Reader { runReader :: r -&gt; a }

instance Functor (Reader r) where
  fmap f (Reader ra) = Reader $ (f . ra)

instance Applicative (Reader r) where
  pure :: a -&gt; Reader r a
  pure a = Reader $ \r -&gt; a

  (&lt;*&gt;) :: Reader r (a -&gt; b)
        -&gt; Reader r a
        -&gt; Reader r b

  (Reader rab) &lt;*&gt; (Reader ra) =
    Reader $ \r -&gt; rab r (ra r)

instance Monad (Reader r) where
  return = pure
  (&gt;&gt;=) :: Reader r a
        -&gt; (a -&gt; Reader r b)
        -&gt; Reader r b
  (Reader ra) &gt;&gt;= aRb =
    Reader $ \r -&gt; runReader (aRb $ ra r) $ r</code></pre>
</div>
</div>
</li>
<li>
<p>Is this right? It compiles and looks similar to Applicative.</p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE InstanceSigs #-}

import Control.Monad (liftM2)

newtype Reader r a = Reader { runReader :: r -&gt; a }

instance Functor (Reader r) where
  fmap f (Reader ra) = Reader $ (f . ra)

instance Applicative (Reader r) where
  pure :: a -&gt; Reader r a
  pure a = Reader $ \r -&gt; a

  (&lt;*&gt;) :: Reader r (a -&gt; b)
        -&gt; Reader r a
        -&gt; Reader r b

  (Reader rab) &lt;*&gt; (Reader ra) =
    Reader $ \r -&gt; rab r (ra r)

instance Monad (Reader r) where
  return = pure
  (&gt;&gt;=) :: Reader r a
        -&gt; (a -&gt; Reader r b)
        -&gt; Reader r b
  (Reader ra) &gt;&gt;= aRb =
    Reader $ \r -&gt; runReader (aRb $ ra r) $ r

newtype HumanName =
  HumanName String
  deriving (Eq, Show)

newtype DogName =
  DogName String
  deriving (Eq, Show)

newtype Address =
  Address String
  deriving (Eq, Show)

data Person =
  Person {
    humanName :: HumanName
  , dogName :: DogName
  , address :: Address
  } deriving (Eq, Show)

data Dog =
  Dog {
    dogsName :: DogName
  , dogsAddress :: Address
  } deriving (Eq, Show)

getDogRM :: Reader Person Dog
getDogRM = Reader $ liftM2 Dog dogName address</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_22_11_chapter_exercises">22.11 Chapter Exercises</h3>
<div class="sect3">
<h4 id="_a_warm_up_stretch">A warm-up stretch</h4>
<div class="paragraph">
<p>ok&#8230;&#8203;..</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Applicative
import Data.Maybe

x = [1, 2, 3]
y = [4, 5, 6]
z = [7, 8, 9]

-- lookup :: Eq a =&gt; a -&gt; [(a, b)] -&gt; Maybe b

-- zip x and y using 3 as the lookup key
xs :: Maybe Integer
xs = lookup 3 $ zip x y

-- zip y and z using 6 as the lookup key
ys :: Maybe Integer
ys = lookup 6 $ zip y z

-- it's also nice to have one that
-- will return Nothing, like this one
-- zip x and y using 4 as the lookup key
zs :: Maybe Integer
zs = lookup 4 $ zip x y

-- now zip x and z using a variable lookup key
z' :: Integer -&gt; Maybe Integer
z' n = lookup n $ zip x z

x1 :: Maybe (Integer, Integer)
x1 = (,) &lt;$&gt; xs &lt;*&gt; ys

x2 :: Maybe (Integer, Integer)
x2 = (,) &lt;$&gt; ys &lt;*&gt; zs

x3 :: Integer -&gt; (Maybe Integer, Maybe Integer)
x3 n = (z' n, z' n)

summed :: Num c =&gt; (c, c) -&gt; c
summed = uncurry (+)

bolt :: Integer -&gt; Bool
-- use &amp;&amp;, &gt;3, &lt;8
bolt = liftA2 (&amp;&amp;) (&gt;3) (&lt;8)

sequA :: Integral a =&gt; a -&gt; [Bool]
sequA m = sequenceA [(&gt;3), (&lt;8), even] m

s' = summed &lt;$&gt; ((,) &lt;$&gt; xs &lt;*&gt; ys)

main :: IO ()
main = do
  print $ sequenceA [Just 3, Just 2, Just 1]
  print $ sequenceA [x, y]
  print $ sequenceA [xs, ys]
  print $ summed &lt;$&gt; ((,) &lt;$&gt; xs &lt;*&gt; ys)
  print $ fmap summed ((,) &lt;$&gt; xs &lt;*&gt; zs)
  print $ bolt 7
  print $ fmap bolt z
  print $ sequenceA [(&gt;3), (&lt;8), even] 7
  print $ foldr (&amp;&amp;) True $ sequA 7
  print $ sequA $ fromMaybe 0 s'
  print $ bolt $ fromMaybe 0 ys
  print $ bolt $ fromMaybe 0 (z' 3)</code></pre>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_rewriting_shawty">Rewriting Shawty</h4>
<div class="paragraph">
<p>use ReaderT, I will come back later</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad (replicateM)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Char8 as BC
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Database.Redis as R
import Network.URI (URI, parseURI)
import qualified System.Random as SR
import Web.Scotty

alphaNum :: String
alphaNum = ['A'..'Z'] ++ ['0'..'9']

randomElement :: String -&gt; IO Char
randomElement xs = do
  let maxIndex :: Int
      maxIndex = length xs - 1
  -- Right of arrow is IO Int, so randomDigit is Int
  randomDigit &lt;- SR.randomRIO (0, maxIndex) :: IO Int
  return (xs !! randomDigit)

shortyGen :: IO String
shortyGen =
  replicateM 7 (randomElement alphaNum)

saveURI :: R.Connection
        -&gt; BC.ByteString
        -&gt; BC.ByteString
        -&gt; IO (Either R.Reply R.Status)
saveURI conn shortURI uri =
  R.runRedis conn $ R.set shortURI uri

getURI  :: R.Connection
        -&gt; BC.ByteString
        -&gt; IO (Either R.Reply (Maybe BC.ByteString))
getURI conn shortURI = R.runRedis conn $ R.get shortURI

linkShorty :: String -&gt; String
linkShorty shorty =
  concat [ "&lt;a href=\""
         , shorty
         , "\"&gt;Copy and paste your short URL&lt;/a&gt;"
         ]

shortyCreated :: Show a =&gt; a -&gt; String -&gt; TL.Text
shortyCreated resp shawty =
  TL.concat [ TL.pack (show resp)
            , " shorty is: ", TL.pack (linkShorty shawty)
            ]

shortyAintUri :: TL.Text -&gt; TL.Text
shortyAintUri uri =
  TL.concat [ uri
            , " wasn't a url, did you forget http://?"
            ]

shortyFound :: TL.Text -&gt; TL.Text
shortyFound tbs =
  TL.concat ["&lt;a href=\"", tbs, "\"&gt;", tbs, "&lt;/a&gt;"]

app :: R.Connection
    -&gt; ScottyM ()
app rConn = do
  get "/" $ do
    uri &lt;- param "uri"
    let parsedUri :: Maybe URI
        parsedUri = parseURI (TL.unpack uri)
    case parsedUri of
      Just _  -&gt; do
        shawty &lt;- liftIO shortyGen
        let shorty = BC.pack shawty
            uri' = encodeUtf8 (TL.toStrict uri)
        resp &lt;- liftIO (saveURI rConn shorty uri')
        html (shortyCreated resp shawty)
      Nothing -&gt; text (shortyAintUri uri)
  get "/:short" $ do
    short &lt;- param "short"
    uri &lt;- liftIO (getURI rConn short)
    case uri of
      Left reply -&gt; text (TL.pack (show reply))
      Right mbBS -&gt; case mbBS of
        Nothing -&gt; text "uri not found"
        Just bs -&gt; html (shortyFound tbs)
          where tbs :: TL.Text
                tbs = TL.fromStrict (decodeUtf8 bs)

main :: IO ()
main = do
  rConn &lt;- R.connect R.defaultConnectInfo
  scotty 3000 (app rConn)</code></pre>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_23_state">23 State</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_23_5_throw_down">23.5 Throw down</h3>
<div class="sect3">
<h4 id="_exercises_3">Exercises</h4>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>rollsToGetN</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import System.Random

rollsToGetN :: Int -&gt; StdGen -&gt; Int
rollsToGetN n g = go 0 0 g
  where go :: Int -&gt; Int -&gt; StdGen -&gt; Int
        go sum count gen
          | sum &gt;= n = count
          | otherwise =
            let (die, nextGen) = randomR (1, 6) gen
            in go (sum + die) (count + 1) nextGen</code></pre>
</div>
</div>
</li>
<li>
<p><code>rollsCountLogged</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import System.Random

data Die =
    DieOne
  | DieTwo
  | DieThree
  | DieFour
  | DieFive
  | DieSix
  deriving (Eq, Show)

intToDie :: Int -&gt; Die
intToDie n =
  case n of
    1 -&gt; DieOne
    2 -&gt; DieTwo
    3 -&gt; DieThree
    4 -&gt; DieFour
    5 -&gt; DieFive
    6 -&gt; DieSix

rollsCountLogged :: Int -&gt; StdGen -&gt; (Int, [Die])
rollsCountLogged n g = go 0 0 [] g
  where go :: Int -&gt; Int -&gt; [Die] -&gt; StdGen -&gt; (Int, [Die])
        go sum count acc gen
          | sum &gt;= n = (count, reverse acc)
          | otherwise =
            let (die, nextGen) = randomR (1, 6) gen
            in go (sum + die) (count + 1) (intToDie die : acc) nextGen</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_23_6_write_state_for_yourself">23.6 Write State for yourself</h3>
<div class="paragraph">
<p>Looks legit and compiles, what can go wrong? :)</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">{-# LANGUAGE InstanceSigs #-}

newtype Moi s a =
  Moi { runMoi :: s -&gt; (a, s) }

instance Functor (Moi s) where
  fmap :: (a -&gt; b) -&gt; Moi s a -&gt; Moi s b
  fmap f (Moi g) = Moi $ \s -&gt; let (a, b) = g s
                               in (f a, b)

--Prelude&gt; runMoi ((+1) &lt;$&gt; (Moi $ \s -&gt; (0, s))) 0
--(1,0)

instance Applicative (Moi s) where
  pure :: a -&gt; Moi s a
  pure a = Moi $ \s -&gt; (a, s)

  (&lt;*&gt;) :: Moi s (a -&gt; b)
        -&gt; Moi s a
        -&gt; Moi s b
  (Moi f) &lt;*&gt; (Moi g) = Moi $ \s -&gt; let fab = fst $ f s
                                        (a, b) = g s
                                    in (fab a, b)

instance Monad (Moi s) where
  return = pure

  (&gt;&gt;=) :: Moi s a
        -&gt; (a -&gt; Moi s b)
        -&gt; Moi s b
  (Moi f) &gt;&gt;= g = Moi $ \s -&gt; let a = fst $ f s
                                  ms = runMoi $ g a
                              in ms s</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_23_7_get_a_coding_job_with_one_weird_trick">23.7 Get a coding job with one weird trick</h3>
<div class="paragraph">
<p>More of a list thing than state&#8230;&#8203;.</p>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad
import Control.Monad.Trans.State

fizzBuzz :: Integer -&gt; String
fizzBuzz n | n `mod` 15 == 0 = "FizzBuzz"
           | n `mod` 5 == 0 = "Fizz"
           | n `mod` 3 == 0 = "Buzz"
           | otherwise = show n

fizzbuzzList :: [Integer] -&gt; [String]
fizzbuzzList list =
  execState (mapM_ addResult list) []

addResult :: Integer -&gt; State [String] ()
addResult n = do
  xs &lt;- get
  let result = fizzBuzz n
  put (result : xs)

fizzbuzzFromTo :: Integer -&gt; Integer -&gt; [String]
fizzbuzzFromTo start end = fizzbuzzList $ enumFromThenTo end (end - 1) start

main :: IO ()
main =
  mapM_ putStrLn $ fizzbuzzFromTo 1 100</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_23_8_chapter_exercises">23.8 Chapter exercises</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>get</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad.Trans.State hiding (get)

get :: State s s
get = state $ \s -&gt; (s, s)

--Prelude&gt; runState get "curryIsAmaze"
--("curryIsAmaze","curryIsAmaze")</code></pre>
</div>
</div>
</li>
<li>
<p><code>put</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad.Trans.State hiding (put)

put :: s -&gt; State s ()
put = \s -&gt; state $ \x -&gt; ((), s)

--Prelude&gt; runState (put "blah") "woot"
--((),"blah")</code></pre>
</div>
</div>
</li>
<li>
<p><code>exec</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
There is no data constructor <code>State</code> to pattern match on. Bug in the book?
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad
import Control.Monad.Trans.State

exec :: State s a -&gt; s -&gt; s
exec (State sa) s = snd $ sa s

--Prelude&gt; exec (put "wilma") "daphne"
--"wilma"
--Prelude&gt; exec get "scooby papu"
--"scooby papu"</code></pre>
</div>
</div>
</li>
<li>
<p><code>eval</code></p>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
same as with <code>exec</code>
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">eval :: State s a -&gt; s -&gt; a
eval (State sa) = ???

--Prelude&gt; eval get "bunnicula"
--"bunnicula"
--Prelude&gt; eval get "stake a bunny"
--"stake a bunny"</code></pre>
</div>
</div>
</li>
<li>
<p><code>modify</code></p>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">import Control.Monad.Trans.State hiding (modify)

modify :: (s -&gt; s) -&gt; State s ()
modify f = state $ \s -&gt; ((), f s)

--Prelude&gt; runState (modify (+1)) 0
--((),1)
--Prelude&gt; runState (modify (+1) &gt;&gt; modify (+1)) 0
--((),2)</code></pre>
</div>
</div>
</li>
</ol>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_24_parser_combinators">24 Parser combinators</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_24_3_understanding_the_parsing_process">24.3 Understanding the parsing process</h3>
<div class="admonitionblock warning">
<table>
<tr>
<td class="icon">
<i class="fa icon-warning" title="Warning"></i>
</td>
<td class="content">
Well, somehow glued code. This works in GHCI but does not compile: <code>testParse'' oneStr</code>. Complains about <code>No instance for (Show a0) arising from a use of testParse''</code>
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre class="prettyprint highlight"><code class="language-haskell" data-lang="haskell">module LearnParsers where

import Text.Trifecta

stop :: Parser a
stop = unexpected "stop"

one = char '1' &gt;&gt; eof &gt;&gt; stop

one' = one &gt;&gt; stop

oneTwo = char '1' &gt;&gt; char '2' &gt;&gt; eof &gt;&gt; stop

oneTwo' = oneTwo &gt;&gt; stop

oneStr = string "1"  &gt;&gt; stop

oneTwoStr = string "12"

oneTwoThreeStr = string "123"

oneTwoThreeChar = char '1' &gt;&gt; char '2' &gt;&gt; char '3'

stringChar (x:xs) = char x &gt;&gt; stringChar xs
stringChar [] = stop

oneTwoThreeChar' = stringChar "123"

testParse :: Parser Char -&gt; IO ()
testParse p =
  print $ parseString p mempty "123"

testParse' :: Parser String -&gt; IO ()
testParse' p =
  print $ parseString p mempty "123"

testParse'' :: Show a =&gt; Parser a -&gt; IO ()
testParse'' p =
  print $ parseString p mempty "123"

pNL s =
  putStrLn ('\n' : s)

main = do
  pNL "stop:"
  testParse stop
  pNL "one:"
  testParse one
  pNL "one':"
  testParse one'
  pNL "oneTwo:"
  testParse oneTwo
  pNL "oneTwo':"
  testParse oneTwo'
  pNL "oneStr':"
  testParse' oneStr
  pNL "oneTwoStr':"
  testParse' oneTwoStr
  pNL "oneTwoThreeStr':"
  testParse'' oneTwoThreeStr
  pNL "oneTwoThreeChar:"
  testParse oneTwoThreeChar
  pNL "oneTwoThreeChar':"
  testParse oneTwoThreeChar'</code></pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_24_4_parsing_fractions">24.4 Parsing fractions</h3>
<div class="listingblock">
<div class="content">
<pre>{-# LANGUAGE OverloadedStrings #-}

module Text.Fractions where
import Control.Applicative
import Data.Ratio ((%))
import Text.Trifecta

badFraction = "1/0"
alsoBad = "10"
shouldWork = "1/2"
shouldAlsoWork = "2/1"

parseFraction :: Parser Rational
parseFraction = do
  numerator &lt;- decimal
  char '/'
  denominator &lt;- decimal
  return (numerator % denominator)

virtuousFraction :: Parser Rational
virtuousFraction = do
  numerator &lt;- decimal
  char '/'
  denominator &lt;- decimal
  case denominator of
    0 -&gt; fail "Denominator cannot be zero"
    _ -&gt; return (numerator % denominator)

testVirtuous :: IO ()
testVirtuous = do
  print $ parseString virtuousFraction mempty badFraction
  print $ parseString virtuousFraction mempty alsoBad
  print $ parseString virtuousFraction mempty shouldWork
  print $ parseString virtuousFraction mempty shouldAlsoWork

main :: IO ()
main = do
  print $ parseString parseFraction mempty shouldWork
  print $ parseString parseFraction mempty shouldAlsoWork
  print $ parseString parseFraction mempty alsoBad
  print $ parseString parseFraction mempty badFraction</pre>
</div>
</div>
<div class="sect3">
<h4 id="_exercise_unit_of_success">Exercise: Unit of Success</h4>
<div class="paragraph">
<p>Using <code>do</code> block helps. Somehow I wanted to use some cool fancy operator instead, but not sure is exists.</p>
</div>
<div class="listingblock">
<div class="content">
<pre>import Text.Trifecta

parseReturnNumber :: Parser Integer
parseReturnNumber = do
  number &lt;- decimal
  eof
  return number

main :: IO ()
main = do
  print $ parseString parseReturnNumber mempty "123"
  print $ parseString parseReturnNumber mempty "123abc"</pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_24_6_alternative">24.6 Alternative</h3>
<div class="sect3">
<h4 id="_exercise_try_try">Exercise: Try Try</h4>
<div class="admonitionblock caution">
<table>
<tr>
<td class="icon">
<i class="fa icon-caution" title="Caution"></i>
</td>
<td class="content">
The <code>badFraction</code> result is interesting. Not sure if it should be bad fraction or good decimal. The code as written righfuly so return decimal. Also I needed to use the fraction parser first, otherwise it would just return decimal.
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre>{-# LANGUAGE OverloadedStrings #-}

module Text.Fractions where
import Control.Applicative
import Data.Ratio ((%), Ratio(..))
import Text.Trifecta

badFraction = "1/0"
alsoBad = "10"
shouldWork = "1/2"
shouldAlsoWork = "2/1"

virtuousFraction :: Parser Rational
virtuousFraction = do
  numerator &lt;- decimal
  char '/'
  denominator &lt;- decimal
  case denominator of
    0 -&gt; fail "Denominator cannot be zero"
    _ -&gt; return (numerator % denominator)

type NumberOrFraction =
  Either Integer (Ratio Integer)

parseNR :: Parser NumberOrFraction
parseNR =
      (Right &lt;$&gt; try virtuousFraction)
  &lt;|&gt; (Left &lt;$&gt; try integer)

main :: IO ()
main = do
  print $ parseString parseNR mempty badFraction
  print $ parseString parseNR mempty alsoBad
  print $ parseString parseNR mempty shouldWork
  print $ parseString parseNR mempty shouldAlsoWork</pre>
</div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_24_7_parsing_configuration_files">24.7 Parsing configuration files</h3>
<div class="listingblock">
<div class="content">
<pre>stack install trifecta
stack install hspec
stack install raw-strings-qq</pre>
</div>
</div>
<div class="listingblock">
<div class="content">
<pre>{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Data.Ini where
import Control.Applicative
import Data.ByteString (ByteString)
import Data.Char (isAlpha)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text.IO as TIO
import Test.Hspec
import Text.RawString.QQ
-- parsers 0.12.3, trifecta 1.5.2
import Text.Trifecta

headerEx :: ByteString
headerEx = "[blah]"

-- "[blah]" -&gt; Section "blah"
newtype Header =
  Header String
  deriving (Eq, Ord, Show)

parseBracketPair :: Parser a -&gt; Parser a
parseBracketPair p = char '[' *&gt; p &lt;* char ']'
-- these operators mean the brackets will be
-- parsed and then discarded
-- but the p will remain as our result

parseHeader :: Parser Header
parseHeader =
  parseBracketPair (Header &lt;$&gt; some letter)

assignmentEx :: ByteString
assignmentEx = "woot=1"

type Name = String
type Value = String
type Assignments = Map Name Value

parseAssignment :: Parser (Name, Value)
parseAssignment = do
  name &lt;- some letter
  _ &lt;- char '='
  val &lt;- some (noneOf "\n")
  skipEOL -- important!
  return (name, val)

-- | Skip end of line and whitespace beyond.
skipEOL :: Parser ()
skipEOL = skipMany (oneOf "\n")

commentEx :: ByteString
commentEx = "; last modified 1 April 2001 by John Doe"

commentEx' :: ByteString
commentEx' = "; blah\n; woot\n \n;hah"

-- | Skip comments starting at the beginning of the line.
skipComments :: Parser ()
skipComments =
  skipMany (do _ &lt;- char ';' &lt;|&gt; char '#'
               skipMany (noneOf "\n")
               skipEOL)

sectionEx :: ByteString
sectionEx =
  "; ignore me\n[states]\nChris=Texas"

sectionEx' :: ByteString
sectionEx' = [r|
; ignore me
[states]
Chris=Texas
|]

sectionEx'' :: ByteString
sectionEx'' = [r|
; comment
[section]
host=wikipedia.org
alias=claw
[whatisit]
red=intoothandclaw
|]

data Section =
  Section Header Assignments
  deriving (Eq, Show)

newtype Config =
  Config (Map Header Assignments)
  deriving (Eq, Show)

skipWhitespace :: Parser ()
skipWhitespace =
  skipMany (char ' ' &lt;|&gt; char '\n')

parseSection :: Parser Section
parseSection = do
  skipWhitespace
  skipComments
  h &lt;- parseHeader
  skipEOL
  assignments &lt;- some parseAssignment
  return $ Section h (M.fromList assignments)

rollup :: Section
  -&gt; Map Header Assignments
  -&gt; Map Header Assignments

rollup (Section h a) m =
  M.insert h a m

parseIni :: Parser Config
parseIni = do
  sections &lt;- some parseSection
  let mapOfSections =
        foldr rollup M.empty sections
  return (Config mapOfSections)

maybeSuccess :: Result a -&gt; Maybe a
maybeSuccess (Success a) = Just a
maybeSuccess _ = Nothing

main :: IO ()
main = hspec $ do
  describe "Assignment Parsing" $
    it "can parse a simple assignment" $ do
      let m = parseByteString parseAssignment
              mempty assignmentEx
          r' = maybeSuccess m
      print m
      r' `shouldBe` Just ("woot", "1")
  describe "Header Parsing" $
    it "can parse a simple header" $ do
      let m = parseByteString parseHeader mempty headerEx
          r' = maybeSuccess m
      print m
      r' `shouldBe` Just (Header "blah")
  describe "Comment parsing" $
    it "Can skip a comment before a header" $ do
      let p = skipComments &gt;&gt; parseHeader
          i = "; woot\n[blah]"
          m = parseByteString p mempty i
          r' = maybeSuccess m
      print m
      r' `shouldBe` Just (Header "blah")
  describe "Section parsing" $
    it "Can parse a simple section" $ do
      let m = parseByteString parseSection
              mempty sectionEx
          r' = maybeSuccess m
          states = M.fromList [("Chris", "Texas")]
          expected' = Just (Section
                            (Header "states")
                            states)
      print m
      r' `shouldBe` expected'
  describe "INI parsing" $
    it "Can parse multiple sections" $ do
      let m = parseByteString parseIni mempty sectionEx''
          r' = maybeSuccess m
          sectionValues = M.fromList
                          [ ("alias", "claw")
                          , ("host", "wikipedia.org")]
          whatisitValues = M.fromList
                            [("red", "intoothandclaw")]
          expected' = Just (Config
                            (M.fromList
                              [ (Header "section"
                                , sectionValues)
                              , (Header "whatisit"
                                , whatisitValues)]))
      print m
      r' `shouldBe` expected'</pre>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_24_11_chapter_exercises">24.11 Chapter Exercises</h3>
<div class="olist arabic">
<ol class="arabic">
<li>
<p><code>SemVer</code> will try to make it nicer. Monoids are cool.</p>
<div class="listingblock">
<div class="content">
<pre>import Control.Applicative ((&lt;|&gt;))
import Data.Monoid ((&lt;&gt;))
import Text.Trifecta


-- Relevant to precedence/ordering,
-- cannot sort numbers like strings.
data NumberOrString =
    NOSS String
  | NOSI Integer
  deriving Show

instance Eq NumberOrString where
  (==) (NOSI i) (NOSI i') = i == i'
  (==) (NOSS s) (NOSS s') = s == s'
  (==) _ _ = False

instance Ord NumberOrString where
  compare (NOSI i) (NOSI i') = compare i i'
  compare (NOSS s) (NOSS s') = compare s s'
  compare (NOSI _) _         = LT
  compare _        (NOSI _)  = GT

type Major = Integer
type Minor = Integer
type Patch = Integer
type Release = [NumberOrString]
type Metadata = [NumberOrString]

data SemVer =
  SemVer Major Minor Patch Release Metadata deriving Show

instance Eq SemVer where
  (==) (SemVer ma mi pa re me) (SemVer ma' mi' pa' re' me') =
    ma == ma' &amp;&amp; mi == mi' &amp;&amp; pa == pa' &amp;&amp; re == re' &amp;&amp; me == me'

instance Ord SemVer where
  compare (SemVer ma mi pa re _) (SemVer ma' mi' pa' re' _) =
    let c = (compare ma ma') &lt;&gt; (compare mi mi') &lt;&gt; (compare pa pa')
    in case c of
        EQ -&gt; compare re re'
        _  -&gt; c

nos :: Parser NumberOrString
nos = do
  (NOSI &lt;$&gt; decimal) &lt;|&gt; (NOSS &lt;$&gt; some letter)

nosDot :: Parser NumberOrString
nosDot = do
  ns &lt;- nos
  skipMany (oneOf ".")
  return ns

relP :: Parser [NumberOrString]
relP = do
  (char '-' &gt;&gt; many nosDot) &lt;|&gt; (return [])

metP :: Parser [NumberOrString]
metP = do
  (char '+' &gt;&gt; many nosDot) &lt;|&gt; (return [])

parseSemVer :: Parser SemVer
parseSemVer = do
  ma &lt;- decimal
  char '.'
  mi &lt;- decimal
  char '.'
  pa &lt;- decimal
  rel &lt;- try relP
  met &lt;- try metP
  return $ SemVer ma mi pa rel met</pre>
</div>
</div>
</li>
<li>
<p>parser for positive integer values</p>
<div class="listingblock">
<div class="content">
<pre>import Text.Trifecta
import Data.Char (digitToInt)

parseDigit :: Parser Char
parseDigit = oneOf "0123456789"

joinNumber :: [Char] -&gt; Integer
joinNumber = toInteger . foldl addThem 0
  where addThem acc d = acc * 10 + digitToInt d

base10Integer :: Parser Integer
base10Integer = do
  digits &lt;- some parseDigit
  return (joinNumber digits)

main = do
  print $ parseString parseDigit mempty "123"
  print $ parseString parseDigit mempty "abc"
  print $ parseString base10Integer mempty "123abc"
  print $ parseString base10Integer mempty "abc"</pre>
</div>
</div>
</li>
<li>
<p>parser for positive and negative integer values</p>
<div class="admonitionblock caution">
<table>
<tr>
<td class="icon">
<i class="fa icon-caution" title="Caution"></i>
</td>
<td class="content">
clunky
</td>
</tr>
</table>
</div>
<div class="listingblock">
<div class="content">
<pre>import Text.Trifecta
import Data.Char (digitToInt)
import Control.Applicative ((&lt;|&gt;))

parseDigit :: Parser Char
parseDigit = oneOf "0123456789"

joinNumber :: [Char] -&gt; Integer
joinNumber = toInteger . foldl addThem 0
  where addThem acc d = acc * 10 + digitToInt d

parseSign :: Parser Bool
parseSign = try (char '-' &gt;&gt; return True) &lt;|&gt; return False

base10Integer :: Parser Integer
base10Integer = do
  isNegative &lt;- parseSign
  digits &lt;- some parseDigit
  let n = joinNumber digits
  return (if isNegative then (- n) else n)

main = do
  print $ parseString parseDigit mempty "123"
  print $ parseString parseDigit mempty "abc"
  print $ parseString base10Integer mempty "123abc"
  print $ parseString base10Integer mempty "abc"
  print $ parseString base10Integer mempty "-123abc"</pre>
</div>
</div>
</li>
</ol>
</div>
<div class="paragraph">
<p>rest of the chapter not finished yet</p>
</div>
</div>
</div>
</div>
</div>
<div id="footer">
<div id="footer-text">
Last updated 2017-03-17 21:02:25 CET
</div>
</div>
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/prettify/r298/prettify.min.css">
<script src="https://cdnjs.cloudflare.com/ajax/libs/prettify/r298/prettify.min.js"></script>
<script>prettyPrint()</script>
</body>
</html>