Once I tried to implement TigerHash in Haskell. Pure implementation was very slow no matter how did I tried to optimize it and I switched to foreign implementation in C. As most of hash function it need to store intermediate state between calls to update to process long streams. So interface in haskell consist of init/reset/update/finalize. But implementing only tigerHash function means that it will create and destroy context at each call. To avoid that I thought that I can make tigerHashList which will hold context while processing the list.
That was pretty easy to use that tigerHashList when you have to just mapM_ print (tigerHashList $ map getContents files) or something like that. But when you will need to calculate something complicated which the way to use that function isn't so straight. For example:
out = tigerHashList (inp out)
inp ~(nextHash:ys) = nextFile : walk nextHash files ys
And there you have two choices: to make tigerHashMonad or to wrap that tigerHashList.
As I did used "list processors" several times before:
newtype LPMonad a b c = LPMonad { unLPMonad :: [b] -> ([a] -> [a], c, [b]) }
runLPMonad :: LPMonad a b c -> ([a] -> [b]) -> c
runLPMonad m f = r where
(inp, r, _) = unLPMonad m out
out = f (inp [])
request :: a -> LPMonad a b b
request x = LPMonad (\ ~(y:ys) -> ((x:), y, ys) )
instance Monad (LPMonad a b) where
return z = LPMonad (\ ys -> (id, z, ys))
m >>= f = LPMonad next where
next ys = (inp . inp', r', ys'') where
(inp, r, ys') = unLPMonad m ys
(inp', r', ys'') = unLPMonad (f r) ys'
data Action = Withdraw Int
| Deposit Int
| Receipt
| Balance Int
account :: Int -> [Action] -> [Int]
account balance (Withdraw amount : xs) = balance' : account balance' xs where balance' = balance - amount
account balance (Deposit amount : xs) = balance' : account balance' xs where balance' = balance + amount
account balance (Receipt : xs) = balance : account balance xs
account balance (Balance amount : xs) = (amount - balance) : account balance xs
test1 = do
request $ Deposit 200
request $ Withdraw 50
x <- request Receipt
request $ Withdraw 50
y <- request $ Balance 100
return (x,y)
{-
tth = tree . splitBlocks 1024 where
tree xs = runLPMonad (getHash 0 (length xs)) tigerHashList where
getHash n 1 = request (xs !! n)
getHash n m = do
let l = m `div` 2
a <- getHash n l
b <- getHash (n+l) (m-l)
request . runPut $ do
putWord8 1
put a
put b
-}
main = do
print (runLPMonad test1 (account 1))
P.S. simplified example from Curry's (MCC) Ports library.
