-- read the rule data from the file named in the first argument, and the packet data from

-the file named in the second argument, and then print the accepted packets followed by

-a log generated during the computation. main :: IO ()

main = do args<- getArgs

ruleData <- readFile (args!!0) packetData <- readFile (args!!1) let rules = (read ruleData)::[Rule]

packets = (read packetData)::[Packet] (out,log) <- runWriterT (filterAll rules packets) putStrLn "ACCEPTED PACKETS" putStr (unlines (map show out)) putStrLn "\n\nFIREWALL LOG" putStr (unlines (map show log))

3.6.2.ReaderT with IO

If you found that one too easy, move on to a slightly more complex example: convert the template system in example 16 from using a single template file with named templates to treating individual files as templates. One possible solution is shown in example 23, but try to do it without looking first.

3.6.3.StateT with List

The previous examples have all been using the IO monad as the inner monad. Here is a more interesting example: combining StateT with the List monad to produce a monad for stateful nondeterministic computations.

We will apply this powerful monad combination to the task of solving constraint satisfaction problems (in this case, a logic problem). The idea behind it is to have a number of variables that can take on different values and a number of predicates involving those variables that must be satisfied. The current variable assignments and the predicates make up the state of the computation, and the non-deterministic nature of the List monad allows us to easily test all combinations of variable assignments.

We start by laying the groundwork we will need to represent the logic problem, a simple predicate language:

Code available in example24.hs

- First, we develop a language to express logic problems type Var = String type Value = String

data Predicate = Is Var Value-- var has specific value

Equal Var Var

And Predicate Predicate Or Predicate Predicate Not Predicate deriving (Eq, Show)

type Variables = [(Var,Value)]

-- test for a variable NOT equaling a value isNot :: Var -> Value -> Predicate isNot var value = Not (Is var value)

-- if a is true, then b must also be true implies :: Predicate -> Predicate -> Predicate implies a b = Not (a "And" (Not b))

-- exclusive or

orElse :: Predicate -> Predicate -> Predicate orElse a b = (a "And" (Not b)) "Or" ((Not a) "And" b)

-Check a predicate with the given variable bindings.

-An unbound variable causes a Nothing return value. check :: Predicate -> Variables -> Maybe Bool check (Is var value) vars = do val <- lookup var vars

return (val == value) check (Equal vl v2) vars = do vall <- lookup vl vars

val2 <- lookup v2 vars return (vall == val2) vars = liftM2 (&&) (check pl vars) vars = liftM2 () (check pl vars) vars = liftM (not) (check p vars)

-- vars have same (unspecified)

both are true

at least one is true

it is not true

check (And pl p2) check (Or pl p2) check (Not p)

(check p2 vars) (check p2 vars)

The next thing we will need is some code for representing and solving constraint satisfaction problems. This is where we will define our combined monad.

Code available in example24.hs

-- this is the type of our logic problem data ProblemState = PS {vars::Variables,

constraints::[Predicate]}

-- this is our monad type for non-determinstic computations with state type NDS a = StateT ProblemState [] a

-- lookup a variable

getVar :: Var -> NDS (Maybe Value)

getVar v = do vs <- gets vars

return $ lookup v vs

-- set a variable

setVar :: Var -> Value -> NDS () setVar v x = do st <- get

vs <- return $ filter ((v/=).fst) (vars st)

put $ st {vars=(v,x):vs}

-- Check if the variable assignments satisfy all of the predicates.

-- The partial argument determines the value used when a predicate returns

-- Nothing because some variable it uses is not set. Setting this to True

-- allows us to accept partial solutions, then we can use a value of

-- False at the end to signify that all solutions should be complete.

isConsistent :: Bool -> NDS Bool

isConsistent partial = do cs <- gets constraints

vs <- gets vars

let results = map (\p->check p vs) cs

return $ and (map (maybe partial id) results)

-- Return only the variable bindings that are complete consistent solutions. getFinalVars :: NDS Variables getFinalVars = do c <- isConsistent False

guard c

gets vars

-- Get the first solution to the problem, by evaluating the solver computation with

-- an initial problem state and then returning the first solution in the result list,

-- or Nothing if there was no solution. getSolution :: NDS a -> ProblemState -> Maybe a getSolution c i = listToMaybe (evalStateT c i)

-- Get a list of all possible solutions to the problem by evaluating the solver

-- computation with an initial problem state. getAllSolutions :: NDS a -> ProblemState -> [a] getAllSolutions c i = evalStateT c i

We are ready to apply the predicate language and stateful nondeterministic monad to solving a logic problem. For this example, we will use the well-known Kalotan puzzle which appeared in Mathematical Brain-Teasers, Dover Publications (1976), by J. A. H. Hunter.

The Kalotans are a tribe with a peculiar quirk: their males always tell the truth. Their females never make two consecutive true statements, or two consecutive untrue statements. An anthropologist (lets call him Worf) has begun to study them. Worf does not yet know the Kalotan language. One day, he meets a Kalotan (heterosexual) couple and their child Kibi. Worf asks Kibi: "Are you a boy? The kid answers in Kalotan, which of course Worf doesnt understand. Worf turns to the parents (who know English) for explanation. One of them says:

№ докум.

ФП 02005-03 01