Round tripping balls

Unifying a JSON Printer/Parser with partial isomorphisms

Transcript

1. Round-Tripping Balls Building A Bi-Directional Printer/Parser 1 / 46
2. Introducing: Enterprise JSON 2 / 46
3. Introducing: Enterprise JSON “datetime” "27/6/2013 10:29 pm" 2 / 46
4. Introducing: Enterprise JSON “datetime” "27/6/2013 10:29 pm" “date” "12/12/2012" 2 / 46
5. Introducing: Enterprise JSON “datetime” "27/6/2013 10:29 pm" “date” "12/12/2012" “mmdddate” "12/12" 2 / 46
6. Introducing: Enterprise JSON “datetime” "27/6/2013 10:29 pm" “date” "12/12/2012" “mmdddate” "12/12" “mmyydate” "12/2012" 2 / 46
7. Introducing: Enterprise JSON “datetime” "27/6/2013 10:29 pm" “date” "12/12/2012" “mmdddate” "12/12" “mmyydate” "12/2012" "12.2012" 2 / 46
8. Introducing: Enterprise JSON “datetime” "27/6/2013 10:29 pm" “date” "12/12/2012" “mmdddate” "12/12" “mmyydate” "12/2012" "12.2012" "122012" 2 / 46
9. Introducing: Enterprise JSON “checkbox” "T" 3 / 46
10. Introducing: Enterprise JSON “checkbox” "T" “currency”, “currency2” and “poscurrency” "00.03" 3 / 46
11. Introducing: Enterprise JSON “checkbox” "T" “currency”, “currency2” and “poscurrency” "00.03" “posfloat”, “nonnegfloat” "2.718281828459045" 3 / 46
12. Introducing: Enterprise JSON Figure 1:Concern for sanity 4 / 46
13. A wild paper appears! 5 / 46
14. Given a datatype: data List a = Nil | Cons a (List a) 6 / 46
15. We define a Printer1 “combinator” type Printer a = a -> Doc printMany :: Printer a -> Printer (List a) printMany p list = case list of Nil -> text "" Cons x xs -> p x <> printMany p xs 7 / 46
16. And a Parser2 “combinator” newtype Parser a = Parser (String -> [(a, String)]) parseMany :: Parser a -> Parser (List a) parseMany p = const Nil <$> text "" <|> Cons <$> p <*> parseMany p 8 / 46
17. It would be nice if. . . combined :: Unicorn x => x a -> x (List a) combined p = magic Nil <$> fairies "" <|> Cons <$> p <*> parseMany p 9 / 46
18. co/contravariance newtype Parser a = Parser (String -> [(a, String)]) (<$>) :: (a -> b) -> Parser a -> Parser b f <$> Parser p = Parser $ (fmap . first) f . p 10 / 46
19. co/contravariance newtype Parser a = Parser (String -> [(a, String)]) (<$>) :: (a -> b) -> Parser a -> Parser b f <$> Parser p = Parser $ (fmap . first) f . p type Printer a = a -> Doc (<$>) :: (a -> b) -> Printer a -> Printer b 10 / 46
20. co/contravariance newtype Parser a = Parser (String -> [(a, String)]) (<$>) :: (a -> b) -> Parser a -> Parser b f <$> Parser p = Parser $ (fmap . first) f . p type Printer a = a -> Doc (<$>) :: (a -> b) -> Printer a -> Printer b Can you implement this? 10 / 46
21. co/contravariance Covariant newtype Parser a = Parser (String -> [(a, String)]) (<$>) :: (a -> b) -> Parser a -> Parser b type Printer a = a -> Doc (<$>) :: (b -> a) -> Printer a -> Printer b Contravariant 11 / 46
22. The solution: Partial Isomorphisms3 data Iso a b = Iso { apply :: a -> Maybe b , unapply :: b -> Maybe a } 12 / 46
23. The solution: IsoFunctor4 class Functor f where (<$>) :: (a -> b) -> f a -> f b 13 / 46
24. The solution: IsoFunctor4 class Functor f where (<$>) :: (a -> b) -> f a -> f b class IsoFunctor f where (<$>) :: Iso a b -> f a -> f b 13 / 46
25. The important things about partial isos Unifying a functor requires both a → b and b → a 14 / 46
26. The important things about partial isos Unifying a functor requires both a → b and b → a We unify both with a partial Iso, where these functions can fail 14 / 46
27. The important things about partial isos Unifying a functor requires both a → b and b → a We unify both with a partial Iso, where these functions can fail We defined IsoFunctor (from partial isos to printer/parsers) 14 / 46
28. Applicative class Applicative where (<*>) :: f (a -> b) -> f a -> f b 15 / 46
29. Applicative class Applicative where (<*>) :: f (a -> b) -> f a -> f b class UnhelpfulIsoApplicative where (<*>) :: f (Iso a b) -> f a -> f b 15 / 46
30. Applicative class Applicative where (<*>) :: f (a -> b) -> f a -> f b class UnhelpfulIsoApplicative where (<*>) :: f (Iso a b) -> f a -> f b type Printer a = a -> Doc instance UnhelpfulIsoApplicative Printer where (<*>) :: (Iso a b -> Doc) -> (a -> Doc) -> b -> Doc (f <*> g) b = error "how do I shot web?" 15 / 46
31. Applicative class Functor f => Applicative f where (<*>) :: f (a -> b) -> f a -> f b 16 / 46
32. Applicative class Functor f => Applicative f where (<*>) :: f (a -> b) -> f a -> f b class ProductFunctor f where infixr 6 <*> (<*>) :: f a -> f b -> f (a, b) 16 / 46
33. Applicative class Functor f => Applicative f where (<*>) :: f (a -> b) -> f a -> f b class ProductFunctor f where infixr 6 <*> (<*>) :: f a -> f b -> f (a, b) instance ProductFunctor Printer where Printer p <*> Printer q = Printer $ \(x, y) -> liftM2 (++) (p x) (q y) 16 / 46
34. Tuple trees for our data types nil :: Iso () (List a) cons :: Iso (a, List a) (List a) 17 / 46
35. Tuple trees for our data types nil :: Iso () (List a) cons :: Iso (a, List a) (List a) data List a = Nil | Cons a (List a) defineIsomorphisms List 17 / 46
36. The important things: ProductFunctor 18 / 46
37. The important things: ProductFunctor Naively adapting Applicative leaves us with an uninhabitable type. 18 / 46
38. The important things: ProductFunctor Naively adapting Applicative leaves us with an uninhabitable type. We use ProductFunctor, it has tuples instead of currying and associates right 18 / 46
39. The important things: ProductFunctor Naively adapting Applicative leaves us with an uninhabitable type. We use ProductFunctor, it has tuples instead of currying and associates right <*> mushes tuples together one way, and takes them apart the other 18 / 46
40. Almost done, Alternative6 is trivial class Alternative where (<|>) :: f a -> f a -> f a 19 / 46
41. We now have an abstract Syntax7 class (IsoFunctor s, ProductFunctor s, Alternative s) => Syntax s where pure :: Eq a => a -> s a 20 / 46
42. Invertible Syntax Descriptions: the punchline parseMany :: Parser a -> Parser (List a) parseMany p = const Nil <$> text "" <|> Cons <$> p printMany :: (a -> Doc) -> (List a -> Doc) printMany p list = case list of Nil -> text "" Cons x xs -> p x <> printMany p xs 21 / 46
43. Invertible Syntax Descriptions: the punchline many :: Syntax s => s a -> s (List a) many p = nil <$> pure () <|> cons <$> p <*> many p 22 / 46
44. Invertible Syntax Descriptions: summary 23 / 46
45. Invertible Syntax Descriptions: summary Partial isos: composable building blocks for munging data 23 / 46
46. Invertible Syntax Descriptions: summary Partial isos: composable building blocks for munging data IsoFunctor: to “lift” theses isos into concrete printers or parsers 23 / 46
47. Invertible Syntax Descriptions: summary Partial isos: composable building blocks for munging data IsoFunctor: to “lift” theses isos into concrete printers or parsers ProductFunctor: to handle multiple fields and sequencing via tuples 23 / 46
48. Invertible Syntax Descriptions: summary Partial isos: composable building blocks for munging data IsoFunctor: to “lift” theses isos into concrete printers or parsers ProductFunctor: to handle multiple fields and sequencing via tuples Syntax: to glue all these constraints together and add pure 23 / 46
49. Let’s try it on enterprise JSON! Figure 2:We are now enterprise developers 24 / 46
50. JsonBuilder/Parser IsoFunctor, simple! newtype JsonBuilder a = JsonBuilder { runBuilder :: a -> Maybe Value } newtype JsonParser a = JsonParser { runParser :: Value -> Maybe a } instance IsoFunctor JsonBuilder where (<$>) :: Iso a b -> JsonBuilder a -> JsonBuilder b i <$> JsonBuilder b = JsonBuilder $ unapply i >=> b instance IsoFunctor JsonParser where (<$>) :: Iso a b -> JsonParser a -> JsonParser b i <$> JsonParser p = JsonParser $ apply i <=< p 25 / 46
51. JsonBuilder ProductFunctor: Mush tuples together instance ProductFunctor JsonBuilder where (<*>) :: JsonBuilder a -> JsonBuilder b -> JsonBuilder (a JsonBuilder p <*> JsonBuilder q = JsonBuilder $ \(a,b) -> do a <- p a b <- q b merge a b where merge (Object a) (Object b) = Just . Object $ a union b merge a (Array b) = Just . Array $ V.cons a b merge x Null = Just x merge Null x = Just x merge _ _ = Nothing 26 / 46
52. JsonParser ProductFunctor: Tuple the things instance ProductFunctor JsonParser where (<*>) :: JsonParser a -> JsonParser b -> JsonParser (a,b) JsonParser p <*> JsonParser q = JsonParser $ \v -> do let (a,b) | Array x <- v, Just y <- x !? 0 = (y, Array $ V.tail x) | Array _ <- v = (Null, Null) | otherwise = (v,v) liftM2 (,) (p a) (q b) 27 / 46
53. Alternative: Try one, then the other instance Alternative JsonBuilder where (<||>) :: JsonBuilder a -> JsonBuilder a -> JsonBuilder a JsonBuilder p <||> JsonBuilder q = JsonBuilder $ \a -> p a mplus q a instance Alternative JsonParser where (<||>) :: JsonParser a -> JsonParser a -> JsonParser a JsonParser p <||> JsonParser q = JsonParser $ \v -> p v mplus q v 28 / 46
54. Two primitives for all your JSON needs: class Syntax s => JsonSyntax s where runSub :: s v -> s Value -> s v value :: s Value 29 / 46
55. Providing access to Values instance JsonSyntax JsonBuilder where value = JsonBuilder Just runSub (JsonBuilder a) (JsonBuilder b) = JsonBuilder $ a >=> b instance JsonSyntax JsonParser where value = JsonParser Just runSub (JsonParser a) (JsonParser b) = JsonParser $ a <=< b 30 / 46
56. From prisms to isos The lens-aeson package provides code for most of the JSON manipulation we want, but it has these terrifying Prism things: type Prism s t a b = (Choice p, Applicative f) => p a (f b) -> p s (f t) type Prism s a = Prism s s a a 31 / 46
57. From prisms to isos The lens-aeson package provides code for most of the JSON manipulation we want, but it has these terrifying Prism things: type Prism s t a b = (Choice p, Applicative f) => p a (f b) -> p s (f t) type Prism s a = Prism s s a a preview :: Prism a b -> a -> Maybe b review :: Prism a b -> b -> a 31 / 46
58. Prisms/isos are “stronger” than partial isos demote :: Prism a b -> Iso a b demote p = unsafeMakeIso (preview p) (review (_Just . p)) 32 / 46
59. Using prisms to build JsonSyntax helpers _Bool :: Prism Value Bool 33 / 46
60. Using prisms to build JsonSyntax helpers _Bool :: Prism Value Bool demote _Bool :: Iso Value Bool value :: Syntax s => s Value 33 / 46
61. Using prisms to build JsonSyntax helpers _Bool :: Prism Value Bool demote _Bool :: Iso Value Bool value :: Syntax s => s Value (<$>) :: Iso Value Bool -> s Value -> s Bool jsonBool :: JsonSyntax s => s Bool jsonBool = demote _Bool <$> value 33 / 46
62. Using prisms to build JsonSyntax helpers _Bool :: Prism Value Bool demote _Bool :: Iso Value Bool value :: Syntax s => s Value (<$>) :: Iso Value Bool -> s Value -> s Bool jsonBool :: JsonSyntax s => s Bool jsonBool = demote _Bool <$> value jsonNumber :: JsonSyntax s => s Scientific jsonNumber = demote _Number <$> value jsonString :: JsonSyntax s => s Text jsonString = demote _String <$> value 33 / 46
63. Looking up keys in objects runSub :: s v -> s Value -> s v jsonField :: JsonSyntax s => Text --^ Key to look up -> s v --^ Sub printer/parser to run on that key -> s v jsonField k sub = runSub sub (keyIso <$> value) where keyIso = demote $ prism (\x -> Object [(k,x)]) (^? key k) 34 / 46
64. When you want to ensure something is there is :: (JsonSyntax s, Eq a) => s a -> a -> s () is s a = demote (prism (const a) (guard . (a ==))) <$> s 35 / 46
65. JsonSyntax summary 36 / 46
66. JsonSyntax summary JsonSyntax: to provide access to the underlying domain specific data 36 / 46
67. JsonSyntax summary JsonSyntax: to provide access to the underlying domain specific data Prisms are stronger than partial isos 36 / 46
68. JsonSyntax summary JsonSyntax: to provide access to the underlying domain specific data Prisms are stronger than partial isos lens-aeson made it easy to define JSON combinators 36 / 46
69. Example - Round-tripping balls Figure 3:A happy ball 37 / 46
70. We can have either bouncy or lumpy balls data Ball = Lumpy { _colour :: Text , _lumps :: [[Bool]] } | Bouncy { _bouncyness :: Double } deriving (Eq, Show) 38 / 46
71. Bouncy balls are happy, lumpy ones are not. [ Lumpy {_colour = "Rainbow" , _lumps = [[True,False],[False,False]]} , Bouncy {_bouncyness = 3.141592653589793}] [{ "colour" : "Rainbow", ":D" : false, "lumps" : [[true,false],[false,false]] },{ "bouncyness" : 3.14159265358979, ":D" : true }] 39 / 46
72. Ball syntax ballSyntax :: JsonSyntax s => s Ball ballSyntax = lumpy <$> jsonField ":D" (jsonBool is False) *> jsonField "colour" jsonString <*> jsonField "lumps" (many $ many jsonBool) <|> bouncy <$> jsonField ":D" (jsonBool is True) *> jsonField "bouncyness" jsonRealFloat 40 / 46
73. The test main :: IO () main = do let tony = Lumpy "Rainbow" [[True, False], [False, False]] let oscar = Bouncy pi let pit = [tony, oscar] let Just blob = runBuilder (many ballSyntax) pit L.putStrLn $ encode blob let Just pit = runParser (many ballSyntax) blob print pit print $ pit == pit 41 / 46
74. Output (whitespace added) [ { "colour" : "Rainbow", ":D" : false, "lumps" : [[true,false],[false,false]] }, { "bouncyness" : 3.14159265358979, ":D" : true } ] [ Lumpy "Rainbow" [[True,False],[False,False]] , Bouncy 3.141592653589793 ] True 42 / 46
75. Real world example (currency) -- | Parse an enterprise currency field, which is a -- blob of text looking like: -- -- "00.43" currency :: JsonSyntax s => s Scientific currency = demoteLR "currency" (prism f g) <$> value where f = String . LT.toStrict . LT.toLazyText . fmt g = readMaybe . ST.unpack . ST.filter (not . isSpace) <=< preview _String -- We render with arbitrary precision (Nothing) -- and standard decimal notation (Fixed) fmt = LT.formatScientificBuilder Fixed Nothing 43 / 46
76. Real world example (datetime) -- | Parse an enterprise datetime field, looks like: -- -- "20/6/2014 4:25 pm" datetime :: JsonSyntax s => s UTCTime datetime = demoteLR "datetime" (prism f g) <$> value where f = String . ST.pack . opts formatTime g = opts parseTime . ST.unpack <=< preview _String opts h = h defaultTimeLocale "%-d/%-m/%Y %-l:%M %P" 44 / 46
77. Summary/Conclusion Problem: writing round-trip printer/parsers in two seperate passes can be redundant and error prone. 45 / 46
78. Summary/Conclusion Problem: writing round-trip printer/parsers in two seperate passes can be redundant and error prone. A reasonable middle ground is detailed in the paper by Tillmann Rendel and Klaus Ostermann. Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing. 45 / 46
79. Summary/Conclusion Problem: writing round-trip printer/parsers in two seperate passes can be redundant and error prone. A reasonable middle ground is detailed in the paper by Tillmann Rendel and Klaus Ostermann. Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing. It’s quite straight-forward to implement a simple unified Printer/Parser 45 / 46
80. Summary/Conclusion Problem: writing round-trip printer/parsers in two seperate passes can be redundant and error prone. A reasonable middle ground is detailed in the paper by Tillmann Rendel and Klaus Ostermann. Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing. It’s quite straight-forward to implement a simple unified Printer/Parser Existing implementations of this general idea are still relatively immature. 45 / 46
81. Summary/Conclusion Problem: writing round-trip printer/parsers in two seperate passes can be redundant and error prone. A reasonable middle ground is detailed in the paper by Tillmann Rendel and Klaus Ostermann. Invertible Syntax Descriptions: Unifying Parsing and Pretty Printing. It’s quite straight-forward to implement a simple unified Printer/Parser Existing implementations of this general idea are still relatively immature. People do seem to be interested in and working on this 45 / 46
82. A note on categories and type classes import qualified Control.Categorical.Functor as CF type Hask = (->) instance CF.Functor JsonBuilder Iso Hask where fmap iso (JsonBuilder f) = JsonBuilder (unapply iso >=> f) 46 / 46