mon@razerRamon:~/tmp/haskell/granulate-effects$ ll
total 12K
-rwxr-xr-x 1 mon mon 3.2K Nov 24 20:57 GranulateEffects.hs*
mon@razerRamon:~/tmp/haskell/granulate-effects$

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
#!/usr/bin/env stack
{- stack
   --resolver lts-8.21
   --install-ghc
   runghc
   --package http-client
   --package http-client-tls
   --
   -Wall -Werror
-}

module GranulateEffects (main) where

import qualified Data.ByteString.Lazy.Char8 as L8

{- https://haskell-lang.org/library/http-client -}
import Network.HTTP.Client
{- https://hackage.haskell.org/package/http-client-tls -}
import Network.HTTP.Client.TLS (tlsManagerSettings)

{- As Kris Jenkins (@krisajenkins) says: "IO is the SUDO of side-effects" -}
getHtml :: String -> IO String
getHtml url = do
  {- To get secure HTML we will need: TLS manager, request and response -}
  manager  <- newManager   tlsManagerSettings
  request  <- parseRequest url
  response <- httpLbs request manager
  let html =  L8.unpack $ responseBody response

  {- Because we aren't limiting effects, we can also log to a file -}
  writeFile "./logging.txt" html
  
  return html

{- Lets granulate our effects to what we really want -}
class Monad m => 
  MmanagerTLS m where
  newManager' :: ManagerSettings -> m Manager

instance MmanagerTLS IO where
  newManager' = newManager

class Monad m => 
  Mrequest m where
  parseRequest' :: String -> m Request

instance Mrequest IO where
  parseRequest' = parseRequest

class Monad m => 
  Mresponse m where
  httpLbs' :: Request -> Manager -> m (Response L8.ByteString)

instance Mresponse IO where
  httpLbs' = httpLbs

{- We update the signature and add our granulated prime functions -}
getHtml' :: (MmanagerTLS m, Mrequest m, Mresponse m) => String -> m String
getHtml' url = do
  {- To get secure HTML we will need: TLS manager, request and response -}
  manager  <- newManager'   tlsManagerSettings
  request  <- parseRequest' url
  response <- httpLbs' request manager
  let html =  L8.unpack $ responseBody response

  {- And we are no longer allowed to log to a file, only retrieve HTML -}
  -- writeFile "./logging.txt" html
  {- error:
    • Couldn't match type ‘m’ with ‘IO’
      ‘m’ is a rigid type variable bound by
        the type signature for:
          getHtml' :: forall (m :: * -> *).
                      (MmanagerTLS m, Mrequest m, Mresponse m) =>
                      String -> m String
        at GranulateEffects.hs:70:13
      Expected type: m ()
        Actual type: IO ()
    • In a stmt of a 'do' block: writeFile "./logging.txt" html
      In the expression:
        do { manager <- newManager' tlsManagerSettings;
             request <- parseRequest' url;
             response <- httpLbs' request manager;
             let html = L8.unpack $ responseBody response;
             .... }
      In an equation for ‘getHtml'’:
          getHtml' url
            = do { manager <- newManager' tlsManagerSettings;
                   request <- parseRequest' url;
                   response <- httpLbs' request manager;
                   .... }
    • Relevant bindings include
        getHtml' :: String -> m String (bound at GranulateEffects.hs:71:1)
  -}
  
  return html
  
{- And ofc it's easier to just put everything inside the same monad -}
class Monad m =>
  HtmlHttpsM m where
  newManager''   :: ManagerSettings -> m Manager
  parseRequest'' :: String -> m Request
  httpLbs''      :: Request -> Manager -> m (Response L8.ByteString)

instance HtmlHttpsM IO where
  newManager''   = newManager
  parseRequest'' = parseRequest
  httpLbs''      = httpLbs

{- We update the signature and add our granulated prime prime functions -}
getHtml'' :: (HtmlHttpsM m) => String -> m String
getHtml'' url = do
  {- To get secure HTML we will need: TLS manager, request and response -}
  manager  <- newManager''   tlsManagerSettings
  request  <- parseRequest'' url
  response <- httpLbs'' request manager
  let html =  L8.unpack $ responseBody response

  {- And we are still not allowed to log to a file, only retrieve HTML -}
  -- writeFile "./logging.txt" html
  {- error:
    • Couldn't match type ‘m’ with ‘IO’
      ‘m’ is a rigid type variable bound by
        the type signature for:
          getHtml'' :: forall (m :: * -> *).
                       HtmlHttpsM m =>
                       String -> m String
        at GranulateEffects.hs:111:14
      Expected type: m ()
        Actual type: IO ()
    • In a stmt of a 'do' block: writeFile "./logging.txt" html
      In the expression:
        do { manager <- newManager'' tlsManagerSettings;
             request <- parseRequest'' url;
             response <- httpLbs'' request manager;
             let html = L8.unpack $ responseBody response;
             .... }
      In an equation for ‘getHtml''’:
          getHtml'' url
            = do { manager <- newManager'' tlsManagerSettings;
                   request <- parseRequest'' url;
                   response <- httpLbs'' request manager;
                   .... }
    • Relevant bindings include
        getHtml'' :: String -> m String
          (bound at GranulateEffects.hs:112:1)
  -}
  
  return html

main :: IO ()
main = do
  html0 <- getHtml   "https://www.google.dk/"
  html1 <- getHtml'  "https://www.google.dk/"
  html2 <- getHtml'' "https://www.google.dk/"
  print $ html0
  print $ html1
  print $ html2

mon@razerRamon:~/tmp/haskell/granulate-effects$ ./GranulateEffects.hs
<!doctype html> ... </script></div></body></html>
<!doctype html> ... </script></div></body></html>
<!doctype html> ... </script></div></body></html>
mon@razerRamon:~/tmp/haskell/granulate-effects$

mon@razerRamon:~/tmp/haskell/granulate-effects$ ll
total 68K
-rwxr-xr-x 1 mon mon 3.2K Nov 24 20:57 GranulateEffects.hs*
-rw-r--r-- 1 mon mon  46K Nov 24 21:29 logging.txt
mon@razerRamon:~/tmp/haskell/granulate-effects$