diff options
Diffstat (limited to 'Haskell-book/26')
31 files changed, 933 insertions, 0 deletions
diff --git a/Haskell-book/26/Embedded/Embedded.cabal b/Haskell-book/26/Embedded/Embedded.cabal new file mode 100644 index 0000000..d0898f4 --- /dev/null +++ b/Haskell-book/26/Embedded/Embedded.cabal @@ -0,0 +1,40 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 4aaf9c578000b87231817edc542c283c58e2e1562cc290df37e9e8a9628885b0 + +name: Embedded +version: 0.1.0.0 +author: Eugen Wissner +maintainer: belka@caraus.de +copyright: 2018 Eugen Wissner +license: BSD3 +build-type: Simple +cabal-version: >= 1.10 + +library + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , transformers + exposed-modules: + OuterInner + other-modules: + Paths_Embedded + default-language: Haskell2010 + +test-suite Embedded-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Embedded + , base >=4.7 && <5 + , transformers + other-modules: + Paths_Embedded + default-language: Haskell2010 diff --git a/Haskell-book/26/Embedded/Setup.hs b/Haskell-book/26/Embedded/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/26/Embedded/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/26/Embedded/package.yaml b/Haskell-book/26/Embedded/package.yaml new file mode 100644 index 0000000..59f144a --- /dev/null +++ b/Haskell-book/26/Embedded/package.yaml @@ -0,0 +1,24 @@ +name: Embedded +version: 0.1.0.0 +license: BSD3 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 +- transformers + +library: + source-dirs: src + +tests: + Embedded-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - Embedded diff --git a/Haskell-book/26/Embedded/src/OuterInner.hs b/Haskell-book/26/Embedded/src/OuterInner.hs new file mode 100644 index 0000000..edc31c1 --- /dev/null +++ b/Haskell-book/26/Embedded/src/OuterInner.hs @@ -0,0 +1,30 @@ +module OuterInner where + +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Control.Monad.Trans.Reader + +-- We only need to use return once +-- because it's one big Monad +embedded :: MaybeT + (ExceptT String + (ReaderT () IO)) + Int +--embedded = return 1 +embedded = MaybeT . ExceptT . ReaderT $ return . (const (Right (Just 1))) + +-- We can sort of peel away the layers one by one: +maybeUnwrap :: ExceptT String + (ReaderT () IO) (Maybe Int) +maybeUnwrap = runMaybeT embedded + +-- Next +eitherUnwrap :: ReaderT () IO + (Either String (Maybe Int)) +eitherUnwrap = runExceptT maybeUnwrap + +-- Lastly +readerUnwrap :: () + -> IO (Either String + (Maybe Int)) +readerUnwrap = runReaderT eitherUnwrap
\ No newline at end of file diff --git a/Haskell-book/26/Embedded/stack.yaml b/Haskell-book/26/Embedded/stack.yaml new file mode 100644 index 0000000..eb506f9 --- /dev/null +++ b/Haskell-book/26/Embedded/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-11.7 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.6" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file diff --git a/Haskell-book/26/Embedded/test/Spec.hs b/Haskell-book/26/Embedded/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/Haskell-book/26/Embedded/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/Haskell-book/26/Exercises/.gitignore b/Haskell-book/26/Exercises/.gitignore new file mode 100644 index 0000000..3834f98 --- /dev/null +++ b/Haskell-book/26/Exercises/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +Exercises.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/26/Exercises/Setup.hs b/Haskell-book/26/Exercises/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/26/Exercises/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/26/Exercises/app/Main.hs b/Haskell-book/26/Exercises/app/Main.hs new file mode 100644 index 0000000..6bfe6bb --- /dev/null +++ b/Haskell-book/26/Exercises/app/Main.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader +import Data.IORef +import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy as TL +import System.Environment (getArgs) +import Web.Scotty.Trans ( ScottyT(..) + , ActionT(..) + , scottyT + , get + , html + , param ) + +data Config = + Config { + -- that's one, one click! + -- two...two clicks! + -- Three BEAUTIFUL clicks! ah ah ahhhh + counts :: IORef (M.Map Text Integer) + , prefix :: Text + } + +type Scotty = ScottyT Text (ReaderT Config IO) + +bumpBoomp :: Text + -> M.Map Text Integer + -> (M.Map Text Integer, Integer) +bumpBoomp k m = + let (maybeCount, newMap) = M.insertLookupWithKey (\_ _ oldCount -> oldCount + 1) k 1 m + in case maybeCount of + Nothing -> (newMap, 1) + Just oldCount -> (newMap, oldCount + 1) + +app :: Scotty () +app = + get "/:key" $ do + unprefixed <- param "key" + prefix <- lift $ asks prefix + let key' = mappend prefix unprefixed + counts <- lift $ asks counts + (newMap, newInteger) <- liftIO $ bumpBoomp key' <$> readIORef counts + liftIO $ writeIORef counts newMap + html $ mconcat [ "<h1>Success! Count was: " + , TL.pack $ show (newInteger :: Integer) + , "</h1>" + ] + +main :: IO () +main = do + [prefixArg] <- getArgs + counter <- newIORef M.empty + let config = Config {counts = counter, prefix = TL.pack prefixArg} + runR = flip runReaderT config + scottyT 3000 runR app diff --git a/Haskell-book/26/Exercises/package.yaml b/Haskell-book/26/Exercises/package.yaml new file mode 100644 index 0000000..a757233 --- /dev/null +++ b/Haskell-book/26/Exercises/package.yaml @@ -0,0 +1,37 @@ +name: Exercises +version: 0.1.0.0 +license: BSD3 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 +- containers +- scotty +- transformers +- text + +library: + source-dirs: src + +executables: + HitCounter: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + +tests: + Exercises-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - Exercises + - hspec diff --git a/Haskell-book/26/Exercises/src/Exercises.hs b/Haskell-book/26/Exercises/src/Exercises.hs new file mode 100644 index 0000000..d3a8370 --- /dev/null +++ b/Haskell-book/26/Exercises/src/Exercises.hs @@ -0,0 +1,75 @@ +module Exercises where + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Reader (Reader(..), ReaderT(..), runReader, runReaderT) +import Control.Monad.Trans.State (StateT(..)) +import Data.Functor.Identity (Identity(..)) + +-- 1. rDec is a function that should get its argument in the context of +-- Reader and return a value decremented by one. +-- +-- Note that “Reader” from transformers is ReaderT of Identity and +-- that runReader is a convenience function throwing away the +-- meaningless structure for you. Play with runReaderT if you like. +rDec :: Num a => Reader a a +rDec = ReaderT $ dec + where dec :: Num a => a -> Identity a + dec = return . (flip (-) 1) + +-- 2. Once you have an rDec that works, make it and any inner lamb- +-- das pointfree if that’s not already the case. + + +-- 3. rShow is show, but in Reader. +rShow :: Show a => Reader a String +rShow = ReaderT $ toString + where toString = return . show + +-- 4. Once you have an rShow that works, make it pointfree. + + +-- 5. rPrintAndInc will first print the input with a greeting, then return +-- the input incremented by one. +rPrintAndInc :: (Num a, Show a) => ReaderT a IO a +rPrintAndInc = ReaderT print + where print x = do + liftIO $ putStrLn $ "Hi: " ++ show x + return $ x + 1 + +-- Prelude> runReaderT rPrintAndInc 1 +-- Hi: 1 +-- 2 +-- Prelude> traverse (runReaderT rPrintAndInc) [1..10] +-- Hi: 1 +-- Hi: 2 +-- Hi: 3 +-- Hi: 4 +-- Hi: 5 +-- Hi: 6 +-- Hi: 7 +-- Hi: 8 +-- Hi: 9 +-- Hi: 10 +-- [2,3,4,5,6,7,8,9,10,11] + + +-- 6. sPrintIncAccum first prints the input with a greeting, then puts +-- the incremented input as the new state, and returns the original +-- input as a String. +sPrintIncAccum :: (Num a, Show a) => StateT a IO String +sPrintIncAccum = StateT print + where print x = do + liftIO $ putStrLn $ "Hi: " ++ show x + return $ (show x, x + 1) + +-- Prelude> runStateT sPrintIncAccum 10 +-- Hi: 10 +-- ("10",11) +-- Prelude> mapM (runStateT sPrintIncAccum) [1..5] +-- Hi: 1 +-- Hi: 2 +-- Hi: 3 +-- Hi: 4 +-- Hi: 5 +-- [("1",2),("2",3),("3",4),("4",5),("5",6)] diff --git a/Haskell-book/26/Exercises/src/Fix.hs b/Haskell-book/26/Exercises/src/Fix.hs new file mode 100644 index 0000000..bd43f7f --- /dev/null +++ b/Haskell-book/26/Exercises/src/Fix.hs @@ -0,0 +1,24 @@ +module Fix where + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Maybe +import Control.Monad + +isValid :: String -> Bool +isValid v = '!' `elem` v + +maybeExcite :: MaybeT IO String +maybeExcite = do + v <- liftIO getLine + guard $ isValid v + return v + +doExcite :: IO () +doExcite = do + putStrLn "say something excite!" + excite <- runMaybeT maybeExcite + case excite of + Nothing -> putStrLn "MOAR EXCITE" + Just e -> + putStrLn + ("Good, was very excite: " ++ e) diff --git a/Haskell-book/26/Exercises/stack.yaml b/Haskell-book/26/Exercises/stack.yaml new file mode 100644 index 0000000..1962baa --- /dev/null +++ b/Haskell-book/26/Exercises/stack.yaml @@ -0,0 +1,65 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-11.8 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file diff --git a/Haskell-book/26/Exercises/test/Spec.hs b/Haskell-book/26/Exercises/test/Spec.hs new file mode 100644 index 0000000..92db8e6 --- /dev/null +++ b/Haskell-book/26/Exercises/test/Spec.hs @@ -0,0 +1,19 @@ +import Control.Monad.Trans.Reader +import Exercises +import Test.Hspec + +main :: IO () +main = hspec $ do + describe "rDec" $ do + it "returns a value decremented by one" $ do + runReader rDec 1 `shouldBe` 0 + + it "decrements all elements of a list" $ do + (fmap (runReader rDec) [1..10]) `shouldBe` [0,1,2,3,4,5,6,7,8,9] + + describe "rShow" $ do + it "shows a number" $ do + runReader rShow 1 `shouldBe` "1" + + it "shows a list" $ do + (fmap (runReader rShow) [1..10]) `shouldBe` ["1","2","3","4","5","6","7","8","9","10"] diff --git a/Haskell-book/26/MaybeT/.gitignore b/Haskell-book/26/MaybeT/.gitignore new file mode 100644 index 0000000..ae82431 --- /dev/null +++ b/Haskell-book/26/MaybeT/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +MaybeT.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/26/MaybeT/Setup.hs b/Haskell-book/26/MaybeT/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/26/MaybeT/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/26/MaybeT/package.yaml b/Haskell-book/26/MaybeT/package.yaml new file mode 100644 index 0000000..dfa5dac --- /dev/null +++ b/Haskell-book/26/MaybeT/package.yaml @@ -0,0 +1,23 @@ +name: MaybeT +version: 0.1.0.0 +license: BSD3 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 + +library: + source-dirs: src + +tests: + MaybeT-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - MaybeT diff --git a/Haskell-book/26/MaybeT/src/Either.hs b/Haskell-book/26/MaybeT/src/Either.hs new file mode 100644 index 0000000..e09bfe6 --- /dev/null +++ b/Haskell-book/26/MaybeT/src/Either.hs @@ -0,0 +1,56 @@ +module Either where + +import Control.Monad (liftM) +import MonadTrans +import MonadIO + +newtype EitherT e m a = + EitherT { runEitherT :: m (Either e a) } + +-- 1 +instance Functor m => Functor (EitherT e m) where + fmap f (EitherT x) = EitherT $ (fmap . fmap) f x + +-- 2 +instance Applicative m => Applicative (EitherT e m) where + pure x = EitherT $ pure $ pure x + + (EitherT f) <*> (EitherT a) = EitherT $ (<*>) <$> f <*> a + +-- 3 +instance Monad m => Monad (EitherT e m) where + return = pure + + (EitherT em) >>= f = EitherT $ do + v <- em + case v of + Left y -> return $ Left y + Right y -> runEitherT (f y) + + +-- 4 +-- transformer version of swapEither. +-- Hint: write swapEither first, then swapEitherT in terms of the former. +swapEither :: Either e a -> Either a e +swapEither (Left x) = Right x +swapEither (Right y) = Left y + +swapEitherT :: (Functor m) + => EitherT e m a + -> EitherT a m e +swapEitherT (EitherT x) = EitherT $ fmap swapEither x + +-- 5. Write the transformer variant of the either catamorphism. +eitherT :: Monad m + => (a -> m c) + -> (b -> m c) + -> EitherT a m b + -> m c +eitherT f g (EitherT x) = x >>= (either f g) + +instance MonadTrans (EitherT e) where + lift = EitherT . liftM Right + +instance (MonadIO m) + => MonadIO (EitherT e m) where + liftIO = lift . liftIO diff --git a/Haskell-book/26/MaybeT/src/Identity.hs b/Haskell-book/26/MaybeT/src/Identity.hs new file mode 100644 index 0000000..8189c18 --- /dev/null +++ b/Haskell-book/26/MaybeT/src/Identity.hs @@ -0,0 +1,43 @@ +module Identity where + +import MonadIO +import MonadTrans + +newtype Identity a = + Identity { runIdentity :: a } + deriving (Eq, Show) + +instance Functor Identity where + fmap f (Identity a) = Identity (f a) + +instance Applicative Identity where + pure = Identity + (Identity f) <*> (Identity a) = Identity (f a) + +newtype IdentityT f a = + IdentityT { runIdentityT :: f a } + deriving (Eq, Show) + +instance (Functor m) + => Functor (IdentityT m) where + fmap f (IdentityT fa) = IdentityT (fmap f fa) + +instance (Applicative m) + => Applicative (IdentityT m) where + pure x = IdentityT (pure x) + + (IdentityT fab) <*> (IdentityT fa) = + IdentityT (fab <*> fa) + +instance (Monad m) + => Monad (IdentityT m) where + return = pure + + (IdentityT ma) >>= f = IdentityT $ ma >>= runIdentityT . f + +instance (MonadIO m) + => MonadIO (IdentityT m) where + liftIO = IdentityT . liftIO + +instance MonadTrans IdentityT where + lift = IdentityT diff --git a/Haskell-book/26/MaybeT/src/Maybe.hs b/Haskell-book/26/MaybeT/src/Maybe.hs new file mode 100644 index 0000000..4d6c9b7 --- /dev/null +++ b/Haskell-book/26/MaybeT/src/Maybe.hs @@ -0,0 +1,40 @@ +module Maybe where + +import Control.Monad +import MonadIO +import MonadTrans + +newtype MaybeT m a = + MaybeT { runMaybeT :: m (Maybe a) } + +-- compare to the instance for MaybeT +instance (Functor m) + => Functor (MaybeT m) where + fmap f (MaybeT ma) = + MaybeT $ (fmap . fmap) f ma + +instance (Applicative m) + => Applicative (MaybeT m) where + pure x = MaybeT (pure (pure x)) + + (MaybeT fab) <*> (MaybeT mma) = MaybeT $ (<*>) <$> fab <*> mma + +instance (Monad m) + => Monad (MaybeT m) where + return = pure + + -- (>>=) :: MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b + (MaybeT ma) >>= f = MaybeT $ do + -- ma :: m (Maybe a) + -- v :: Maybe a + v <- ma + case v of + Nothing -> return Nothing + Just y -> runMaybeT (f y) + +instance MonadTrans MaybeT where + lift = MaybeT . liftM Just + +instance (MonadIO m) + => MonadIO (MaybeT m) where + liftIO = lift . liftIO diff --git a/Haskell-book/26/MaybeT/src/MonadIO.hs b/Haskell-book/26/MaybeT/src/MonadIO.hs new file mode 100644 index 0000000..93244dd --- /dev/null +++ b/Haskell-book/26/MaybeT/src/MonadIO.hs @@ -0,0 +1,5 @@ +module MonadIO where + +class (Monad m) => MonadIO m where + -- | Lift a computation from the 'IO' monad. + liftIO :: IO a -> m a diff --git a/Haskell-book/26/MaybeT/src/MonadTrans.hs b/Haskell-book/26/MaybeT/src/MonadTrans.hs new file mode 100644 index 0000000..7954164 --- /dev/null +++ b/Haskell-book/26/MaybeT/src/MonadTrans.hs @@ -0,0 +1,7 @@ +module MonadTrans where + +class MonadTrans t where + -- | Lift a computation from + -- the argument monad to + -- the constructed monad. + lift :: (Monad m) => m a -> t m a diff --git a/Haskell-book/26/MaybeT/src/Reader.hs b/Haskell-book/26/MaybeT/src/Reader.hs new file mode 100644 index 0000000..38fded9 --- /dev/null +++ b/Haskell-book/26/MaybeT/src/Reader.hs @@ -0,0 +1,35 @@ +module Reader where + +import MonadIO +import MonadTrans + +newtype ReaderT r m a = + ReaderT { runReaderT :: r -> m a } + +instance (Functor m) + => Functor (ReaderT r m) where + fmap f (ReaderT rma) = + ReaderT $ (fmap . fmap) f rma + +instance (Applicative m) + => Applicative (ReaderT r m) where + pure a = ReaderT (pure (pure a)) + + (ReaderT fmab) <*> (ReaderT rma) = + ReaderT $ (<*>) <$> fmab <*> rma + +instance (Monad m) + => Monad (ReaderT r m) where + return = pure + + (ReaderT rma) >>= f = + ReaderT $ \r -> do + a <- rma r + runReaderT (f a) r + +instance MonadTrans (ReaderT r) where + lift = ReaderT . const + +instance (MonadIO m) + => MonadIO (ReaderT r m) where + liftIO = lift . liftIO diff --git a/Haskell-book/26/MaybeT/src/State.hs b/Haskell-book/26/MaybeT/src/State.hs new file mode 100644 index 0000000..d30fdd5 --- /dev/null +++ b/Haskell-book/26/MaybeT/src/State.hs @@ -0,0 +1,41 @@ +module State where + +import MonadIO +import MonadTrans + +newtype StateT s m a = + StateT { runStateT :: s -> m (a, s) } + +-- 1 +instance (Functor m) + => Functor (StateT s m) where + fmap f (StateT m) = StateT $ \s -> fmap first $ m s + where first = uncurry (\t1 t2 -> ((f t1), t2)) + +-- 2 +-- Links: +-- http://stackoverflow.com/questions/18673525/is-it-possible-to-implement-applicative-m-applicative-statet-s-m +-- https://github.com/NICTA/course/issues/134 +instance (Monad m) + => Applicative (StateT s m) where + pure x = StateT $ (\s -> pure (x, s)) + StateT g <*> StateT h = StateT $ \s -> keepFirst <$> g s <*> h s + where keepFirst (f, s') (x, _) = (f x, s') + + +-- 3 +instance (Monad m) + => Monad (StateT s m) where + return = pure + + (StateT sma) >>= f = + StateT $ \s -> do + a <- sma s + runStateT (f $ fst a) s + +instance MonadTrans (StateT s) where + lift c = StateT $ \s -> c >>= (\x -> return (x, s)) + +instance (MonadIO m) + => MonadIO (StateT s m) where + liftIO = lift . liftIO diff --git a/Haskell-book/26/MaybeT/stack.yaml b/Haskell-book/26/MaybeT/stack.yaml new file mode 100644 index 0000000..05facc0 --- /dev/null +++ b/Haskell-book/26/MaybeT/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-11.6 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.6" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file diff --git a/Haskell-book/26/MaybeT/test/Spec.hs b/Haskell-book/26/MaybeT/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/Haskell-book/26/MaybeT/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/Haskell-book/26/Morra/.gitignore b/Haskell-book/26/Morra/.gitignore new file mode 100644 index 0000000..552029c --- /dev/null +++ b/Haskell-book/26/Morra/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +Morra.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/26/Morra/Setup.hs b/Haskell-book/26/Morra/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/26/Morra/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/26/Morra/app/Main.hs b/Haskell-book/26/Morra/app/Main.hs new file mode 100644 index 0000000..0b0d28a --- /dev/null +++ b/Haskell-book/26/Morra/app/Main.hs @@ -0,0 +1,69 @@ +module Main where + +import Control.Monad +import Control.Monad.Trans.State +import System.Random +import System.Console.ANSI (clearScreen) + +type Score = StateT (Integer, Integer) IO (Integer, Integer) + +yourTurn :: IO (Integer, Integer) +yourTurn = do + putStrLn "Wie viele Finger zeigen Sie?" + shown <- liftM read getLine + + putStrLn "Wie viele Finger wird der Gegner zeigen?" + guessed <- liftM read getLine + + clearScreen + + return (shown, guessed) + + +aiTurn :: IO (Integer, Integer) +aiTurn = do + gen1 <- getStdGen + + let (shown, gen2) = randomR (1, 5) gen1 + putStrLn $ "Der Gegner zeigt: " ++ (show shown) + + let (guessed, gen3) = randomR (1, 5) gen2 + putStrLn $ "Der Gegner hat " ++ (show guessed) ++ " geraten." + + setStdGen gen3 + return (shown, guessed) + + +score :: IO (Integer, Integer) -> Score +score partnerTurn = StateT $ \(s1, s2) -> do + you <- yourTurn + partner <- partnerTurn + let sum = (fst you) + (snd partner) + + let yourScore = if (snd you) == sum then 1 else 0 + let partnerScore = if (snd partner) == sum then 1 else 0 + return ((yourScore, partnerScore), (s1 + yourScore, s2 + partnerScore)) + + +loopGame :: IO (Integer, Integer) + -> (Integer, Integer) + -> IO (Either (Integer, Integer) (Integer, Integer)) +loopGame partnerTurn currentScore = do + (result, s) <- runStateT (score partnerTurn) currentScore + putStrLn $ show $ result + + case s of + (16, _) -> return $ Left result + (_, 16) -> return $ Right result + _ -> loopGame partnerTurn s + + +main :: IO () +main = do + winner <- loopGame aiTurn (0, 0) + + case winner of + Left x -> putStrLn $ "You've won! Score: " ++ (show x) + Right x -> putStrLn $ "You've lost! Score: " ++ (show x) + + return () diff --git a/Haskell-book/26/Morra/package.yaml b/Haskell-book/26/Morra/package.yaml new file mode 100644 index 0000000..5b313af --- /dev/null +++ b/Haskell-book/26/Morra/package.yaml @@ -0,0 +1,21 @@ +name: Morra +version: 0.1.0.0 +license: BSD3 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 +- random +- transformers +- ansi-terminal + +executables: + morra: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N diff --git a/Haskell-book/26/Morra/stack.yaml b/Haskell-book/26/Morra/stack.yaml new file mode 100644 index 0000000..8235b57 --- /dev/null +++ b/Haskell-book/26/Morra/stack.yaml @@ -0,0 +1,65 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-11.9 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file |