Modellieren Sie ein serielles Format im Typsystem, wie zB Servant

Question

Ich arbeite an einer API-Integration, die die Existenz von XML oder JSON zugunsten des Anhängens von Zeichendaten ignoriert. (Das Metro2 Format, wenn Interesse besteht)

Ich vereinfacht, aber vorstellen, dass eine Person wie diese serialisiert werden muss:

• Bei pos 0, 4 Zeichen: Anzahl der Bytes in der Nachricht
• an Pos 5: 6 Zeichen: "PERSON" Fest
• an Pos codiert 11: 20 Zeichen: Name, linksbündig und platz gepolsterte
• an Pos 21: 8 Zeichen: Geburtstag, YYYYMMDD
• Bei Position 29: 3 Zeichen: Alter, rechtsbündig und null-gepolstert

Numerische Felder sind immer rechtsbündig ausgerichtet und nullgefüllt. Textfelder sind immer linksbündig und Leerzeichen aufgefüllt.

Zum Beispiel:

"0032PERSONDAVID WILCOX  19820711035" 

Kann ich drücke dies in der Art System? Wie funktioniert das? servant? Etwas wie das?

newtype ByteLength = ByteLength Int 
newtype Age = Age Int 
-- etc 

type PersonMessage 
    = Field ByteLength '0 
    :| Field "PERSON" '5 
    :| Field Name '11 
    :| Field Date '21 
    :| Field Age '29 

-- :| is a theoretical type operator, like :> in servant 
-- the number is the expected offset 
-- the length of the field is implicit in the type 

Kann ich statisch überprüfen, ob meine Implementierung der Serialisierung mit dem Typ übereinstimmt?

Kann ich statisch prüfen, ob der Offset des 3. Feldes (Name) 11 ist? Dass sich die Längen der vorhergehenden Felder zu 11 addieren? Ich nehme an, nein, da es scheint, dass es vollständige abhängige Artunterstützung benötigen würde.

Ist das auf dem richtigen Weg?

instance ToMetro Age where 
    -- get the length into the type system using a type family? 
    field = Numeric '3 

    -- express how this is encoded. Would need to use the length from the type family. Or if that doesn't work, put it in the constructor. 
    toMetro age = Numeric age 

Update: Beispiel einer Funktion würde ich statisch gerne bestätigen:

personToMetro :: Person -> PersonMessage 
personToMetro p = error "Make sure that what I return is a PersonMessage" 

Answer 1

Nur du Inspiration zu geben, tun nur, was Servant tut und haben unterschiedliche Typen für die verschiedenen combinators Sie Unterstützung:

{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators, ScopedTypeVariables #-} 

module Seriavant where 

import GHC.TypeLits 
import Data.Proxy 
import Data.List (stripPrefix) 

data Skip (n :: Nat) = Skip deriving Show 
data Token (n :: Nat) = Token String deriving Show 
data Lit (s :: Symbol) = Lit deriving Show 

data (:>>) a b = a :>> b deriving Show 
infixr :>> 

class Deserialize a where 
    deserialize :: String -> Maybe (a, String) 

instance (KnownNat n) => Deserialize (Skip n) where 
    deserialize s = do 
     (_, s') <- trySplit (natVal (Proxy :: Proxy n)) s 
     return (Skip, s') 

instance (KnownNat n) => Deserialize (Token n) where 
    deserialize s = do 
     (t, s') <- trySplit (natVal (Proxy :: Proxy n)) s 
     return (Token t, s') 

instance (KnownSymbol lit) => Deserialize (Lit lit) where 
    deserialize s = do 
     s' <- stripPrefix (symbolVal (Proxy :: Proxy lit)) s 
     return (Lit, s') 

instance (Deserialize a, Deserialize b) => Deserialize (a :>> b) where 
    deserialize s = do 
     (x, s') <- deserialize s 
     (y, s'') <- deserialize s' 
     return (x :>> y, s'') 

trySplit :: Integer -> [a] -> Maybe ([a], [a]) 
trySplit 0 xs = return ([], xs) 
trySplit n (x:xs) = do 
    (xs', ys) <- trySplit (n-1) xs 
    return (x:xs', ys) 
trySplit _ _ = Nothing 

Ja, so ist dies recht spartanisch, aber es ermöglicht Ihnen bereits

zu tun

type MyFormat = Token 4 :>> Lit "PERSON" :>> Skip 1 :>> Token 4 

testDeserialize :: String -> Maybe MyFormat 
testDeserialize = fmap fst . deserialize 

die wie folgt funktioniert:

*Seriavant> testDeserialize "1" 
Nothing 
*Seriavant> testDeserialize "1234PERSON Foo " 
Just (Token "1234" :>> (Lit :>> (Skip :>> Token "Foo "))) 

EDIT: Es stellte sich heraus, dass ich völlig die Frage falsch verstanden, und Sean ist für die Serialisierung zu fragen, nicht Deserialisierung ... Aber natürlich haben wir kann das auch tun:

class Serialize a where 
    serialize :: a -> String 

instance (KnownNat n) => Serialize (Skip n) where 
    serialize Skip = replicate (fromIntegral $ natVal (Proxy :: Proxy n)) ' ' 

instance (KnownNat n) => Serialize (Token n) where 
    serialize (Token t) = pad (fromIntegral $ natVal (Proxy :: Proxy n)) ' ' t 

instance (KnownSymbol lit) => Serialize (Lit lit) where 
    serialize Lit = symbolVal (Proxy :: Proxy lit) 

instance (Serialize a, Serialize b) => Serialize (a :>> b) where 
    serialize (x :>> y) = serialize x ++ serialize y 

pad :: Int -> a -> [a] -> [a] 
pad 0 _x0 xs = xs 
pad n x0 (x:xs) = x : pad (n-1) x0 xs 
pad n x0 [] = replicate n x0 

(natürlich hat das schreckliche Leistung wi th all diese String Verkettung usw.aber das ist nicht der Punkt hier)

*Seriavant> serialize ((Token "1234" :: Token 4) :>> (Lit :: Lit "FOO") :>> (Skip :: Skip 2) :>> (Token "Bar" :: Token 10)) 
"1234FOO Bar  " 

Natürlich, wenn wir das Format kennen, können wir die lästigen Typenannotationen vermeiden:

type MyFormat = Token 4 :>> Lit "PERSON" :>> Skip 1 :>> Token 4 

testSerialize :: MyFormat -> String 
testSerialize = serialize 

*Seriavant> testSerialize (Token "1234" :>> Lit :>> Skip :>> Token "Bar") 
"1234PERSON Bar "