QualifiedDo @ RFP 2020-06-25

README.md

Þarf nýjasta committið af qualified-do branchinhu hjá tweag, https://gitlab.haskell.com/tweag/ghc/

M.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module M where

import GHC.TypeLits

data Merki = Leyndarmál | Opinbert

newtype LIO (l :: Merki) a = LIO {unLIO :: IO a}

runLIO :: LIO Opinbert a -> IO a
runLIO = unLIO

merkja :: a -> LIO m a
merkja = LIO . return

type family Hámark (a :: Merki) (b :: Merki) :: Merki where
  Hámark Leyndarmál Opinbert = Leyndarmál
  Hámark Opinbert Leyndarmál = Leyndarmál
  Hámark m m = m

prenta :: Show a => a -> LIO Opinbert ()
prenta = LIO . print

dulrita :: String -> LIO Leyndarmál ()
dulrita = LIO . putStrLn . flip replicate '*' . length

takaVið :: LIO Leyndarmál String
takaVið = LIO (putStr "Lykilorð: " Prelude.>>= getLine)

(>>) :: LIO m1 a -> LIO m2 b -> LIO (Hámark m1 m2) b
a >> b = LIO (unLIO a Prelude.>> (unLIO b))

(>>=) :: LIO m1 a -> (a -> LIO m2 b) -> LIO (Hámark m1 m2) b
a >>= b = LIO (unLIO a Prelude.>>= (unLIO . b))

Test.hs

{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Main where

import qualified M as M
import M

main :: Prelude.IO ()
main = M.runLIO $ M.do lykilorð <- takaVið
                       dulrita lykilorð
                       prenta lykilorð