[More progress on chapter 9. Bryan O'Sullivan **20071025062056] { hunk ./en/ch09-find-dsl.xml 63 - getRecursiveContents to list that directory. - Otherwise, it returns a single-element list that is the name of - the current entry. Note that in the body of the loop, the - return is returning a value + getRecursiveContents to list that + directory. Otherwise, it returns a single-element list that is + the name of the current entry. Note that in the body of the + loop, the return is returning a value hunk ./en/ch09-find-dsl.xml 306 - predicate p, as p's - purity means it cannot do the I/O needed to gather the metadata - it requires. + predicate p, as p's purity + means it cannot do the I/O needed to gather the metadata it + requires. hunk ./en/ch09-find-dsl.xml 486 - + hunk ./en/ch09-find-dsl.xml 578 - + hunk ./en/ch09-find-dsl.xml 592 - &BetterPredicate.hs:liftP2; + &BetterPredicate.hs:liftPK; hunk ./en/ch09-find-dsl.xml 596 - function that works in a different context, here + function that operates in a different context, here hunk ./en/ch09-find-dsl.xml 599 - explains the choice of liftP2 as a - function name (the 2 indicates that it works with - functions of two arguments). Lifting lets us reuse code and - reduce boilerplate. We'll be using it a lot throughout the + explains the presence of lift in the function's + name. Lifting lets us reuse code and reduce boilerplate. + We'll be using it a lot, in different guises, throughout the hunk ./en/ch09-find-dsl.xml 604 + When we lift a function, we'll often refer to its original + and new versions as unlifted and + lifted, respectively. + hunk ./en/ch09-find-dsl.xml 610 - liftP2, was no accident. This made it + liftPK, was no accident. This made it hunk ./en/ch09-find-dsl.xml 621 + + + Gluing predicates together + + If we want to combine predicates, we can of course follow + the obvious path of doing so by hand. + + &BetterPredicate.hs:simpleAndP; + + Now that we know about lifting, however, it becomes + tempting to lift our existing Boolean operators. + + &BetterPredicate.hs:liftP2; + + Notice that liftP2 is very similar to + our earlier liftPK. In fact, it's more + general, because we can write liftPK in + terms of liftP2. + + &BetterPredicate.hs:constP; + + + Combinators + + In Haskell, we refer to functions that take other + functions as arguments, returning new functions, as + combinators. + + + Now that we have some helper functions in place, we can + return to the myTest function we defined + earlier. + + &BetterPredicate.hs:myTest.noid; + + How will this function look if we write it using our new + combinators? + + &BetterPredicate.hs:myTest2; + + We've added one final combinator, + liftPath, since manipulating file names + is such a common activity. + + Our rewrite doesn't really look any shorter than the + original function, though it's perhaps a little easier to + read. + + + + + Defining and using new operators + + We can address the length problem by defining new infix + operators, taking advantage of a Haskell feature that we first + mentioned briefly in . + + &BetterPredicate.hs:myTest3; + + We chose names like (==?) for the + lifted functions specifically for their visual similarity to + their unlifted counterparts. + + The parentheses in our definition above are necessary, + because we haven't told Haskell about the precedence or + associativity of our new operators. The language specifies + that operators without fixity declarations should be treated + as infixl 9, i.e. they are parsed from left to + right at the lowest allowable precedence level. If we were to + omit the parentheses, the expression would thus be parsed as + (((liftPath takeExtension) ==? ".cpp") &&? + sizeP) >? 1024, which is horribly wrong. + + We can respond by writing fixity declarations for our new + operators. Our first step is to find out what the fixities of + the unlifted operators are, so that we can mimic them. + + &betterpredicate.ghci:fixities; + + With these in hand, we can now write a parenthesis-free + expression that will be parsed identically to + myTest3. + + &BetterPredicate.hs:myTest3; + + + + + + Controlling traversal + + When traversing the filesystem, we'd like to give ourselves + more control over which directories we enter, and when. An easy + way in which we can allow this is to pass in a function that + takes a list of subdirectories of a given directory, and returns + another list. This list can have elements removed, or it can be + ordered differently than the original list, or both. The + simplest such control function is id, which + will return its input list unmodified. + + For variety, we're going to change a few aspects of our + representation here. Instead of an elaborate function type + InfoP a, we'll use a normal algebraic data type to + represent substantially the same information. + + &ControlledVisit.hs:Info; + + We're using record syntax to give ourselves + free accessor functions, such as + infoPath. The type of our + traverse function is simple, as we proposed + above. To obtain Info about a file or directory, + we call the getInfo action. + + &ControlledVisit.hs:traverse.type; + + The definition of traverse is short, + but dense. + + &ControlledVisit.hs:traverse; + + While we're not introducing any new techniques here, this is + one of the densest function definitions we've yet encountered. + Let's walk through it almost line by line, explaining what is + going on. The first few lines hold no mystery, as they're + almost verbatim copies of code we've already seen. + + Things begin to get interesting when we assign to the + variable contents. Let's read this line from + right to left. We already know that + usefulNames is a list of directory entries; + we put the empty string on the front of the list, to represent + the current directory, path. The code + getInfo . (path </>) joins + path and one of these entries together, then + calls getInfo on the result. (Using + (</>) to combine + path with the empty string gives us + path again, which is why we put the empty + string onto the front of our list.) Finally, we use + mapM to apply this function to + path and every one of its directory + entries. + + The line that follows is even more dense. Again reading + from right to left, we see that the last element of the line is + an anonymous function. Given one Info value, it + either visits a directory recursively (there's an extra check to + make sure we don't visit path again), or + returns that value as a single-element list (to match the return + type of traverse). + + We use forM to apply this function to + each element of the list of Info values returned by + order, the user-supplied traversal control + function. + + Finally, at the beginning of the line, we have another use + of lifting. The liftM function takes a + regular function, concat and lifts it into + the IO monad. In other words, it takes the result + of forM (of type [[Info]]) out + of the IO monad, applies + concat to it (yielding a result of type + [Info], which is what we need), and puts the result + back into the IO monad. + + Finally, we mustn't forget to define our + getInfo function. + + &ControlledVisit.hs:getInfo; + + The only noteworthy thing here is a useful combinator, + maybeIO, which turns an IO + action that might throw an exception into one that wraps its + result in Maybe. + + + Exercises + + + + + What should you pass to traverse + to traverse a directory tree in reverse alphabetic + order? + + + + + + Using id as a control function, + traverse id performs a + preorder traversal of a tree: it + returns a parent directory before its children. Write a + control function that makes traverse + perform a postorder traversal, in + which it returns children before their parent. + + + + + + Take the predicates and combinators from and make them + work with our new Info type. + + + + + + Write a wrapper for traverse + that lets you control traversal using one predicate, and + filter results using another. + + + + + + + + + Density, readability, and the learning process + + Code as dense as traverse isn't all + that unusual in Haskell. The gain in expressiveness is + significant, and it requires a relatively small amount of + practice to be able to fluently read and write code in this + style. + + For comparison, here's a less dense presentation of the same + code. This might be more typical of a less experienced Haskell + programmer. + + &ControlledVisit.hs:traverse; + + All we've done here is make a few substitutions. Instead of + using partial application and function composition liverally, + we've defined some local functions in a &where; block. In place + of the maybe combinator, we're using a + &case; expression. And instead of using + liftM, we're manually lifting + concat ourselves. + + This is not to say that density is a uniformly good + property. Each line of the original + traverse function is short. We introduce a + local variable (usefulNames) and a local + function (isDirectory) specifically to keep + the lines short and the code clearer. Our names names are + descriptive. While we use function composition and pipelining, + the longest pipeline contains only three elements. + + The key to writing maintainable Haskell code is to find a + balance between density and readability. Where your code falls + on this continuum is likely to be influenced by your level of + experience. + + + + As a beginning Haskell programmer, Andrew doesn't know + his way around the standard libraries very well. As a + result, he duplicates a lot of standard library code. + + + + Zack has been programming for a few months, and has + mastered the use of (.) to compose long + pipelines of code. Every time the needs of his program + change slightly, he has to construct a new pipeline from + scratch, because he can't understand the existing one any + longer and it's too fragile to change in any case. + + + + Monica has been hacking for a while. She's familiar + enough with Haskell libraries and idioms to write tight + code, but she avoids a hyperdense style in order to keep her + code maintainable and easy to refactor in the face of + changing needs. + + + + While much of good programming taste comes from experience, + we have a few general guidelines to offer. + + + + If you find yourself proudly thinking that a particular + piece of code is fiendishly clever, consider whether you'll + be able to understand it again after you've stepped away + from it for a month. + + Until you've been working with Haskell for a substantial + amount of time, spend a few minutes searching for library + functions before you write small functions. This applies + particularly to ubiquitous types like lists, + Maybe, and Either. If the + standard libraries don't already provide exactly what you + need, you might be able to combine a few functions to obtain + the result you desire. + + Long pipelines of composed functions are hard to read. + If you have one, use a &let; or &where; block to break it + down into smaller pipelines. Give each one of these + pipeline elements a meaningful name, then glue them back + together. If you can't think of a meaningful name for an + element, you probably can't describe what it's supposed to + be doing. + + hunk ./en/ch09-find-dsl.xml 941 - don't expose enough information. As an we must open a file to - find out what size it is. This is inefficient, and sometimes - impossible. We also can't find out who owns a file. + don't expose enough information to let us write interesting and + complicated queries. hunk ./examples/ch09/BetterPredicate.hs 93 -{-- snippet liftP2 --} -liftP2 :: (a -> a -> b) -> InfoP a -> a -> InfoP b -liftP2 f g k w x y z = g w x y z `f` k +{-- snippet liftPK --} +liftPK :: (a -> b -> c) -> InfoP a -> b -> InfoP c +liftPK q f k w x y z = f w x y z `q` k hunk ./examples/ch09/BetterPredicate.hs 98 -greaterP = liftP2 (>) -lesserP = liftP2 (<) +greaterP = liftPK (>) +lesserP = liftPK (<) +{-- /snippet liftPK --} + +{-- snippet simpleAndP --} +simpleAndP :: InfoP Bool -> InfoP Bool -> InfoP Bool +simpleAndP f g w x y z = f w x y z && g w x y z +{-- /snippet simpleAndP --} + +{-- snippet liftP2 --} +liftP2 :: (a -> b -> c) -> InfoP a -> InfoP b -> InfoP c +liftP2 q f g w x y z = f w x y z `q` g w x y z + +andP = liftP2 (&&) +orP = liftP2 (||) hunk ./examples/ch09/BetterPredicate.hs 115 -andP :: InfoP Bool -> InfoP Bool -> InfoP Bool -andP f g w x y z = f w x y z && g w x y z +{-- snippet constP --} +constP :: a -> InfoP a +constP k _ _ _ _ = k + +liftPK' q f k w x y z = f w x y z `q` constP k w x y z +{-- /snippet constP --} + +{-- snippet myTest2 --} +liftPath :: (FilePath -> a) -> InfoP a +liftPath f w _ _ _ = f w + +myTest2 = (liftPath takeExtension `equalP` ".cpp") `andP` + (sizeP `greaterP` 1024) +{-- /snippet myTest2 --} + +{-- snippet myTest3 --} +(==?) = equalP +(&&?) = andP +(>?) = greaterP + +myTest3 = (liftPath takeExtension ==? ".cpp") &&? (sizeP >? 1024) +-- +{-- /snippet myTest3 --} + +{-- snippet myTest4 --} +infix 4 ==? +infixr 3 &&? +infix 4 >? + +myTest4 = liftPath takeExtension ==? ".cpp" &&? sizeP >? 1024 +{-- /snippet myTest4 --} addfile ./examples/ch09/ControlledVisit.hs hunk ./examples/ch09/ControlledVisit.hs 1 +import Control.Monad (filterM, forM, liftM) +import Data.List (partition) +import Data.Maybe (isJust) +import System.Directory (Permissions(..), getDirectoryContents, + getModificationTime, getPermissions) +import System.Time (ClockTime(..)) +import System.FilePath (takeExtension, ()) +import Control.Exception (bracket, handle) +import System.IO (IOMode(..), hClose, hFileSize, openFile) + +{-- snippet Info --} +data Info = Info { + infoPath :: FilePath + , infoPerms :: Maybe Permissions + , infoSize :: Maybe Integer + , infoModTime :: Maybe ClockTime + } deriving (Eq, Ord, Show) + +getInfo :: FilePath -> IO Info +{-- /snippet Info --} + +{-- snippet getInfo --} +maybeIO :: IO a -> IO (Maybe a) +maybeIO act = handle (const (return Nothing)) (Just `liftM` act) + +getInfo path = do + perms <- maybeIO (getPermissions path) + size <- maybeIO (bracket (openFile path ReadMode) hClose hFileSize) + modified <- maybeIO (getModificationTime path) + return (Info path perms size modified) +{-- /snippet getInfo --} + +{-- snippet traverse.type --} +traverse :: ([Info] -> [Info]) -> FilePath -> IO [Info] +{-- /snippet traverse.type --} +{-- snippet traverse --} +traverse order path = do + names <- getDirectoryContents path + let usefulNames = filter (not . (`elem` [".", ".."])) names + contents <- mapM (getInfo . (path )) ("" : usefulNames) + liftM concat $ forM (order contents) $ \info -> do + if isDirectory info && infoPath info /= path + then traverse order (infoPath info) + else return [info] + where isDirectory = maybe False searchable . infoPerms +{-- /snippet traverse --} + +{-- snippet traverseVerbose --} +traverseVerbose order path = do + names <- getDirectoryContents path + let usefulNames = filter (not . (`elem` [".", ".."])) names + contents <- mapM getEntryName ("" : usefulNames) + recursiveContents <- mapM recurse (order contents) + return (concat recursiveContents) + where getEntryName name = getInfo (path name) + isDirectory info = case infoPerms info of + Nothing -> False + Just perms -> searchable perms + recurse info = do + if isDirectory info && infoPath info /= path + then traverseVerbose order (infoPath info) + else return [info] +{-- /snippet traverseVerbose --} hunk ./examples/ch09/betterpredicate.ghci 7 +--# fixities + +:info == +:info && +:info > + }