6
\$\begingroup\$

I need a way to build up a sort of stack of places to search for an item.

What I would like to do is to have each layer searched for an item, and if it is found at that level, then it should be loaded by each higher level (successively).

What I have so far is just a basic framework, but I was wondering if I was missing some more apt abstraction here in terms of command flow. Does anyone have any suggestions?

type Result = String
type Query = String
type Search = Query -> Maybe Result
type Load = Result -> Maybe Result

data LoadFunc = LoadFunc { 
  search :: Search, 
  load :: Load }

data RunFunc = RunFunc { runner :: [RunFunc] -> Maybe Result }

mkRunFunc :: Query -> LoadFunc -> RunFunc
mkRunFunc q lf = RunFunc r
  where r (x:xs) = 
          case search lf q of
            Nothing -> runner x xs >>= load lf
            a       -> a
        r []    = search lf q

inMem :: LoadFunc
inMem = LoadFunc { search = search, load = load }
  where search q = if q == "hi" then return $ "Found in mem." else Nothing 
        load = addToLog "Loaded to mem."

renDisk :: LoadFunc
renDisk = LoadFunc { search = search, load = load }
  where search q = if q == "foo" then return $ "Found rendered." else Nothing
        load = addToLog "Added rendered."

onDisk :: LoadFunc
onDisk = LoadFunc { search = search, load = load }
  where search q = if q == "bar" then return $ "Found on disk." else Nothing
        load = addToLog "Now on disk."

addToLog :: Result -> Result -> Maybe Result
addToLog next str = return $ str ++ (' ':next)

tester :: [LoadFunc] -> Query -> Maybe Result
tester caches q = runner first rem
  where caches' = mk `fmap` caches
        first   = head caches'
        rem     = tail caches'
        mk      = mkRunFunc q

To see this in action, it should be sufficient to load up ghci and enter:

tester "bar" [inMem,renDisk,onDisk]
\$\endgroup\$

1 Answer 1

4
\$\begingroup\$

How about making inMem & co "bracket" functions? Like follows:

import Control.Monad.Writer

type M a = Writer String a
type LoadFunc a b = (a -> M b) -> a -> M b

type Query = String
type Result = ()

inMem :: LoadFunc Query Result
inMem _ "hi" = tell "Found in mem. "
inMem f q    = f q >> tell "Added to mem. "

renDisk :: LoadFunc Query Result
renDisk _ "foo" = tell "Found rendered. "
renDisk f q     = f q >> tell "Added rendered. "

onDisk :: LoadFunc Query Result
onDisk _ "bar" = tell "Found on disk. "
onDisk f q     = f q >> tell "Now on disk. "

tester :: [LoadFunc Query Result] -> Query -> M Result
tester = foldr ($) notFound
  where notFound q = tell "Not found!"

Run using runWriter $ tester [inMem,renDisk,onDisk] "bar"

This should give you the control flow you seek - as well as enough room for extension by replacing the monad as required. You could for example have notFound throw an exception using an Error monad instead (which would probably make sense).

\$\endgroup\$
1
  • \$\begingroup\$ That's an interesting idea, I like the idea of using the pattern matcher to determine a match, although I'd need more than just a writer, as I'd need to be doing some IO in there. At any rate, +1 @Peter :). \$\endgroup\$
    – Khanzor
    Commented Dec 20, 2011 at 20:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.