Craft3e 0.1.0.7 → 0.1.0.8
raw patch · 35 files changed
+1/−1390 lines, 35 files
Files
- .DS_Store binary
- ._.DS_Store binary
- ._Calculator binary
- ._Chapter15 binary
- ._Chapter16 binary
- ._Craft3e.cabal binary
- ._IO binary
- ._LICENSE binary
- ._README.txt binary
- ._Simulation binary
- ._blk_horse_head.jpg binary
- Calculator/.DS_Store binary
- Calculator/._.DS_Store binary
- Chapter15/.DS_Store binary
- Chapter15/._.DS_Store binary
- Chapter16/.DS_Store binary
- Chapter16/._.DS_Store binary
- Chapter19/.DS_Store binary
- Chapter19/._.DS_Store binary
- Chapter19/ParseLib.hs +0/−132
- Chapter19/Pic.hs +0/−63
- Chapter19/Pictures.hs +0/−256
- Chapter19/PositionedImages.hs +0/−258
- Chapter19/QCfuns.hs +0/−37
- Craft3e.cabal +1/−1
- IO/.DS_Store binary
- IO/._.DS_Store binary
- IO/DoTest.hs +0/−49
- IO/MonadIO.hs +0/−171
- IO/TreeId.hs +0/−55
- IO/TreeState.hs +0/−99
- LISTING +0/−177
- Simulation/.DS_Store binary
- Simulation/._.DS_Store binary
- UsePictures.hs +0/−92
− .DS_Store
binary file changed (6148 → absent bytes)
− ._.DS_Store
binary file changed (82 → absent bytes)
− ._Calculator
binary file changed (229 → absent bytes)
− ._Chapter15
binary file changed (229 → absent bytes)
− ._Chapter16
binary file changed (229 → absent bytes)
− ._Craft3e.cabal
binary file changed (356 → absent bytes)
− ._IO
binary file changed (229 → absent bytes)
− ._LICENSE
binary file changed (167 → absent bytes)
− ._README.txt
binary file changed (171 → absent bytes)
− ._Simulation
binary file changed (229 → absent bytes)
− ._blk_horse_head.jpg
binary file changed (263 → absent bytes)
− Calculator/.DS_Store
binary file changed (6148 → absent bytes)
− Calculator/._.DS_Store
binary file changed (82 → absent bytes)
− Chapter15/.DS_Store
binary file changed (6148 → absent bytes)
− Chapter15/._.DS_Store
binary file changed (82 → absent bytes)
− Chapter16/.DS_Store
binary file changed (6148 → absent bytes)
− Chapter16/._.DS_Store
binary file changed (82 → absent bytes)
− Chapter19/.DS_Store
binary file changed (6148 → absent bytes)
− Chapter19/._.DS_Store
binary file changed (82 → absent bytes)
− Chapter19/ParseLib.hs
@@ -1,132 +0,0 @@----------------------------------------------------------------------------- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.--- --- ParseLib.hs--- --- Library functions for parsing --- Note that this is not a monadic approach to parsing. --- ---------------------------------------------------------------------------- --module ParseLib where--import Data.Char--infixr 5 >*>--- --- The type of parsers. --- -type Parse a b = [a] -> [(b,[a])]--- --- Some basic parsers --- --- --- Fail on any input. --- -none :: Parse a b-none inp = []--- --- Succeed, returning the value supplied. --- -succeed :: b -> Parse a b -succeed val inp = [(val,inp)]--- --- token t recognises t as the first value in the input. --- -token :: Eq a => a -> Parse a a-token t (x:xs) - | t==x = [(t,xs)]- | otherwise = []-token t [] = []--- --- spot whether an element with a particular property is the --- first element of input. --- -spot :: (a -> Bool) -> Parse a a-spot p (x:xs) - | p x = [(x,xs)]- | otherwise = []-spot p [] = []--- --- Examples. --- -bracket = token '('-dig = spot isDigit---- Succeeds with value given when the input is empty.--endOfInput :: b -> Parse a b-endOfInput x [] = [(x,[])]-endOfInput x _ = []--- --- Combining parsers --- --- --- alt p1 p2 recognises anything recogniseed by p1 or by p2. --- -alt :: Parse a b -> Parse a b -> Parse a b-alt p1 p2 inp = p1 inp ++ p2 inp-exam1 = (bracket `alt` dig) "234" --- --- Apply one parser then the second to the result(s) of the first. --- --(>*>) :: Parse a b -> Parse a c -> Parse a (b,c)--- -(>*>) p1 p2 inp - = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2) <- p2 rem1 ]--- --- Transform the results of the parses according to the function. --- -build :: Parse a b -> (b -> c) -> Parse a c-build p f inp = [ (f x,rem) | (x,rem) <- p inp ]--- --- Recognise a list of objects. --- --- -list :: Parse a b -> Parse a [b]-list p = (succeed []) - `alt`- ((p >*> list p) `build` convert)- where- convert = uncurry (:)--- --- Some variants...---- A non-empty list of objects. --- -neList :: Parse a b -> Parse a [b]-neList p = (p `build` (:[]))- `alt`- ((p >*> list p) `build` (uncurry (:)))---- Zero or one object.--optional :: Parse a b -> Parse a [b]-optional p = (succeed []) - `alt` - (p `build` (:[]))---- A given number of objects.--nTimes :: Int -> Parse a b -> Parse a [b]-nTimes 0 p = succeed []-nTimes (n+1) p = (p >*> nTimes n p) `build` (uncurry (:))--- --- Monadic parsing--data SParse a b = SParse (Parse a b)--instance Monad (SParse a) where- return x = SParse (succeed x)- (SParse pr) >>= f - = SParse (\st -> concat [ sparse (f a) rest | (a,rest) <- pr st ])--sparse :: SParse a b -> Parse a b--sparse (SParse pr) = pr--
− Chapter19/Pic.hs
@@ -1,63 +0,0 @@------------------------------------------------------------------------------ Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.------ Pic.hs--- --- A deep embedding of pictures-----------------------------------------------------------------------------module Pic where--import Pictures---- Data type representing pictures--data Pic = Horse |- Above Pic Pic |- Beside Pic Pic |- FlipH Pic |- FlipV Pic ---- Interpreting a Pic as a Picture--interpretPic :: Pic -> Picture--interpretPic Horse = horse-interpretPic (Above pic1 pic2)- = above (interpretPic pic1) (interpretPic pic2)-interpretPic (Beside pic1 pic2)- = beside (interpretPic pic1) (interpretPic pic2)-interpretPic (FlipH pic)- = flipH (interpretPic pic)-interpretPic (FlipV pic)- = flipV (interpretPic pic)---- Tidying up a picture ...---- remove pairs of flips--- push flips through placement above / beside--tidyPic :: Pic -> Pic--tidyPic (FlipV (FlipV pic)) - = tidyPic pic-tidyPic (FlipV (FlipH pic)) - = FlipH (tidyPic (FlipV pic)) --tidyPic (FlipV (Above pic1 pic2))- = Above (tidyPic (FlipV pic1)) (tidyPic (FlipV pic2)) -tidyPic (FlipV (Beside pic1 pic2))- = Beside (tidyPic (FlipV pic2)) (tidyPic (FlipV pic1)) --tidyPic (FlipH (FlipH pic)) - = tidyPic pic- -tidyPic (FlipH (Above pic1 pic2))- = Above (tidyPic (FlipH pic2)) (tidyPic (FlipH pic1)) -tidyPic (FlipH (Beside pic1 pic2))- = Beside (tidyPic (FlipH pic1)) (tidyPic (FlipH pic2)) -
− Chapter19/Pictures.hs
@@ -1,256 +0,0 @@--------------------------------------------------------------------------- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2010.------ Pictures.hs--- --- An implementation of a type of rectangular pictures --- using lists of lists of characters. ------------------------------------------------------------------------------ The basics--- ^^^^^^^^^^--module Pictures where-import Test.QuickCheck---type Picture = [[Char]]---- The example used in Craft2e: a polygon which looks like a horse. Here--- taken to be a 16 by 12 rectangle.--horse :: Picture--horse = [".......##...",- ".....##..#..",- "...##.....#.",- "..#.......#.",- "..#...#...#.",- "..#...###.#.",- ".#....#..##.",- "..#...#.....",- "...#...#....",- "....#..#....",- ".....#.#....",- "......##...."]---- Completely white and black pictures.--white :: Picture--white = ["......",- "......",- "......",- "......",- "......",- "......"]--black = ["######",- "######",- "######",- "######",- "######",- "######"]---- Getting a picture onto the screen.--printPicture :: Picture -> IO ()--printPicture = putStr . concat . map (++"\n")----- Transformations of pictures.--- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^---- Reflection in a vertical mirror.--flipV :: Picture -> Picture--flipV = map reverse---- Reflection in a horizontal mirror.--flipH :: Picture -> Picture--flipH = reverse---- Rotation through 180 degrees, by composing vertical and horizontal--- reflection. Note that it can also be done by flipV.flipH, and that we--- can prove equality of the two functions.--rotate :: Picture -> Picture--rotate = flipH . flipV---- One picture above another. To maintain the rectangular property,--- the pictures need to have the same width.--above :: Picture -> Picture -> Picture--above = (++)---- One picture next to another. To maintain the rectangular property,--- the pictures need to have the same height.--beside :: Picture -> Picture -> Picture--beside = zipWith (++)---- Superimose one picture above another. Assume the pictures to be the same--- size. The individual characters are combined using the combine function.--superimpose :: Picture -> Picture -> Picture--superimpose = zipWith (zipWith combine)---- For the result to be '.' both components have to the '.'; otherwise--- get the '#' character.--combine :: Char -> Char -> Char--combine topCh bottomCh- = if (topCh == '.' && bottomCh == '.') - then '.'- else '#'---- Inverting the colours in a picture; done pointwise by invert...--invertColour :: Picture -> Picture--invertColour = map (map invert)---- ... which works by making the result '.' unless the input is '.'.--invert :: Char -> Char--invert ch = if ch == '.' then '#' else '.'----- Property--prop_rotate, prop_flipV, prop_flipH :: Picture -> Bool--prop_rotate pic = flipV (flipH pic) == flipH (flipV pic)--prop_flipV pic = flipV (flipV pic) == pic--prop_flipH pic = flipH (flipV pic) == pic--test_rotate, test_flipV, test_flipH :: Bool- -test_rotate = flipV (flipH horse) == flipH (flipV horse)--test_flipV = flipV (flipV horse) == horse--test_flipH = flipH (flipV horse) == horse---- More properties--prop_AboveFlipV pic1 pic2 = - flipV (pic1 `above` pic2) == (flipV pic1) `above` (flipV pic2) --prop_AboveFlipH pic1 pic2 = flipH (pic1 `above` pic2) == (flipH pic2) `above` (flipH pic1)--propAboveBeside1 nw ne sw se =- (nw `beside` ne) `above` (sw `beside` se) - == - (nw `above` sw) `beside` (ne `above` se) --propAboveBeside2 n s =- (n `beside` n) `above` (s `beside` s) == (n `above` s) `beside` (n `above` s) --propAboveBeside3 w e =- (w `beside` e) `above` (w `beside` e) == (w `above` w) `beside` (e `above` e) --propAboveBeside3Correct w e =- (rectangular w && rectangular e && height w == height e) - ==>- (w `beside` e) `above` (w `beside` e) - == - (w `above` w) `beside` (e `above` e) ---- auxiliary properties and functions--notEmpty pic = pic /= []--rectangular pic =- notEmpty pic &&- and [ length first == length l | l <-rest ]- where- (first:rest) = pic--height, width :: Picture -> Int--height = length-width = length . head--size :: Picture -> (Int,Int)--size pic = (width pic, height pic)--propAboveBesideFull nw ne sw se =- (rectangular nw && rectangular ne && rectangular sw && rectangular se &&- size nw == size ne && size ne == size se && size se == size sw) ==>- (nw `beside` ne) `above` (sw `beside` se) == (nw `above` sw) `beside` (ne `above` se) ---- Using explicit generators ...---prop_1 = forAll (choose (1,10)) $ \x -> x/=x+(x::Int)--prop_2 = forAll (choose (1,10)) $ \x -> x/=(x::Int)---- Generators suited to Pictures---- chose either '.' or '#'--genChar :: Gen Char--genChar = oneof [return '.', return '#']---- generate a list of length n each element from generator g.--genList :: Int -> Gen a -> Gen [a]--genList n g = sequence [ g | i<-[1..n] ]---- generate a picture of given size using '.' and '#'--genSizedPicture :: Int -> Int -> Gen [String]--genSizedPicture height width =- sequence [ genList width genChar | i<-[1::Int .. height] ]---- generate a picture of random size using '.' and '#'--genPicture :: Gen [String]--genPicture =- do- height <- choose (1,10)- width <- choose (1,10)- genSizedPicture height width---- generate four pictures of the *same* random size using '.' and '#'--genFourPictures :: Gen ([String],[String],[String],[String])--genFourPictures =- do- height <- choose (1,10)- width <- choose (1,10)- nw <- genSizedPicture height width- ne <- genSizedPicture height width- sw <- genSizedPicture height width- se <- genSizedPicture height width- return (nw,ne,sw,se)---- test that above and besides commute when used with four pictures--- of the same size--prop_AboveBeside =- forAll genFourPictures $ \(nw,ne,sw,se) -> propAboveBeside1 nw ne sw se
− Chapter19/PositionedImages.hs
@@ -1,258 +0,0 @@-{-# OPTIONS_GHC -fglasgow-exts #-}----module PositionedImages where--import System.IO--import Control.Monad-import Control.Monad.State--import Data.Map hiding (map)------- Geometric types------- Points measured with Int coordinates thus:------ o------> x axis--- |--- |--- V--- y axis--type Point = (Int,Int)--origin = (0,0)---- Bounding box: represented by NW and SE corners:------ o------+--- | |--- | |--- +------o--- --data Box = Box Point Point- deriving (Show, Eq)--emptyBox = Box origin origin---- --- Images and pictures--- ---- Pictures are rectangular assemblies of Basic images.--- Each picture has a bounding box, memoised in the data structure ---- An image is contained in a file ...--data File = File String- deriving (Show)---- ... and is displayed in an area of size given by the Point:--data Image = Image File Point- deriving (Show)---- A basic image is an image, with the Point of its origin, and a Filter --- of effects to be applied.--data Basic = Basic Image Point Filter- deriving (Show)--data Filter = Filter {fH, fV, neg :: Bool}- deriving (Show)--newFilter = Filter False False False---- A Picture is a list of Basics.--data Picture = Picture [Basic]---- Convert an Image to a Basic and to a Picture--basic :: Image -> Basic --basic img = - Basic img origin newFilter--img :: Image -> Picture --img img@(Image _ point) = - Picture [Basic img origin newFilter]--box :: Basic -> Box- -box (Basic img@(Image _ (x,y)) (x',y') _)- = Box (x',y') (x'+x, y'+y)-------- The monad------- Simple state monad keeping track of the dimensions of the current picture.--- Folds into the definition the calculation of width and height and the--- calculation of flatten, which is done as the picture is constructed.--type Def a = State Info a---- State is a finite map from Ints to Basic images--type Info = Map Id Basic---- Ids are Ints, which are the keys for the Info map--type Id = Int---- Positions of the four corners of a rectangular image--- Could also add N, W, E, S and Centre TO DO--data Position = NW | NE | SW | SE---- Monadic functions---- Place an image at a given point in the canvas--placeId :: Image -> Point -> Def Id-placeId image point- = - do- n <- gets size- let basic = Basic image point newFilter- modify (insert n basic) - return n--place :: Image -> Point -> Def ()-place image point- = - do- n <- gets size- let basic = Basic image point newFilter- modify (insert n basic) - return ()--positionId :: Image -> Id -> Position -> Def Id-positionId image id pos- = - do- n <- gets size- b <- gets (box . just . Data.Map.lookup id)- let basic = Basic image (getPosition pos b) newFilter- modify (insert n basic) - return n--position :: Image -> Id -> Position -> Def ()-position image id pos- = - do- n <- gets size- b <- gets (box . just . Data.Map.lookup id)- let basic = Basic image (getPosition pos b) newFilter- modify (insert n basic) - return ()--just (Just n) = n--flatten :: Def a -> Picture--flatten defs - = makePicture (execState defs empty)--makePicture :: Map Int Basic -> Picture-makePicture picMap - = Picture $ fold (:) [] picMap------- Library functions------- Extracting coordinates of the four corners of a box--getPosition :: Position -> Box -> Point--getPosition NW (Box pt _) = pt-getPosition NE (Box (_, y0) (x1, _)) = (x1, y0)-getPosition SW (Box (x0, _) (_, y1)) = (x0, y1)-getPosition SE (Box _ pt) = pt-------- examples-----horse :: Image--horse = Image (File "blk_horse_head.jpg") (150, 200)--test :: Def ()--test- = - do- pic <- placeId horse (100,100)- pic2 <- positionId horse pic SE- position horse pic2 SW- -testProgram :: IO ()--testProgram = render $ flatten $ test---- flipFH is flip in a horizontal axis--- flipFV is flip in a vertical axis--- flipNeg negative negates each pixel--- flip one of the flags for transforms / filter--flipFH (Basic img point f@(Filter {fH=boo})) = Basic img point f{fH = not boo}-flipFV (Basic img point f@(Filter {fV=boo})) = Basic img point f{fV = not boo}-flipNeg (Basic img point f@(Filter {neg=boo})) = Basic img point f{neg = not boo}---- Convert is unchaged from the previous version, converts a basic --- image to an SVG object.--convert :: Basic -> String--convert (Basic (Image (File name) (width, height)) (x, y) (Filter fH fV neg))- = "\n <image x=\"" ++ show x ++ "\" y=\"" ++ show y ++ "\" width=\"" ++ show width ++ "\" height=\"" ++- show height ++ "\" xlink:href=\"" ++ name ++ "\"" ++ flipPart ++ negPart ++ "/>\n"- where- flipPart = if fH && not fV - then " transform=\"translate(0," ++ show (2*y + height) ++ ") scale(1,-1)\" " - else - if fV && not fH - then " transform=\"translate(" ++ show (2*x + width) ++ ",0) scale(-1,1)\" " - else - if fV && fH - then " transform=\"translate(" ++ show (2*x + width) ++ "," ++ show (2*y + height) ++ ") scale(-1,-1)\" " - else ""- negPart = if neg then " filter=\"url(#negative)\"" else "" ---- Rendering a picture to a file--render :: Picture -> IO ()--render pic - = - let- Picture picList = pic- svgString = concat (map convert picList)- newFile = preamble ++ svgString ++ postamble- in- do- outh <- openFile "/Users/simonthompson/Dropbox/craft3e/DSLs/svg/svgOut.xml" WriteMode- hPutStrLn outh newFile- hClose outh--preamble- = "<svg width=\"100%\" height=\"200%\" version=\"1.1\"\n" ++- "xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n" ++- "<filter id=\"negative\">\n" ++- "<feColorMatrix type=\"matrix\"\n"++- "values=\"-1 0 0 0 0 0 -1 0 0 0 0 0 -1 0 0 1 1 1 0 0\" />\n" ++- "</filter>\n"--postamble- = "\n</svg>\n"
− Chapter19/QCfuns.hs
@@ -1,37 +0,0 @@-------------------------------------------------------------------------------- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.------ QCfuns-------------------------------------------------------------------------------module QCfuns where--import Test.QuickCheck-import System.IO.Unsafe -- for unsafePerformIO---- Sampling and showing functions--sampleFun :: (Arbitrary a,Show a, Show b) => (a -> b) -> IO String--sampleFun f =- do- inputs <- sample' arbitrary- let list = [ (a,f a) | a <- inputs ]- return $ showMap list--showMap :: (Show a, Show b) => [(a,b)] -> String--showMap [] = "\n"-showMap [(a,b)] = showPair (a,b) ++ "\n"-showMap (p:ps) = showPair p ++ " ," ++ showMap ps--showPair :: (Show a, Show b) => (a,b) -> String--showPair (a,b) = "("++show a ++ "|->" ++ show b ++ ")"--instance (Arbitrary a, Show a, Show b) => Show (a -> b) where- show = unsafePerformIO . sampleFun
Craft3e.cabal view
@@ -1,6 +1,6 @@ name: Craft3e-version: 0.1.0.7+version: 0.1.0.8 license: MIT license-file: LICENSE copyright: (c) Addison Wesley
− IO/.DS_Store
binary file changed (6148 → absent bytes)
− IO/._.DS_Store
binary file changed (82 → absent bytes)
− IO/DoTest.hs
@@ -1,49 +0,0 @@--- (c) Addison-Wesley, 1996-2010.--- DOtest.lhs---test1 :: IO ()--test1 - = do getLine- getLine- line3 <- getLine- putStr (line3 ++ "\n")---put4times :: String -> IO ()--put4times str - = do putStrLn str- putStrLn str- putStrLn str- putStrLn str--putNtimes :: Int -> String -> IO ()--putNtimes n str- = if n <= 1 - then putStrLn str- else do putStrLn str- putNtimes (n-1) str--read2lines :: IO ()--read2lines - = do getLine- getLine- putStrLn "Two lines read."--reverse2lines :: IO ()-reverse2lines- = do line1 <- getLine- line2 <- getLine- putStrLn (reverse line2)- putStrLn (reverse line1)--addOneInt :: IO ()-addOneInt - = do line <- getLine- putStrLn (show (1 + read line :: Int))--- -
− IO/MonadIO.hs
@@ -1,171 +0,0 @@------------------------------------------------------------------------------ ----- FirstEd.hs Using Monads for I/O ----- Haskell 1.4 version ----- ----- (c) Addison-Wesley, 1996-2010. ----- -------------------------------------------------------------------------------import IO -- not good enough! isEOF not implemented properly - -- in Hugs 1.4 yet!------------------------------------------------------------------------------- To read a line ----- getLine :: IO String ----- ----- To write a string ----- putStr :: String -> IO () ----- ----- The `then' operation ----- (>>=) :: IO t -> (t -> IO u) -> IO u ------------------------------------------------------------------------------------------------------------------------------------------------------------ To write a line ----- That is write a String with a newline appended. -------------------------------------------------------------------------------putLine :: String -> IO ()--putLine line = putStr (line ++ "\n")------------------------------------------------------------------------------- Read then write -------------------------------------------------------------------------------readWrite :: IO ()--readWrite = do line <- getLine- putLine line------------------------------------------------------------------------------- Read, reverse then write -------------------------------------------------------------------------------readRevWrite :: IO ()--readRevWrite- = do line <- getLine- putLine (reverse line)------------------------------------------------------------------------------- Return a value without doing any IO ----- return :: t -> IO t ----- ----- Sequence without passing values between ----- (>>) :: IO t -> IO u -> IO u ----- f >> g = f >>= const g ------------------------------------------------------------------------------------------------------------------------------------------------------------ Apply a function and return its result -------------------------------------------------------------------------------apply :: (t -> u) -> t -> IO u-apply f a = return (f a)------------------------------------------------------------------------------- Read, reverse then write (revisited) -------------------------------------------------------------------------------readRevWrite' :: IO ()-readRevWrite' = (getLine >>= apply reverse) >>= putLine------------------------------------------------------------------------------- Making a String transformer into an interaction. ----- interact :: (String -> String) -> IO () ------------------------------------------------------------------------------------------------------------------------------------------------------------ Iteration -------------------------------------------------------------------------------while :: IO Bool -> IO () -> IO ()--while test oper- = do res <- test- if res then do oper- while test oper- else return ()------------------------------------------------------------------------------- Testing for the end of input ----- isEOF :: IO Bool ----- This version uses the NONSTANDARD hugsIsEOF for IO.hs ----- It's not clear how you use this interactively; I remember now ----- that C I/O is peculiar! -------------------------------------------------------------------------------isEOF = hugsIsEOF------------------------------------------------------------------------------- Copy lines until end of file. -------------------------------------------------------------------------------copyInputToOutput :: IO ()-copyInputToOutput- = while (do res <- isEOF- return (not res))- (do line <- getLine- putLine (reverse line))- ---- reverse lines until you hit an empty line--- can't see an easy way of building this with --- combinators rather than recursion ...--- ... goUntilEmpty is a failed attempt.--reverseUntilEmpty :: IO ()--reverseUntilEmpty- = do line <- getLine- if (line == [])- then return ()- else (do putLine (reverse line)- reverseUntilEmpty)- --- following version doesn't work: --- forever outputs the first line read--goUntilEmpty :: IO ()-goUntilEmpty- = do line <- getLine- while (return (line /= []))- (do putLine line- line <- getLine- return ())---- get an integer on a line on its own --- not particularly robust: gives an error--- Program error: PreludeText.read: no parse--- in case there is anything untoward in the input,--- including perhaps multiple Ints per line.--getInt :: IO Int--getInt = do line <- getLine- return (read line :: Int)---- sum integers until 0 is input--sumInts :: IO Int--sumInts- = do n <- getInt- if n==0 - then return 0- else (do m <- sumInts- return (n+m))---- an interactive wrapper for sumInts--sumInteract :: IO ()--sumInteract- = do putLine "Enter integers one per line"- putLine "These will be summed until zero is entered"- sum <- sumInts- putStr "The sum was "- putLine (show sum)-
− IO/TreeId.hs
@@ -1,55 +0,0 @@------------------------------------------------------------------------------ ----- Tree and the identity monad. ----- ----- (c) Addison-Wesley, 1996-2010. ----- -------------------------------------------------------------------------------import Prelude------------------------------------------------------------------------------- Type of trees -------------------------------------------------------------------------------data Tree t = Nil | Node t (Tree t) (Tree t) - deriving (Eq, Show)------------------------------------------------------------------------------- A direct computation of the sum of a tree. -------------------------------------------------------------------------------sTree :: Tree Int -> Int--sTree Nil = 0--sTree (Node n t1 t2) = n + sTree t1 + sTree t2------------------------------------------------------------------------------- A monadic computation of the sum of a tree. -------------------------------------------------------------------------------sumTree :: Tree Int -> Id Int--sumTree Nil = return 0--sumTree (Node n t1 t2)- = do num <- return n- s1 <- sumTree t1- s2 <- sumTree t2- return (num + s1 + s2)------------------------------------------------------------------------------- The monad in question -- the identity monad -------------------------------------------------------------------------------data Id t = Id t - deriving (Eq, Ord, Show, Read)--instance Monad Id where- return = Id- (>>=) (Id x) f = f x--extract :: Id t -> t-extract (Id x) = x-
− IO/TreeState.hs
@@ -1,99 +0,0 @@------------------------------------------------------------------------------ ----- Tree and a State monad ----- ----- (c) Addison-Wesley, 1996-2010. ----- -------------------------------------------------------------------------------import Prelude hiding (lookup)------------------------------------------------------------------------------- Type of trees -------------------------------------------------------------------------------data Tree a = Nil | Node a (Tree a) (Tree a) - deriving (Eq,Show)------------------------------------------------------------------------------- A state monad -------------------------------------------------------------------------------data State a b = State (Table a -> (Table a , b))--type Table a = [a]--instance Monad (State a) where- return x = State (\tab -> (tab,x))- (State st) >>= f - = State (\tab -> let - (newTab,y) = st tab- (State trans) = f y - in- trans newTab)--extract :: State a b -> b--extract (State st) = snd (st [])------------------------------------------------------------------------------- Assigning unique natural numbers to the members of a tree. -------------------------------------------------------------------------------numTree :: Eq a => Tree a -> Tree Int-numTree = extract . numberTree--numberTree :: Eq a => Tree a -> State a (Tree Int)--numberTree Nil = return Nil--numberTree (Node x t1 t2)- = do num <- numberNode x- nt1 <- numberTree t1- nt2 <- numberTree t2- return (Node num nt1 nt2)------------------------------------------------------------------------------- Numbering a Node involves a lookup, which in turn will modify ----- the state in case the value is seen for the first time. -------------------------------------------------------------------------------numberNode :: Eq a => a -> State a Int--numberNode x - = State (\ table -> if elem x table- then (table , lookup x table)- else (table++[x] , length table) )--lookup :: Eq a => a -> Table a -> Int--lookup x table = look x table 0--look :: Eq a => a -> Table a -> Int -> Int--look x [] n = error "table lookup"-look x (y:ys) n- | x==y = n- | otherwise = look x ys (n+1)------------------------------------------------------------------------------- Examples -------------------------------------------------------------------------------example :: Tree Char--example = Node 'z' ex1 ex2--ex1 = Node 'f' ex2 ex2--ex2 = Node 'q' (Node 'z' Nil Nil) (Node 'e' Nil Nil)--data Children = Ahmet | Dweezil | Moon - deriving Eq--zapTree :: Tree Children--zapTree = Node Moon (Node Ahmet Nil Nil)- (Node Dweezil (Node Ahmet Nil Nil)- (Node Moon Nil Nil))-
− LISTING
@@ -1,177 +0,0 @@-Calculator-Chapter1.hs-Chapter10.hs-Chapter11.hs-Chapter12.hs-Chapter13.hs-Chapter14_1.hs-Chapter14_2.hs-Chapter15-Chapter16-Chapter17.hs-Chapter18.hs-Chapter19-Chapter2.hs-Chapter20.hs-Chapter3.hs-Chapter4.hs-Chapter5.hs-Chapter6.hs-Chapter7.hs-Chapter8.hs-Chapter9.hs-Craft3e.cabal-FirstScript.hs-IO-Index.hs-LICENSE-LISTING-ParseLib.hs-Parsing.hs-PerformanceI.hs-PerformanceIA.hs-PerformanceIS.hs-Pic.hs-Pictures.hs-PicturesSVG.hs-QCfuns.hs-README.txt-RPS.hs-Relation.hs-Set.hs-Setup.hs-Simulation-UseMonads.hs-black.jpg-blk_horse_head.jpg-blue.jpg-dist-red.jpg-refresh.html-showPic.html-svgOut.xml-white.jpg--./Calculator:-CalcEval.hs-CalcParse.hs-CalcParseLib.hs-CalcStore.hs-CalcToplevel.hs-CalcTypes.hs--./Chapter15:-Ant.hs-Bee.hs-CodeTable.hs-Coding.hs-Cow.hs-Doe.hs-Frequency.hs-Main.hs-MakeCode.hs-MakeTree.hs-Test.hs-Types.hs--./Chapter16:-QCStoreTest.hs-Queues1.hs-Queues2.hs-Queues3.hs-Store.hs-StoreFun.hs-StoreTest.hs-Tree.hs-UseStore.hs-UseStoreFun.hs-UseTree.hs--./Chapter19:-QC.hs-RegExp.hs--./IO:-DoTest.hs-MonadIO.hs-TreeId.hs-TreeState.hs--./Simulation:-Base.hs-QueueState.hs-RandomGen.hs-ServerState.hs-TopLevelServe.hs--./dist:-Craft3e-0.1.0.1.tar.gz-build-package.conf.inplace-setup-config-src--./dist/build:-Chapter1.hi-Chapter1.o-Chapter10.hi-Chapter10.o-Chapter11.hi-Chapter11.o-Chapter12.hi-Chapter12.o-Chapter13.hi-Chapter13.o-Chapter14_1.hi-Chapter14_1.o-Chapter14_2.hi-Chapter14_2.o-Chapter17.hi-Chapter17.o-Chapter18.hi-Chapter18.o-Chapter2.hi-Chapter2.o-Chapter20.hi-Chapter20.o-Chapter3.hi-Chapter3.o-Chapter4.hi-Chapter4.o-Chapter5.hi-Chapter5.o-Chapter6.hi-Chapter6.o-Chapter7.hi-Chapter7.o-Chapter8.hi-Chapter8.o-Chapter9.hi-Chapter9.o-FirstScript.hi-FirstScript.o-HSCraft3e-0.1.0.1.o-HSCraft3e-0.1.o-Index.hi-Index.o-Pic.hi-Pic.o-Pictures.hi-Pictures.o-RPS.hi-RPS.o-RegExp.hi-RegExp.o-Relation.hi-Relation.o-Set.hi-Set.o-autogen-libHSCraft3e-0.1.0.1.a-libHSCraft3e-0.1.a--./dist/build/autogen:-Paths_Craft3e.hs-cabal_macros.h--./dist/src:
− Simulation/.DS_Store
binary file changed (6148 → absent bytes)
− Simulation/._.DS_Store
binary file changed (82 → absent bytes)
− UsePictures.hs
@@ -1,92 +0,0 @@------------------------------------------------------------------------------- --- --- Haskell: The Craft of Functional Programming --- Simon Thompson --- (c) Addison-Wesley, 2011. --- --- UsePictures --- --- Solutions to Exercises 2.1-2.4 --- ------------------------------------------------------------------------------- - - -module UsePictures where -import Pictures - --- --- Solution 2.1 --- - -blackHorse :: Picture -blackHorse = (invertColour horse) - -rotateHorse :: Picture -rotateHorse = flipH (flipV horse) - --- --- Solution 2.2 --- - --- One approach is to define it all in one go ... - -square1 :: Picture - -square1 = (black `beside` white) `above` (white `beside` black) - --- ... another uses some auxilary definitions: - -bw, wb, square2 :: Picture - -bw = black `beside` white -wb = white `beside` black - -square2 = bw `above` wb - --- Other approaches put the squares above each other before putting --- the results beside each other, using auxiliary definitions or not. - --- Variants don't use infix functions, or define wb by inverting bw: - -wb1 = invertColour bw - --- --- Solution 2.3 --- - --- Some of hese solutions use two auxiliary definitions - --- White horse next to black horse, and vice versa - -blackWhite, whiteBlack :: Picture -blackWhite = (beside horse blackHorse) -whiteBlack = (beside blackHorse horse) - --- A: White horse black horse, above black horse white horse - -checkBoard1 :: Picture -checkBoard1 = (beside (above horse (blackHorse)) (above (blackHorse) horse)) - --- B: White horse, black horse above black horse white horse, flipped vertically - -checkBoard2 :: Picture -checkBoard2 = (above (blackWhite) (flipV blackWhite)) - --- C: White horse black horse above black horse white horse, flipped horizontally - -checkBoard3 :: Picture -checkBoard3 = (above (blackWhite) (flipV (flipH blackWhite))) - --- --- Solution 2.4 --- - --- White horse black horse above upside down white horse black horse, flipped horizontally - -checkBoard4 :: Picture -checkBoard4 = (above (blackWhite) (flipH whiteBlack)) - - - - -