hid-examples 0.1.0.0 → 0.2
raw patch · 14 files changed
+919/−74 lines, 14 filesdep +extradep +mtldep +randomdep ~timenew-component:exe:dicegamenew-component:exe:filecountnew-component:exe:gcdnew-component:exe:genSQLnew-component:exe:iorefnew-component:exe:maybenew-component:exe:readernew-component:exe:shunting-yardnew-component:exe:strefnew-component:exe:weapons
Dependencies added: extra, mtl, random
Dependency ranges changed: time
Files
- .travis.yml +150/−0
- appveyor.yml +19/−0
- dicegame.hs +35/−0
- filecount.hs +25/−0
- gcd.hs +21/−0
- genSQL.hs +35/−0
- hid-examples.cabal +189/−74
- ioref.hs +21/−0
- maybe.hs +27/−0
- package.yaml +111/−0
- reader.hs +38/−0
- shunting-yard.hs +177/−0
- stref.hs +33/−0
- weapons.hs +38/−0
+ .travis.yml view
@@ -0,0 +1,150 @@+# This is the complex Travis configuration, which is intended for use+# on open source libraries which need compatibility across multiple GHC+# versions, must work with cabal-install, and should be+# cross-platform. For more information and other options, see:+#+# https://docs.haskellstack.org/en/stable/travis_ci/+#+# Copy these contents into the root directory of your Github project in a file+# named .travis.yml++# Use new container infrastructure to enable caching+sudo: false++# Do not choose a language; we provide our own build tools.+language: generic++# Caching so the next build will be fast too.+cache:+ directories:+ - $HOME/.ghc+ - $HOME/.cabal+ - $HOME/.stack+ - $TRAVIS_BUILD_DIR/.stack-work++# The different configurations we want to test. We have BUILD=cabal which uses+# cabal-install, and BUILD=stack which uses Stack. More documentation on each+# of those below.+#+# We set the compiler values here to tell Travis to use a different+# cache file per set of arguments.+#+# If you need to have different apt packages for each combination in the+# matrix, you can use a line such as:+# addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}+matrix:+ include:+ - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7+ compiler: ": #GHC 8.2.2"+ addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}+ - env: BUILD=cabal GHCVER=8.4.3 CABALVER=2.2 HAPPYVER=1.19.5 ALEXVER=3.1.7+ compiler: ": #GHC 8.4.3"+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}++ # Build with the newest GHC and cabal-install. This is an accepted failure,+ # see below.+ - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7+ compiler: ": #GHC HEAD"+ addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}++ # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS+ # variable, such as using --stack-yaml to point to a different file.+ - env: BUILD=stack ARGS=""+ compiler: ": #stack default"+ addons: {apt: {packages: [libgmp-dev]}}++ # Build on macOS in addition to Linux+ - env: BUILD=stack ARGS=""+ compiler: ": #stack default osx"+ os: osx++ allow_failures:+ - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7++before_install:+# Using compiler above sets CC to an invalid value, so unset it+- unset CC++# We want to always allow newer versions of packages when building on GHC HEAD+- CABALARGS=""+- if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi++# Download and unpack the stack executable+- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH+- mkdir -p ~/.local/bin+- |+ if [ `uname` = "Darwin" ]+ then+ travis_retry curl --insecure -L https://get.haskellstack.org/stable/osx-x86_64.tar.gz | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin+ else+ travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'+ fi++ # Use the more reliable S3 mirror of Hackage+ mkdir -p $HOME/.cabal+ echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config+ echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config+++install:+- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+- if [ -f configure.ac ]; then autoreconf -i; fi+- |+ set -ex+ case "$BUILD" in+ stack)+ # Add in extra-deps for older snapshots, as necessary+ stack --no-terminal --install-ghc $ARGS test --bench --dry-run || ( \+ stack --no-terminal $ARGS build cabal-install && \+ stack --no-terminal $ARGS solver --update-config)++ # Build the dependencies+ stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies+ ;;+ cabal)+ cabal --version+ travis_retry cabal update++ # Get the list of packages from the stack.yaml file. Note that+ # this will also implicitly run hpack as necessary to generate+ # the .cabal files needed by cabal-install.+ PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@')++ cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES+ ;;+ esac+ set +ex++script:+- |+ set -ex+ case "$BUILD" in+ stack)+ stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps+ ;;+ cabal)+ cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES++ ORIGDIR=$(pwd)+ for dir in $PACKAGES+ do+ cd $dir+ cabal check || [ "$CABALVER" == "1.16" ]+ cabal sdist+ PKGVER=$(cabal info . | awk '{print $2;exit}')+ SRC_TGZ=$PKGVER.tar.gz+ cd dist+ tar zxfv "$SRC_TGZ"+ cd "$PKGVER"+ cabal configure --enable-tests --ghc-options -O0+ cabal build+ if [ "$CABALVER" = "1.16" ] || [ "$CABALVER" = "1.18" ]; then+ cabal test+ else+ cabal test --show-details=streaming --log=/dev/stdout+ fi+ cd $ORIGDIR+ done+ ;;+ esac+ set +ex
+ appveyor.yml view
@@ -0,0 +1,19 @@+build: off++before_test:+# http://help.appveyor.com/discussions/problems/6312-curl-command-not-found+- set PATH=C:\Program Files\Git\mingw64\bin;%PATH%++- curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-i386+- 7z x stack.zip stack.exe++clone_folder: "c:\\stack"+environment:+ global:+ STACK_ROOT: "c:\\sr"++test_script:+- stack setup > nul+# The ugly echo "" hack is to avoid complaints about 0 being an invalid file+# descriptor+- echo "" | stack --no-terminal test
+ dicegame.hs view
@@ -0,0 +1,35 @@+import Control.Monad (replicateM)+import Control.Monad.RWS+import System.Random++type Dice = Int++type DiceGame = RWS (Int, Int) [Dice] StdGen++dice' :: DiceGame Dice+dice' = do+ bs <- ask+ g <- get+ let (r, g') = randomR bs g+ put g'+ tell [r]+ pure r++dice :: DiceGame Dice+dice = do+ bs <- ask+ r <- state (randomR bs)+ tell [r]+ pure r++doubleDice :: DiceGame (Dice, Dice)+doubleDice = (,) <$> dice <*> dice++dices :: Int -> DiceGame [Dice]+dices n = replicateM n dice ++diceGame :: DiceGame (Dice, Dice)+diceGame = dice >> dices 5 >> replicateM 2 (dices 3)+ >> dices 10 >> doubleDice++main = newStdGen >>= print . evalRWS diceGame (1, 6)
+ filecount.hs view
@@ -0,0 +1,25 @@+import Data.Foldable (traverse_)+import System.Environment (getArgs)+import System.Directory.Extra+import Control.Monad.Extra (whenM, ifM, zipWithM)+import Data.IORef (newIORef, modifyIORef', readIORef)++fileCount :: FilePath -> IO Int+fileCount fp = do+ cnt <- newIORef 0+ whenM (doesDirectoryExist fp) $ go cnt fp + readIORef cnt+ where+ go cnt fp = listContents fp >>= traverse_ (processEntry cnt)+ processEntry cnt fp = ifM (doesDirectoryExist fp) (go cnt fp) (inc cnt)+ inc cnt = modifyIORef' cnt (+ 1)++fileCount' :: FilePath -> IO Int+fileCount' fp = length <$> listFilesRecursive fp++main = do+ args <- getArgs+ xs <- traverse fileCount args+ zipWithM printEntry args xs+ where+ printEntry fp n = putStrLn (show n ++ "\t" ++ fp)
+ gcd.hs view
@@ -0,0 +1,21 @@+import Control.Monad.Writer++gcd' :: Integer -> Integer -> Integer+gcd' a 0 = a+gcd' a b = gcd b (a `mod` b)++gcd_countSteps :: Integer -> Integer -> Writer (Sum Int) Integer+gcd_countSteps a 0 = tell (Sum 1) >> pure a+gcd_countSteps a b = tell (Sum 1) >> gcd_countSteps b (a `mod` b)++gcd_logSteps :: Integer -> Integer -> Writer [(Integer, Integer)] Integer+gcd_logSteps a 0 = tell [(a,0)] >> pure a+gcd_logSteps a b = tell [(a,b)] >> gcd_logSteps b (a `mod` b)++gcd_countSteps' a b = mapWriter mapper (gcd_logSteps a b)+ where+ mapper (a, w) = (a, Sum $ length w)++gcd_countSteps'' = (mapWriter (Sum . length <$>) .) . gcd_logSteps++main = print "OK"
+ genSQL.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}++import Data.Foldable+import Control.Monad.Writer+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import Data.Monoid++data ErrorMsg = WrongFormat+ Int+ T.Text+ deriving Show++type SQL = T.Text++genInsert s1 s2 = "INSERT INTO items VALUES ('" <> s1 <> "','" <> s2 <> "');\n"++processOneLine :: (Int, T.Text) -> Writer [ErrorMsg] SQL +processOneLine (i, T.splitOn ":" -> [s1, s2]) = pure $ genInsert s1 s2+processOneLine (i, s) = writer (T.empty, [WrongFormat i s])++genSQL :: T.Text -> Writer [ErrorMsg] SQL+genSQL t = T.concat <$> traverse processOneLine (zip [1..] $ T.lines t)+++testData = "Pen:Bob\nGlass:Mary:10\nPencil:Alice\nBook:Bob\nBottle"++testGenSQL = do+ let (sql, errors) = runWriter (genSQL testData) + TIO.putStrLn "SQL:"+ TIO.putStr sql+ TIO.putStrLn "Errors:"+ traverse_ print errors++main = testGenSQL
hid-examples.cabal view
@@ -1,89 +1,204 @@-name: hid-examples-version: 0.1.0.0-synopsis: Examples to accompany the book "Haskell in Depth"-description:- This package provides source code examples which accompany the book- "Haskell in Depth" by Vitaly Bragilevsky (Manning Publications 2019).- You may want to get this package via @cabal get hid-examples@- and explore its content.+cabal-version: >= 1.10 -license: BSD3-license-file: LICENSE-author: Vitaly Bragilevsky-maintainer: Vitaly Bragilevsky <vit.bragilevsky@gmail.com>-copyright: (c) Vitaly Bragilevsky 2018-category: Sample Code-build-type: Simple-extra-source-files: ChangeLog.md-cabal-version: >=1.10+-- This file has been generated from package.yaml by hpack version 0.29.7.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6d9bc7f35a54450595b8cfc3a4fe434408d4bb09fdf34222dfa11b29c8a6861b -bug-reports: https://github.com/bravit/hid-examples/issues-homepage: https://github.com/bravit/hid-examples/+name: hid-examples+version: 0.2+synopsis: Examples to accompany the book "Haskell in Depth"+description: This package provides source code examples which accompany the book "Haskell in Depth" by Vitaly Bragilevsky (Manning Publications 2019). You may want to get this package via @cabal get hid-examples@ and explore its content.+category: Sample Code+homepage: https://github.com/bravit/hid-examples#readme+bug-reports: https://github.com/bravit/hid-examples/issues+author: Vitaly Bragilevsky+maintainer: Vitaly Bragilevsky <vit.bragilevsky@gmail.com>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ .travis.yml+ appveyor.yml+ ChangeLog.md+ LICENSE+ package.yaml+ README.md+ stack.yaml+data-files:+ data/quotes.csv+ texts/Dracula.srt+ texts/forsyte.txt+ texts/hamlet.txt+ texts/phrase.txt+ texts/rune-poem.txt -extra-source-files: ChangeLog.md- LICENSE- README.md- stack.yaml+source-repository head+ type: git+ location: https://github.com/bravit/hid-examples -data-files: data/quotes.csv- texts/Dracula.srt- texts/*.txt+executable dicegame+ main-is: dicegame.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , mtl >=2.0 && <2.3+ , random >=1.0 && <1.2+ default-language: Haskell2010 -source-repository head- type: git- location: https://github.com/bravit/hid-examples.git+executable filecount+ main-is: filecount.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , extra >=1.5 && <1.7+ default-language: Haskell2010 --- -------------------------------------------------------------------------------- Chapter 2+executable gcd+ main-is: gcd.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , mtl >=2.0 && <2.3+ default-language: Haskell2010 -executable locator- main-is: locator.hs- build-depends: base >=4.10 && <4.12- default-language: Haskell2010+executable genSQL+ main-is: genSQL.hs+ other-modules:+ Paths_hid_examples+ other-extensions: OverloadedStrings ViewPatterns+ build-depends:+ base >=4.10 && <4.12+ , mtl >=2.0 && <2.3+ , text >=1.2 && <1.3+ default-language: Haskell2010 -executable vocab1- main-is: vocab1.hs- build-depends: base >=4.10 && <4.12- , text >=1.2 && <1.3- default-language: Haskell2010+executable ioref+ main-is: ioref.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ default-language: Haskell2010 -executable vocab2- main-is: vocab2.hs- build-depends: base >=4.10 && <4.12- , text >=1.2 && <1.3- default-language: Haskell2010+executable locator+ main-is: locator.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ default-language: Haskell2010 -executable vocab3- main-is: vocab3.hs- build-depends: base >=4.10 && <4.12- , text >=1.2 && <1.3- default-language: Haskell2010+executable maybe+ main-is: maybe.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , safe >=0.3 && <0.4+ default-language: Haskell2010 +executable reader+ main-is: reader.hs+ other-modules:+ Paths_hid_examples+ other-extensions: NamedFieldPuns+ build-depends:+ base >=4.10 && <4.12+ , mtl >=2.0 && <2.3+ default-language: Haskell2010+ executable showexpr- main-is: showexpr.hs- build-depends: base >=4.10 && <4.12- , hint >=0.7 && <0.9- default-language: Haskell2010+ main-is: showexpr.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , hint >=0.7 && <0.9+ default-language: Haskell2010 --- -------------------------------------------------------------------------------- Chapter 3+executable shunting-yard+ main-is: shunting-yard.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , mtl >=2.0 && <2.3+ default-language: Haskell2010 executable stockquotes- hs-source-dirs: stockquotes- main-is: Main.hs- other-modules: BoundedEnum QuoteData Statistics StatReport- Charts HtmlReport Params - other-extensions: RecordWildCards OverloadedStrings FlexibleInstances- DeriveGeneric DeriveAnyClass- build-depends: base >=4.10 && <4.11- , bytestring >=0.10 && <0.11- , blaze-html >=0.9 && <0.10- , optparse-applicative >=0.14 && <0.15- , time >=1.8 && <1.9- , text >=1.2 && <1.3- , fmt >=0.5 && <0.7- , safe >=0.3 && <0.4- , Chart >=1.8 && <1.9- , Chart-diagrams >=1.8 && <1.9- , cassava >=0.5 && <0.6- default-language: Haskell2010+ main-is: Main.hs+ other-modules:+ BoundedEnum+ Charts+ HtmlReport+ Params+ QuoteData+ Statistics+ StatReport+ Paths_hid_examples+ hs-source-dirs:+ stockquotes+ other-extensions: RecordWildCards OverloadedStrings FlexibleInstances DeriveGeneric DeriveAnyClass+ build-depends:+ Chart >=1.8 && <1.10+ , Chart-diagrams >=1.8 && <1.10+ , base >=4.10 && <4.12+ , blaze-html >=0.9 && <0.10+ , bytestring >=0.10 && <0.11+ , cassava >=0.5 && <0.6+ , fmt >=0.5 && <0.7+ , optparse-applicative >=0.14 && <0.15+ , safe >=0.3 && <0.4+ , text >=1.2 && <1.3+ , time >=1.8 && <1.10+ default-language: Haskell2010++executable stref+ main-is: stref.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ default-language: Haskell2010++executable vocab1+ main-is: vocab1.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , text >=1.2 && <1.3+ default-language: Haskell2010++executable vocab2+ main-is: vocab2.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , text >=1.2 && <1.3+ default-language: Haskell2010++executable vocab3+ main-is: vocab3.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , text >=1.2 && <1.3+ default-language: Haskell2010++executable weapons+ main-is: weapons.hs+ other-modules:+ Paths_hid_examples+ build-depends:+ base >=4.10 && <4.12+ , mtl >=2.0 && <2.3+ , random >=1.0 && <1.2+ default-language: Haskell2010
+ ioref.hs view
@@ -0,0 +1,21 @@+import Data.IORef+import Control.Monad++sumNumbers :: IO Int+sumNumbers = do+ s <- newIORef 0+ go s+ readIORef s+ where+ go s = do+ putStr "Enter next integer number (empty line to finish): "+ n <- getLine+ when (not $ null n) $ do+ let num = read n+ modifyIORef' s (+ num)+ go s++main = do+ s <- sumNumbers+ putStr "Your sum is: "+ print s
+ maybe.hs view
@@ -0,0 +1,27 @@+import Safe++type Name = String+type Phone = String+type Location = String+type PhoneNumbers = [(Name, Phone)]+type Locations = [(Phone, Location)]++locByName :: PhoneNumbers -> Locations -> Name -> Maybe Location+locByName pnumbers locs name = lookup name pnumbers >>= flip lookup locs++locByName' :: PhoneNumbers -> Locations -> Name -> Maybe Location+locByName' pnumbers locs name = case lookup name pnumbers of+ Just number -> lookup number locs+ Nothing -> Nothing++doubleStrNumber :: (Num a, Read a) => String -> Maybe a+doubleStrNumber s = (*2) <$> readMay s+++plusStrNumbers :: (Num a, Read a) => String -> String -> Maybe a+plusStrNumbers s1 s2 = (+) <$> readMay s1 <*> readMay s2++main = do+ print $ doubleStrNumber "21"+ print $ plusStrNumbers "10" "xx"+
+ package.yaml view
@@ -0,0 +1,111 @@+name: hid-examples+version: 0.2+synopsis: Examples to accompany the book "Haskell in Depth"+description:+ This package provides source code examples which accompany the book+ "Haskell in Depth" by Vitaly Bragilevsky (Manning Publications 2019).+ You may want to get this package via @cabal get hid-examples@+ and explore its content.++category: Sample Code+license: BSD3+author: Vitaly Bragilevsky+maintainer: Vitaly Bragilevsky <vit.bragilevsky@gmail.com>+github: bravit/hid-examples+extra-source-files:+ - ChangeLog.md+ - LICENSE+ - README.md+ - stack.yaml+ - .travis.yml+ - appveyor.yml+ - package.yaml++data-files:+ - data/*.*+ - texts/*.*++dependencies: base >=4.10 && <4.12++executables:+ # Chapter 2+ locator:+ main: locator.hs+ vocab1:+ main: vocab1.hs+ dependencies: text >=1.2 && <1.3+ vocab2:+ main: vocab2.hs+ dependencies: text >=1.2 && <1.3+ vocab3:+ main: vocab3.hs+ dependencies: text >=1.2 && <1.3+ showexpr:+ main: showexpr.hs+ dependencies: hint >=0.7 && <0.9+ # Chapter 3+ stockquotes:+ source-dirs: stockquotes+ main: Main.hs+ other-extensions:+ - RecordWildCards+ - OverloadedStrings+ - FlexibleInstances+ - DeriveGeneric+ - DeriveAnyClass+ dependencies:+ - bytestring >=0.10 && <0.11+ - blaze-html >=0.9 && <0.10+ - optparse-applicative >=0.14 && <0.15+ - time >=1.8 && <1.10+ - text >=1.2 && <1.3+ - fmt >=0.5 && <0.7+ - safe >=0.3 && <0.4+ - Chart >=1.8 && <1.10+ - Chart-diagrams >=1.8 && <1.10+ - cassava >=0.5 && <0.6+ # Chapter 5+ maybe:+ main: maybe.hs+ dependencies:+ - safe >=0.3 && <0.4+ reader:+ main: reader.hs+ other-extensions:+ - NamedFieldPuns+ dependencies:+ - mtl >=2.0 && <2.3+ genSQL:+ main: genSQL.hs+ other-extensions:+ - OverloadedStrings+ - ViewPatterns+ dependencies:+ - text >=1.2 && <1.3+ - mtl >=2.0 && <2.3+ gcd:+ main: gcd.hs+ dependencies:+ - mtl >=2.0 && <2.3+ weapons:+ main: weapons.hs+ dependencies:+ - mtl >=2.0 && <2.3+ - random >=1.0 && <1.2+ shunting-yard:+ main: shunting-yard.hs+ dependencies:+ - mtl >=2.0 && <2.3+ dicegame:+ main: dicegame.hs+ dependencies:+ - mtl >=2.0 && <2.3+ - random >=1.0 && <1.2+ ioref:+ main: ioref.hs+ filecount:+ main: filecount.hs+ dependencies:+ - extra >=1.5 && <1.7+ stref:+ main: stref.hs
+ reader.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE NamedFieldPuns #-}+import Control.Monad.Reader++data Config = Config {+ flag1 :: Bool,+ flag2 :: Bool+ -- ...+ }++type ConfigM = Reader Config++main = do + let c = Config True False+ pure $ runReader work c+ print "OK"++work :: ConfigM ()+work = do+ -- ...+ f1+ -- ...++f1 :: ConfigM ()+f1 = do+ -- ...+ f11+ -- ...++f11 :: ConfigM ()+f11 = do+ -- ...+ c <- ask+ -- ...+ pure ()++nc = \c @ Config {flag1} -> c {flag1 = not flag1}++nc2 = \c -> c {flag1 = False}
+ shunting-yard.hs view
@@ -0,0 +1,177 @@+import Data.Char+import Data.List+import Data.Foldable+import Control.Monad.State++-- Implementation of the Shunting-yard algorithm++data Expr a = Lit a | Add (Expr a) (Expr a) | Mult (Expr a) (Expr a)++type Token = String+type Stack = [Token]+type Output = [Expr Integer]+type MyState = (Stack, Output)++push :: Token -> State MyState ()+push t = modify (\(s, es) -> (t : s, es))++pop :: State MyState Token+pop = do+ (t : s, es) <- get -- let it crash on empty stack+ put (s, es)+ pure t++pop_ :: State MyState () -- let it crash on empty stack+pop_ = modify (\(s, es) -> (tail s, es))++top :: State MyState Token+top = gets (head . fst) -- let it crash on empty stack++isEmpty :: State MyState Bool+isEmpty = null <$> gets fst++notEmpty :: State MyState Bool+notEmpty = not <$> isEmpty++output :: Token -> State MyState ()+output t = modify (builder t <$>)+ where + builder "+" (e1 : e2 : es) = Add e1 e2 : es+ builder "*" (e1 : e2 : es) = Mult e1 e2 : es+ builder n es = Lit (read n) : es -- let it crash on not a number++whileNotEmptyAnd :: (Token -> Bool) -> State MyState () -> State MyState ()+whileNotEmptyAnd pred m = go+ where+ go = do+ b1 <- notEmpty+ when b1 $ do+ b2 <- pred <$> top+ when b2 (m >> go)++isOp "+" = True+isOp "*" = True+isOp _ = False++precedence "+" = 1+precedence "*" = 2+precedence _ = 0++t1 `precGTE` t2 = precedence t1 >= precedence t2 ++convertToExpr :: String -> Expr Integer+convertToExpr str = head $ snd $ execState convert ([], [])+ where+ convert = traverse_ processToken (reverse $ tokenize str) >> transferRest++ processToken ")" = push ")"+ processToken "(" = transferWhile (/= ")") >> pop_+ processToken t+ | isOp t = transferWhile (`precGTE` t) >> push t+ | otherwise = output t -- number++ transfer = pop >>= output+ transferWhile pred = whileNotEmptyAnd pred transfer+ transferRest = transferWhile (const True)+ + tokenize = groupBy (\a b -> isDigit a && isDigit b)+ . filter (not . isSpace)++{-++https://en.wikipedia.org/wiki/Shunting-yard_algorithm++* stack+* output+* reading tokens in reversed order++while there are tokens to be read:+ read a token.+ if the token is a right bracket (i.e. ")"), then:+ push it onto the stack.+ if the token is a left bracket (i.e. "("), then:+ while the operator at the top of the stack is not a right bracket:+ pop the operator from the stack onto the output.+ pop the right bracket from the stack.+ /* if the stack runs out without finding a right bracket,+ then there are mismatched parentheses. */+ if the token is an operator, then:+ while ((there is an operator at the top of the stack+ with equal or greater precedence)+ and (the operator at the top of the stack+ is not a left bracket):+ pop operators from the stack onto the output.+ push it onto the stack.+ if the token is a number, then:+ push it to the output.++if there are no more tokens to read:+ while there are still operator tokens on the stack:+ /* if the operator token on the top of the stack is a bracket,+ then there are mismatched parentheses. */+ pop the operator from the operator stack onto the output.+exit.++-}++-- Printing `Expr a` values++instance Show a => Show (Expr a) where+ showsPrec _ (Lit a) = shows a+ showsPrec p (Add e1 e2) = showParen (p > precAdd)+ $ showsPrec precAdd e1+ . showString "+" + . showsPrec precAdd e2+ where precAdd = 5+ showsPrec p (Mult e1 e2) = showParen (p > precMult)+ $ showsPrec (precMult) e1+ . showString "*"+ . showsPrec (precMult) e2+ where precMult = 6++-- Evaluating expressions++myeval :: Num a => Expr a -> a+myeval (Lit e) = e+myeval (Add e1 e2) = myeval e1 + myeval e2+myeval (Mult e1 e2) = myeval e1 * myeval e2++-- Testing++strs = ["42", "12 + 13", "(2+3*3)*5", "1+(1+2)*(2+2*(1+2))+1+3*2",+ "13+2+12+2+1+2+13+2", "1*2*132*22*1*22*0*2", "10*(1+2)*2*(2+1*2)+1+3+2"]++view = traverse_ printExpr strs+ where+ printExpr s = do+ let e = convertToExpr s+ putStrLn $ show e ++ "=" ++ show (myeval e)++exprs = map convertToExpr strs+exprs' = map (convertToExpr . show) exprs++check = and $ zipWith (\e1 e2 -> myeval e1 == myeval e2) exprs exprs'++-- Converting expressions to prefix and postfix forms++data ExprForm = Prefix | Postfix++exprTo _ (Lit a) = show a+exprTo form (Add e1 e2) = binOp "+" form e1 e2+exprTo form (Mult e1 e2) = binOp "*" form e1 e2++binOp op form e1 e2 = concat $ intersperse " " (args form) + where+ e1' = exprTo form e1+ e2' = exprTo form e2+ args Prefix = [op, e1', e2']+ args Postfix = [e1', e2', op]++main = do+ view+ putStr "Checked: "+ print check+ putStrLn "\nPrefix forms: "+ mapM_ (putStrLn.exprTo Prefix) exprs+ putStrLn "\nPostfix forms: "+ mapM_ (putStrLn.exprTo Postfix) exprs
+ stref.hs view
@@ -0,0 +1,33 @@+import Data.Foldable (traverse_)+import Control.Monad+import Control.Monad.ST+import Data.STRef++comp1 :: ST s (STRef s Int)+comp1 = do+ -- ...+ newSTRef 0++comp2 :: STRef s Int -> ST s Int+comp2 ref = do+ -- ...+ readSTRef ref+++--main = print $ runST (comp2 (runST comp1))++countZeros :: [Int] -> Int+countZeros = length . filter (== 0)++countZerosST :: [Int] -> Int+countZerosST xs = runST $ do+ c <- newSTRef 0+ traverse_ (\x -> when (x==0) $ inc c) xs+ readSTRef c+ where+ inc c = modifySTRef' c (+1)++main = do+ print $ runST (comp1 >>= comp2)+ print $ countZeros $ replicate 1000 0+ print $ countZerosST $ replicate 1000 0
+ weapons.hs view
@@ -0,0 +1,38 @@+import Data.List (group, sort)+import Control.Monad (replicateM)+import Control.Monad.State+import System.Random++data Weapon = Rock | Paper | Scissors+ deriving (Show, Bounded, Enum, Eq, Ord)++data Winner = First | Second | Draw+ deriving (Show, Eq, Ord)++winner :: (Weapon, Weapon) -> Winner+winner (Paper, Rock) = First+winner (Scissors, Paper) = First+winner (Rock, Scissors) = First+winner (w1, w2) = if w1 == w2 then Draw else Second++instance Random Weapon where+ randomR (a,b) g = case randomR (fromEnum a, fromEnum b) g of+ (r, g') -> (toEnum r, g')+ random g = randomR (minBound, maxBound) g+++randomWeapon :: State StdGen Weapon+randomWeapon = state random++gameRound :: State StdGen (Weapon, Weapon)+gameRound = (,) <$> randomWeapon <*> randomWeapon++game :: Int -> State StdGen [(Winner, Int)]+game n = counts <$> replicateM n (winner <$> gameRound)+ where+ counts xs = map (\xs@(x:_) -> (x, length xs)) $ group $ sort xs+ +main = do+ g <- newStdGen+ let r = evalState (game 10) g+ print r