Friday, September 07, 2012

Parselets :: safe, single expression parser/pretty-printer serializer/deserializer



I want to express  the parse and pretty-print of a data structure with a single, declarative expression. I also want to make the syntax general enough to adapt to any serialization/deserialization format, binary or textual, and for any string format.

The first is done. I used the idea of Formlets and applied it to parse-print. This is the resulting expression for an  example datatype:

data P = I {getInt :: Int} | S {getString :: String} deriving (Show)

This is the instance of  Parselet for P to parse/print from/to Strings (see the class definition below)  :

instance ParseLet P String where
    parse mpx  =   I <$> (str "I" *> pString (sel getInt mpx ))
              <|>  S <$> (str "S" *> pString (sel getString mpx ))

The single expression produces the text serialization and deserialization:

main =  do
   putStrLn . serial $ S "hi"
   print (deserial "I 2" :: Maybe P )


This is the output:

e>runghc demos\parselets.hs
S {getString="hi"}
Just (I 2)


To do this,I  coded some applicative instance that wraps both a non monadic parser and a non-monadic serializer. I also found a way to express  conditional serialization as an Alternative expression within an Applicative expression (sel), so that it mimic the shape of an applicative parser expression


Because there is a single expression for serialization and deserializartion,  it can be guaranteed  that the first will produce a result that will be read without errors by the second:

This is the complete source of parselets.hs:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
{-# LANGUAGE
             ScopedTypeVariables
             ,TypeSynonymInstances
             ,FlexibleInstances
             ,MultiParamTypeClasses

          #-}

import Control.Applicative
import Data.Monoid
import System.IO.Unsafe
import Control.Exception  as CE
import Data.List(isPrefixOf)
import Data.Maybe
import Debug.Trace
(!>)= flip trace

data RS v a= RS v  (Maybe a)

newtype RSView v a=  RSView{runRSView :: (v -> (RS v a,v))}

instance Functor (RSView v) where
  fmap f (RSView p)=RSView $  \v -> let (RS v1 x, r)= p v
                                    in (RS v1 (fmap f x),r)



instance Monoid v => Applicative( RSView v) where
  pure a  = RSView ( \v  -> (RS  mempty $ Just a,v))

  RSView f <*> RSView g= RSView ( \v  ->

                   let (RS v1 k,r)  = f v 

                       (RS v2 x,r2) = g r

                   in  (RS (mappend v1 v2) (k <*> x),r2))

instance  Monoid v => Alternative (RSView v) where

  empty= RSView $ \v -> (RS mempty Nothing, v)
  RSView f <|> RSView g= RSView ( \v  ->

                   let rs@(RS v1 k,r)  = f v 



                   in case k of
                     Just _  -> rs
                     Nothing -> g v )




class Monoid v =>  ParseLet a v where
  parse :: Maybe a -> RSView v a -- must not use pattern match

serial :: ParseLet a v => a -> v
serial x    = getSerial $ (runRSView $ parse  (Just x)) mempty
   where
   getSerial  (RS v _,_)= v

deserial :: ParseLet a v =>  v -> Maybe a
deserial str= getDeserial ( (runRSView ( parse Nothing)) str)
   where
   getDeserial (RS _ x,_)= x

sel f mpx= unsafePerformIO $
   CE.handle (\(e:: SomeException) -> return Nothing)
   $ let x= f $ fromJust mpx in x `seq` return (Just x)




pString :: (Read a, Show a)=>  Maybe a -> RSView String a
pString (Just fpx)= RSView $ \str ->  (RS (show$ fpx) (Just fpx),str)


pString Nothing  = RSView $ \str ->
          case readsPrec  1 str of
                  []      ->  (RS " " Nothing, str)
                  (x,r):_ ->  (RS " " (Just x), r)


--str :: String -> RSView String ()
str s= RSView ( \st ->
   let readit= if isPrefixOf s st then Just() else Nothing
   in (RS (s++" ") readit , drop (length s) st))



data P = I Int | S String deriving (Read, Show)

instance   ParseLet P String where
    parse mpx  =   I <$> (str "I" *> pString (sel (\(I x) -> x) mpx ))
              <|>  S <$> (str "S" *> pString (sel (\(S s) -> s) mpx ))

main =  do
   putStrLn . serial $ S "hi"
   print (deserial "I 2" :: Maybe P )


Post a Comment