[Haskell-cafe] design problem, "varying intermediate types"

[Robert Vollmert]

Dear cafe,

I’m working on a project that reads logic puzzle descriptions from yaml files and renders them using the Diagrams framework (https://github.com/robx/puzzle-draw), and am quite unsure what’s a good way of stringing things together. It’s a bit hard to even express the problem…

I’ve tried to break it down with limited success, to the following task:

1. Read YAML data like
 type: “three”
 x: 3
 y: [3, 4, 5]
Type is from a fixed (long) list of strings. This type determines the format of the fields x and y (x is required, y is optional).

2. Do something type-specific to produce output based on the parsed data. Two options, one that depends on the x field only, the second can also consult the y field.

My problem is how I should deal with these intermediate types that vary based on the input. My current approach below has parsing and printing functions, and then one big function that strings the matching parsers and printers together. I’ve also thought about using one big sum type, or type classes (Parseable, Printable, but doesn’t really seem to help).

So far, all of it has felt a bit awkward. Any suggestions for how to attack this much appreciated.

Cheers
Rob


{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Data.Yaml

type Parsers a b = (Value -> Parser a, Value -> Parser b)

parse1 :: Parsers Int Double
parse1 = (parseJSON, parseJSON)

parse2 :: Parsers String Char
parse2 = (parseJSON, parseJSON)

-- parse3 :: Parsers Int [Int]
-- ... lots more of these

type Printers a b = (a -> IO (), a -> b -> IO ())

print1 :: Printers Int Double
print1 = (print . show, \x y -> print (show y ++ "..." ++ show x))

print2 :: Printers String Char
print2 = (const $ print "hello", \x y -> print (show y))

type Composed = (Value -> Parser (IO ()), Value -> Value -> Parser (IO ()))

compose :: Parsers a b -> Printers a b -> Composed
compose (pp, ps) (rp, rs) = (\v -> rp <$> pp v, \v w -> rs <$> pp v <*> ps w)

composeType :: String -> Composed
composeType t = case t of
   "one" -> compose parse1 print1
   "two" -> compose parse2 print2
   _     -> (f, const f)
 where
   f = fail $ "unknown type: " ++ t

parseXY :: (String -> Value -> Value -> Parser a) -> Value -> Parser a
parseXY f (Object v) = do
   t <- v .: "type"
   x <- v .: "x"
   y <- v .: "y"
   f t x y

parseX :: (String -> Value -> Parser a) -> Value -> Parser a
parseX f (Object v) = do
   t <- v .: "type"
   x <- v .: "x"
   f t x

printA :: Value -> Parser (IO ())
printA = parseX (fst . composeType)

printB :: Value -> Parser (IO ())
printB = parseXY (snd . composeType)

main = do
   flagB <- return False  -- command line flag
   let p = parseEither $ if flagB then printB else printA
   mv <- decodeFile "input.yaml"
   v <- maybe (fail "failed to parse yaml") return mv
   case p v of Left  e -> fail $ "failed to parse data: " ++ e
               Right x -> x