-- |
-- = Tutorial
--
-- This module contains a worked example of encoding and decoding messages,
-- and exporting a corresponding .proto file from Haskell types.
--
-- == Setup
--
-- If you are using "GHC.Generics", you should enable the generic deriving
-- extension, and import the main module:
--
-- > {-# LANGUAGE DeriveGeneric #-}
--
-- > import Proto3.Suite
-- > import GHC.Generics
--

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Proto3.Suite.Tutorial where

import Data.Int (Int32)
import Data.Word (Word32)
import GHC.Exts (Proxy#, proxy#)
import GHC.Generics
import Proto3.Suite (Enumerated, Nested, NestedVec, PackedVec,
                     Message, Named, Finite, DotProtoDefinition,
                     enum, message, packageFromDefs, toProtoFileDef)
import Proto3.Wire.Class (ProtoEnum)

-- $setup
-- >>> :set -XOverloadedStrings

-- |
-- == Defining Message Types
--
-- Define messages using Haskell record types. You can use any 'MessageField' types
-- in your records, and the correct serializer and deserializer will be generated
-- for you.
--
-- Make sure to derive a 'Generic' instance for your type, and then derive instances
-- for 'Message' and 'Named' using the default (empty) instances:
--
-- > instance Message Foo
-- > instance Named Foo
--
-- == Encoding Messages
--
-- Now we can encode a value of type 'Foo' using 'Proto3.Suite.toLazyByteString'.
--
-- For example:
--
-- >>> Proto3.Suite.toLazyByteString (Foo 42 (Proto3.Suite.PackedVec (pure 123)))
-- "\b*\DC2\SOH{"
--
-- We can also decode messages using `fromByteString`:
--
-- >>> Proto3.Suite.fromByteString "\b*\DC2\SOH{" :: Either Proto3.Wire.Decode.ParseError Foo
-- Right (Foo {fooX = 42, fooY = PackedVec {packedvec = [123]}})
data Foo = Foo
  { Foo -> Word32
fooX :: Word32
  , Foo -> PackedVec Int32
fooY :: PackedVec Int32
  } deriving (Int -> Foo -> ShowS
[Foo] -> ShowS
Foo -> String
(Int -> Foo -> ShowS)
-> (Foo -> String) -> ([Foo] -> ShowS) -> Show Foo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Foo] -> ShowS
$cshowList :: [Foo] -> ShowS
show :: Foo -> String
$cshow :: Foo -> String
showsPrec :: Int -> Foo -> ShowS
$cshowsPrec :: Int -> Foo -> ShowS
Show, Foo -> Foo -> Bool
(Foo -> Foo -> Bool) -> (Foo -> Foo -> Bool) -> Eq Foo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Foo -> Foo -> Bool
$c/= :: Foo -> Foo -> Bool
== :: Foo -> Foo -> Bool
$c== :: Foo -> Foo -> Bool
Eq, (forall x. Foo -> Rep Foo x)
-> (forall x. Rep Foo x -> Foo) -> Generic Foo
forall x. Rep Foo x -> Foo
forall x. Foo -> Rep Foo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Foo x -> Foo
$cfrom :: forall x. Foo -> Rep Foo x
Generic)

instance Message Foo
instance Named Foo

-- |
-- == Nested Messages
--
-- Messages can contain other messages, by using the 'Nested' constructor, and
-- lists of nested messages using the 'NestedVec constructor'.
data Bar = Bar
  { Bar -> Enumerated Shape
barShape :: Enumerated Shape
  , Bar -> Nested Foo
barFoo   :: Nested Foo
  , Bar -> NestedVec Foo
foos     :: NestedVec Foo
  }
  deriving (Bar -> Bar -> Bool
(Bar -> Bar -> Bool) -> (Bar -> Bar -> Bool) -> Eq Bar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bar -> Bar -> Bool
$c/= :: Bar -> Bar -> Bool
== :: Bar -> Bar -> Bool
$c== :: Bar -> Bar -> Bool
Eq, (forall x. Bar -> Rep Bar x)
-> (forall x. Rep Bar x -> Bar) -> Generic Bar
forall x. Rep Bar x -> Bar
forall x. Bar -> Rep Bar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bar x -> Bar
$cfrom :: forall x. Bar -> Rep Bar x
Generic)

instance Message Bar
instance Named Bar

-- |
-- == Enumerations
--
-- Enumerated types can be used by deriving the 'Bounded', 'Enum', 'ProtoEnum',
-- 'Finite', and 'Named' classes.  Each of these instances are implied by
-- a 'Generic' instance, so can be derived as follows:
--
-- > data Shape
-- >   = Circle
-- >   | Square
-- >   | Triangle
-- >   deriving (Bounded, Eq, Enum, Finite, Generic, Named, Ord, ProtoEnum)
data Shape
  = Circle
  | Square
  | Triangle
  deriving (Shape
Shape -> Shape -> Bounded Shape
forall a. a -> a -> Bounded a
maxBound :: Shape
$cmaxBound :: Shape
minBound :: Shape
$cminBound :: Shape
Bounded, Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq, Int -> Shape
Shape -> Int
Shape -> [Shape]
Shape -> Shape
Shape -> Shape -> [Shape]
Shape -> Shape -> Shape -> [Shape]
(Shape -> Shape)
-> (Shape -> Shape)
-> (Int -> Shape)
-> (Shape -> Int)
-> (Shape -> [Shape])
-> (Shape -> Shape -> [Shape])
-> (Shape -> Shape -> [Shape])
-> (Shape -> Shape -> Shape -> [Shape])
-> Enum Shape
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Shape -> Shape -> Shape -> [Shape]
$cenumFromThenTo :: Shape -> Shape -> Shape -> [Shape]
enumFromTo :: Shape -> Shape -> [Shape]
$cenumFromTo :: Shape -> Shape -> [Shape]
enumFromThen :: Shape -> Shape -> [Shape]
$cenumFromThen :: Shape -> Shape -> [Shape]
enumFrom :: Shape -> [Shape]
$cenumFrom :: Shape -> [Shape]
fromEnum :: Shape -> Int
$cfromEnum :: Shape -> Int
toEnum :: Int -> Shape
$ctoEnum :: Int -> Shape
pred :: Shape -> Shape
$cpred :: Shape -> Shape
succ :: Shape -> Shape
$csucc :: Shape -> Shape
Enum, ProtoEnum Shape
ProtoEnum Shape
-> (forall string.
    IsString string =>
    Proxy# Shape -> [(string, Int32)])
-> Finite Shape
forall string. IsString string => Proxy# Shape -> [(string, Int32)]
forall a.
ProtoEnum a
-> (forall string.
    IsString string =>
    Proxy# a -> [(string, Int32)])
-> Finite a
enumerate :: Proxy# Shape -> [(string, Int32)]
$cenumerate :: forall string. IsString string => Proxy# Shape -> [(string, Int32)]
$cp1Finite :: ProtoEnum Shape
Finite, (forall x. Shape -> Rep Shape x)
-> (forall x. Rep Shape x -> Shape) -> Generic Shape
forall x. Rep Shape x -> Shape
forall x. Shape -> Rep Shape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Shape x -> Shape
$cfrom :: forall x. Shape -> Rep Shape x
Generic, (forall string. IsString string => Proxy# Shape -> string)
-> Named Shape
forall string. IsString string => Proxy# Shape -> string
forall a.
(forall string. IsString string => Proxy# a -> string) -> Named a
nameOf :: Proxy# Shape -> string
$cnameOf :: forall string. IsString string => Proxy# Shape -> string
Named, Eq Shape
Eq Shape
-> (Shape -> Shape -> Ordering)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Shape)
-> (Shape -> Shape -> Shape)
-> Ord Shape
Shape -> Shape -> Bool
Shape -> Shape -> Ordering
Shape -> Shape -> Shape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Shape -> Shape -> Shape
$cmin :: Shape -> Shape -> Shape
max :: Shape -> Shape -> Shape
$cmax :: Shape -> Shape -> Shape
>= :: Shape -> Shape -> Bool
$c>= :: Shape -> Shape -> Bool
> :: Shape -> Shape -> Bool
$c> :: Shape -> Shape -> Bool
<= :: Shape -> Shape -> Bool
$c<= :: Shape -> Shape -> Bool
< :: Shape -> Shape -> Bool
$c< :: Shape -> Shape -> Bool
compare :: Shape -> Shape -> Ordering
$ccompare :: Shape -> Shape -> Ordering
$cp1Ord :: Eq Shape
Ord, Int32 -> Maybe Shape
Shape -> Int32
(Int32 -> Maybe Shape) -> (Shape -> Int32) -> ProtoEnum Shape
forall a. (Int32 -> Maybe a) -> (a -> Int32) -> ProtoEnum a
fromProtoEnum :: Shape -> Int32
$cfromProtoEnum :: Shape -> Int32
toProtoEnumMay :: Int32 -> Maybe Shape
$ctoProtoEnumMay :: Int32 -> Maybe Shape
ProtoEnum)

-- |
-- == Generating a .proto file
--
-- We can generate a .proto file for the 'Foo' and 'Bar' data types by
-- using the 'toProtoFileDef' function. We have to provide a package name, and
-- explicitly list the message and enumeration types as a 'DotProto' value.
--
-- >>> putStrLn protoFile
-- syntax = "proto3";
-- package examplePackageName;
-- enum Shape {
--   Circle = 0;
--   Square = 1;
--   Triangle = 2;
-- }
-- message Foo {
--   uint32 fooX = 1;
--   repeated int32 fooY = 2 [packed = true];
-- }
-- message Bar {
--   Shape barShape = 1;
--   Foo barFoo = 2;
--   repeated Foo foos = 3;
-- }

protoFile :: String
protoFile :: String
protoFile = DotProto -> String
toProtoFileDef (DotProto -> String) -> DotProto -> String
forall a b. (a -> b) -> a -> b
$ String -> [DotProtoDefinition] -> DotProto
packageFromDefs String
"examplePackageName"
  ([ Proxy# Shape -> DotProtoDefinition
forall e. (Finite e, Named e) => Proxy# e -> DotProtoDefinition
enum    (Proxy# Shape
forall k (a :: k). Proxy# a
proxy# :: Proxy# Shape)
   , Proxy# Foo -> DotProtoDefinition
forall a. (Message a, Named a) => Proxy# a -> DotProtoDefinition
message (Proxy# Foo
forall k (a :: k). Proxy# a
proxy# :: Proxy# Foo)
   , Proxy# Bar -> DotProtoDefinition
forall a. (Message a, Named a) => Proxy# a -> DotProtoDefinition
message (Proxy# Bar
forall k (a :: k). Proxy# a
proxy# :: Proxy# Bar)
   ] :: [DotProtoDefinition])