diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 Binary files a/.DS_Store and /dev/null differ diff --git a/._.DS_Store b/._.DS_Store deleted file mode 100644 Binary files a/._.DS_Store and /dev/null differ diff --git a/._Calculator b/._Calculator deleted file mode 100644 Binary files a/._Calculator and /dev/null differ diff --git a/._Chapter15 b/._Chapter15 deleted file mode 100644 Binary files a/._Chapter15 and /dev/null differ diff --git a/._Chapter16 b/._Chapter16 deleted file mode 100644 Binary files a/._Chapter16 and /dev/null differ diff --git a/._Craft3e.cabal b/._Craft3e.cabal deleted file mode 100644 Binary files a/._Craft3e.cabal and /dev/null differ diff --git a/._IO b/._IO deleted file mode 100644 Binary files a/._IO and /dev/null differ diff --git a/._LICENSE b/._LICENSE deleted file mode 100644 Binary files a/._LICENSE and /dev/null differ diff --git a/._README.txt b/._README.txt deleted file mode 100644 Binary files a/._README.txt and /dev/null differ diff --git a/._Simulation b/._Simulation deleted file mode 100644 Binary files a/._Simulation and /dev/null differ diff --git a/._blk_horse_head.jpg b/._blk_horse_head.jpg deleted file mode 100644 Binary files a/._blk_horse_head.jpg and /dev/null differ diff --git a/Calculator/.DS_Store b/Calculator/.DS_Store deleted file mode 100644 Binary files a/Calculator/.DS_Store and /dev/null differ diff --git a/Calculator/._.DS_Store b/Calculator/._.DS_Store deleted file mode 100644 Binary files a/Calculator/._.DS_Store and /dev/null differ diff --git a/Chapter15/.DS_Store b/Chapter15/.DS_Store deleted file mode 100644 Binary files a/Chapter15/.DS_Store and /dev/null differ diff --git a/Chapter15/._.DS_Store b/Chapter15/._.DS_Store deleted file mode 100644 Binary files a/Chapter15/._.DS_Store and /dev/null differ diff --git a/Chapter16/.DS_Store b/Chapter16/.DS_Store deleted file mode 100644 Binary files a/Chapter16/.DS_Store and /dev/null differ diff --git a/Chapter16/._.DS_Store b/Chapter16/._.DS_Store deleted file mode 100644 Binary files a/Chapter16/._.DS_Store and /dev/null differ diff --git a/Chapter19/.DS_Store b/Chapter19/.DS_Store deleted file mode 100644 Binary files a/Chapter19/.DS_Store and /dev/null differ diff --git a/Chapter19/._.DS_Store b/Chapter19/._.DS_Store deleted file mode 100644 Binary files a/Chapter19/._.DS_Store and /dev/null differ diff --git a/Chapter19/ParseLib.hs b/Chapter19/ParseLib.hs deleted file mode 100644 --- a/Chapter19/ParseLib.hs +++ /dev/null @@ -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 - - diff --git a/Chapter19/Pic.hs b/Chapter19/Pic.hs deleted file mode 100644 --- a/Chapter19/Pic.hs +++ /dev/null @@ -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)) - diff --git a/Chapter19/Pictures.hs b/Chapter19/Pictures.hs deleted file mode 100644 --- a/Chapter19/Pictures.hs +++ /dev/null @@ -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 diff --git a/Chapter19/PositionedImages.hs b/Chapter19/PositionedImages.hs deleted file mode 100644 --- a/Chapter19/PositionedImages.hs +++ /dev/null @@ -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 \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 - = "\n" ++ - "\n" ++ - "\n" ++ - "\n" - -postamble - = "\n\n" diff --git a/Chapter19/QCfuns.hs b/Chapter19/QCfuns.hs deleted file mode 100644 --- a/Chapter19/QCfuns.hs +++ /dev/null @@ -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 diff --git a/Craft3e.cabal b/Craft3e.cabal --- a/Craft3e.cabal +++ b/Craft3e.cabal @@ -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 diff --git a/IO/.DS_Store b/IO/.DS_Store deleted file mode 100644 Binary files a/IO/.DS_Store and /dev/null differ diff --git a/IO/._.DS_Store b/IO/._.DS_Store deleted file mode 100644 Binary files a/IO/._.DS_Store and /dev/null differ diff --git a/IO/DoTest.hs b/IO/DoTest.hs deleted file mode 100644 --- a/IO/DoTest.hs +++ /dev/null @@ -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)) --- - diff --git a/IO/MonadIO.hs b/IO/MonadIO.hs deleted file mode 100644 --- a/IO/MonadIO.hs +++ /dev/null @@ -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) - diff --git a/IO/TreeId.hs b/IO/TreeId.hs deleted file mode 100644 --- a/IO/TreeId.hs +++ /dev/null @@ -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 - diff --git a/IO/TreeState.hs b/IO/TreeState.hs deleted file mode 100644 --- a/IO/TreeState.hs +++ /dev/null @@ -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)) - diff --git a/LISTING b/LISTING deleted file mode 100644 --- a/LISTING +++ /dev/null @@ -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: diff --git a/Simulation/.DS_Store b/Simulation/.DS_Store deleted file mode 100644 Binary files a/Simulation/.DS_Store and /dev/null differ diff --git a/Simulation/._.DS_Store b/Simulation/._.DS_Store deleted file mode 100644 Binary files a/Simulation/._.DS_Store and /dev/null differ diff --git a/UsePictures.hs b/UsePictures.hs deleted file mode 100644 --- a/UsePictures.hs +++ /dev/null @@ -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)) - - - - -