
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