On 25.07.2013 09:09, [email protected] wrote:
Here is a snippet from a real code that could benefit from
non-recursive let. The example is notable because it incrementally
constructs not one but two structures (both maps), ast and headers.
The maps are constructed in a bit interleaved fashion, and stuffing
them into the same State would be ungainly. In my real code
-- Add an update record to a buffer file
do_update :: String -> Handle -> Parsed -> [Parsed] -> IO ()
do_update "TAF" h ast asts@(_:_) = do
rv <- reflect $ get_trange "TRange" ast
headers0 <- return . M.fromList =<< sequence
(map (\ (n,fld) -> reflect (fld ast) >>= \v -> return (n,v))
fields_header)
This is a mouth-full. The ">>= \v -> return (n,v)" can be more
elegantly expressed with tuple section
(map (\ (n,fld) -> (n,) <$> reflect (fld ast)) fields_header)
Maybe even use
mapSnd f = (id *** f)
and write
(map (mapSnd $ \ fld -> reflect (fld ast)) fields_header)
and, getting into lambda-killing rush :-)
(map (mapSnd $ reflect . ($ ast)) fields_header)
(ok, now we overdid it).
Also, was not mapM = sequence . map ?
And return . f =<< m the same as f <$> m? Then we are at
headers0 <- M.fromList <$> do
mapM (\ (n,fld) -> (n,) <$> reflect (fld ast)) fields_header
Actually, I prefer for-loops:
headers0 <- M.fromList <$> do
forM fields_header $ \ (n, fld) -> do
(n,) <$> reflect $ fld ast
Great satisfaction! I killed all long-ranging parentheses! ;-)
-- Andreas
let headers = M.insert "_report_ranges" (format_two_tstamps rv) headers0
foldM write_period (rv,headers,(snd rv,snd rv)) asts
return ()
where
write_period (rv,headers,mv) ast = do
pv@(p_valid_from,p_valid_until) <- reflect $ get_trange "TRange" ast
check_inside pv rv
let prevailing = M.lookup "PREVAILING" ast
(mv,pv) <- case prevailing of
Just _ -> return (pv,pv) -- set the major valid period
-- Make sure each VAR period occurs later than the prevailing
-- period. If exactly at the same time add 1 min
Nothing -> case () of
_ | fst mv < p_valid_from -> return (mv,pv)
_ | fst mv == p_valid_from -> return (mv,(p_valid_from + 60,
p_valid_until))
_ -> gthrow . InvalidData . unwords $ [
"VAR period begins before prevailing:",
show ast, "; prevailing TRange", show mv]
let token = maybe (M.findWithDefault "" "VAR" ast) id prevailing
let ast1 = M.insert "_token" token .
M.insert "_period_valid" (format_two_tstamps pv) .
M.unionWith (\_ x -> x) headers $ ast
let title = M.member "Title" ast
let headers1 = if title then headers else
M.delete "_limit_to " . M.delete "_limit_recd" $ headers
write_fields h ast1 fields
return (rv,headers1,mv)
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
--
Andreas Abel <>< Du bist der geliebte Mensch.
Theoretical Computer Science, University of Munich
Oettingenstr. 67, D-80538 Munich, GERMANY
[email protected]
http://www2.tcs.ifi.lmu.de/~abel/
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
