-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DefaultSignatures #-}
-- | This is a serializable subset of 'DeriveT.Val' and 'DeriveT.Environ'.
-- It omits pitches, which are code and can't be serialized.
module Derive.REnv (
    Environ
    , to_map, from_list, convert, lookup, null
    -- * val
    , Val(..)
    , ConstantPitch(..)
    , ToVal(..)
) where
import           Prelude hiding (lookup, null)
import qualified Data.Map as Map

import qualified Util.Pretty as Pretty
import qualified Util.Serialize as Serialize
import           Util.Serialize (get, put)

import qualified Derive.Attrs as Attrs
import qualified Derive.DeriveT as DeriveT
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Expr as Expr
import qualified Derive.PSignal as PSignal
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal

import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal

import qualified Ui.ScoreTime as ScoreTime

import           Global
import           Types


-- * Environ

newtype Environ = Environ (Map EnvKey.Key Val)
    deriving (Int -> Environ -> ShowS
[Environ] -> ShowS
Environ -> String
(Int -> Environ -> ShowS)
-> (Environ -> String) -> ([Environ] -> ShowS) -> Show Environ
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environ] -> ShowS
$cshowList :: [Environ] -> ShowS
show :: Environ -> String
$cshow :: Environ -> String
showsPrec :: Int -> Environ -> ShowS
$cshowsPrec :: Int -> Environ -> ShowS
Show, Environ -> Environ -> Bool
(Environ -> Environ -> Bool)
-> (Environ -> Environ -> Bool) -> Eq Environ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environ -> Environ -> Bool
$c/= :: Environ -> Environ -> Bool
== :: Environ -> Environ -> Bool
$c== :: Environ -> Environ -> Bool
Eq, NonEmpty Environ -> Environ
Environ -> Environ -> Environ
(Environ -> Environ -> Environ)
-> (NonEmpty Environ -> Environ)
-> (forall b. Integral b => b -> Environ -> Environ)
-> Semigroup Environ
forall b. Integral b => b -> Environ -> Environ
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Environ -> Environ
$cstimes :: forall b. Integral b => b -> Environ -> Environ
sconcat :: NonEmpty Environ -> Environ
$csconcat :: NonEmpty Environ -> Environ
<> :: Environ -> Environ -> Environ
$c<> :: Environ -> Environ -> Environ
Semigroup, Semigroup Environ
Environ
Semigroup Environ
-> Environ
-> (Environ -> Environ -> Environ)
-> ([Environ] -> Environ)
-> Monoid Environ
[Environ] -> Environ
Environ -> Environ -> Environ
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Environ] -> Environ
$cmconcat :: [Environ] -> Environ
mappend :: Environ -> Environ -> Environ
$cmappend :: Environ -> Environ -> Environ
mempty :: Environ
$cmempty :: Environ
Monoid, Get Environ
Putter Environ
Putter Environ -> Get Environ -> Serialize Environ
forall a. Putter a -> Get a -> Serialize a
get :: Get Environ
$cget :: Get Environ
put :: Putter Environ
$cput :: Putter Environ
Serialize.Serialize)

-- Environ keys are always Text, and it's annoying to have quotes on them.
instance Pretty Environ where
    format :: Environ -> Doc
format (Environ Map Key Val
env) = [(Doc, Doc)] -> Doc
Pretty.formatMap
        ([(Doc, Doc)] -> Doc)
-> (Map Key Val -> [(Doc, Doc)]) -> Map Key Val -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Val) -> (Doc, Doc)) -> [(Key, Val)] -> [(Doc, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Doc) -> (Val -> Doc) -> (Key, Val) -> (Doc, Doc)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Key -> Doc
Pretty.text Val -> Doc
forall a. Pretty a => a -> Doc
Pretty.format) ([(Key, Val)] -> [(Doc, Doc)])
-> (Map Key Val -> [(Key, Val)]) -> Map Key Val -> [(Doc, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Key Val -> [(Key, Val)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Key Val -> Doc) -> Map Key Val -> Doc
forall a b. (a -> b) -> a -> b
$ Map Key Val
env

to_map :: Environ -> Map EnvKey.Key Val
to_map :: Environ -> Map Key Val
to_map (Environ Map Key Val
m) = Map Key Val
m

from_list :: [(EnvKey.Key, Val)] -> Environ
from_list :: [(Key, Val)] -> Environ
from_list = Map Key Val -> Environ
Environ (Map Key Val -> Environ)
-> ([(Key, Val)] -> Map Key Val) -> [(Key, Val)] -> Environ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Val)] -> Map Key Val
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

convert :: Environ -> DeriveT.Environ
convert :: Environ -> Environ
convert (Environ Map Key Val
env) = Map Key Val -> Environ
DeriveT.Environ (Map Key Val -> Environ) -> Map Key Val -> Environ
forall a b. (a -> b) -> a -> b
$ Val -> Val
convert_val (Val -> Val) -> Map Key Val -> Map Key Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Key Val
env

lookup :: EnvKey.Key -> Environ -> Maybe Val
lookup :: Key -> Environ -> Maybe Val
lookup Key
key (Environ Map Key Val
env) = Key -> Map Key Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
key Map Key Val
env

null :: Environ -> Bool
null :: Environ -> Bool
null (Environ Map Key Val
env) = Map Key Val -> Bool
forall k a. Map k a -> Bool
Map.null Map Key Val
env

-- * val

-- | This is like 'DeriveT.Val', except missing fields that can't be
-- serialized, or require Deriver and hence couldn't go in a module below
-- Deriver without incurring a circular dependency.
--
-- Namely: 'DeriveT.VPitch', 'DeriveT.VControlFunction'.
-- NOTE [val-and-minival].
data Val =
    VNum !(ScoreT.Typed Signal.Y)
    | VAttributes !Attrs.Attributes
    | VControlRef !DeriveT.ControlRef
    | VConstantPitch !ConstantPitch
    | VNotePitch !Pitch.Pitch
    | VStr !Expr.Str
    | VQuoted !Expr
    | VList ![Val]
    deriving (Val -> Val -> Bool
(Val -> Val -> Bool) -> (Val -> Val -> Bool) -> Eq Val
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Val -> Val -> Bool
$c/= :: Val -> Val -> Bool
== :: Val -> Val -> Bool
$c== :: Val -> Val -> Bool
Eq, Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
(Int -> Val -> ShowS)
-> (Val -> String) -> ([Val] -> ShowS) -> Show Val
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Val] -> ShowS
$cshowList :: [Val] -> ShowS
show :: Val -> String
$cshow :: Val -> String
showsPrec :: Int -> Val -> ShowS
$cshowsPrec :: Int -> Val -> ShowS
Show)

convert_val :: Val -> DeriveT.Val
convert_val :: Val -> Val
convert_val Val
val = case Val
val of
    VNum Typed Y
v -> Typed Y -> Val
DeriveT.VNum Typed Y
v
    VAttributes Attributes
v -> Attributes -> Val
DeriveT.VAttributes Attributes
v
    VControlRef ControlRef
v -> ControlRef -> Val
DeriveT.VControlRef ControlRef
v
    VConstantPitch (ConstantPitch ScaleId
scale_id Note
note NoteNumber
nn) ->
        Pitch -> Val
DeriveT.VPitch (Pitch -> Val) -> Pitch -> Val
forall a b. (a -> b) -> a -> b
$ ScaleId -> Note -> NoteNumber -> Pitch
PSignal.constant_pitch ScaleId
scale_id Note
note NoteNumber
nn
    VNotePitch Pitch
v -> Pitch -> Val
DeriveT.VNotePitch Pitch
v
    VStr Str
v -> Str -> Val
DeriveT.VStr Str
v
    VQuoted Expr
v -> Quoted -> Val
DeriveT.VQuoted (Quoted -> Val) -> Quoted -> Val
forall a b. (a -> b) -> a -> b
$ Expr -> Quoted
DeriveT.Quoted (Expr -> Quoted) -> Expr -> Quoted
forall a b. (a -> b) -> a -> b
$
        (Val -> Val) -> Expr -> Expr
forall a b. (a -> b) -> Expr a -> Expr b
Expr.map_literals Val -> Val
convert_val Expr
v
    VList [Val]
v -> [Val] -> Val
DeriveT.VList ([Val] -> Val) -> [Val] -> Val
forall a b. (a -> b) -> a -> b
$ (Val -> Val) -> [Val] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Val -> Val
convert_val [Val]
v

instance Pretty Val where format :: Val -> Doc
format = Val -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (Val -> Doc) -> (Val -> Val) -> Val -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Val
convert_val

-- | This duplicates 'TrackLang.Typecheck', but then so does this whole module.
-- In any case, it's convenient for creaing 'Environ's.
--
-- TODO But I wish I could reuse Typecheck.ToVal, otherwise I have to add an
-- extra instance declaration for each type.
class ToVal a where
    to_val :: a -> Val
    default to_val :: ShowVal.ShowVal a => a -> Val
    to_val = Str -> Val
VStr (Str -> Val) -> (a -> Str) -> a -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Str
Expr.Str (Key -> Str) -> (a -> Key) -> a -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Key
forall a. ShowVal a => a -> Key
ShowVal.show_val

-- ** VNum

instance ToVal Val where to_val :: Val -> Val
to_val = Val -> Val
forall a. a -> a
id
instance ToVal Double where to_val :: Y -> Val
to_val = Typed Y -> Val
VNum (Typed Y -> Val) -> (Y -> Typed Y) -> Y -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> Typed Y
forall a. a -> Typed a
ScoreT.untyped
instance ToVal Int where to_val :: Int -> Val
to_val = Typed Y -> Val
VNum (Typed Y -> Val) -> (Int -> Typed Y) -> Int -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Y -> Typed Y
forall a. a -> Typed a
ScoreT.untyped (Y -> Typed Y) -> (Int -> Y) -> Int -> Typed Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Y
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToVal Pitch.NoteNumber where
    to_val :: NoteNumber -> Val
to_val = Typed Y -> Val
VNum (Typed Y -> Val) -> (NoteNumber -> Typed Y) -> NoteNumber -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Y -> Typed Y
forall a. Type -> a -> Typed a
ScoreT.Typed Type
ScoreT.Nn (Y -> Typed Y) -> (NoteNumber -> Y) -> NoteNumber -> Typed Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteNumber -> Y
Pitch.nn_to_double
instance ToVal Pitch.Transpose where
    to_val :: Transpose -> Val
to_val Transpose
n = case Transpose
n of
        Pitch.Diatonic Y
n -> Typed Y -> Val
VNum (Typed Y -> Val) -> Typed Y -> Val
forall a b. (a -> b) -> a -> b
$ Type -> Y -> Typed Y
forall a. Type -> a -> Typed a
ScoreT.Typed Type
ScoreT.Diatonic Y
n
        Pitch.Chromatic Y
n -> Typed Y -> Val
VNum (Typed Y -> Val) -> Typed Y -> Val
forall a b. (a -> b) -> a -> b
$ Type -> Y -> Typed Y
forall a. Type -> a -> Typed a
ScoreT.Typed Type
ScoreT.Chromatic Y
n
        Pitch.Nn Y
n -> Typed Y -> Val
VNum (Typed Y -> Val) -> Typed Y -> Val
forall a b. (a -> b) -> a -> b
$ Type -> Y -> Typed Y
forall a. Type -> a -> Typed a
ScoreT.Typed Type
ScoreT.Nn Y
n
instance ToVal ScoreTime where
    to_val :: ScoreTime -> Val
to_val = Typed Y -> Val
VNum (Typed Y -> Val) -> (ScoreTime -> Typed Y) -> ScoreTime -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Y -> Typed Y
forall a. Type -> a -> Typed a
ScoreT.Typed Type
ScoreT.Score (Y -> Typed Y) -> (ScoreTime -> Y) -> ScoreTime -> Typed Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreTime -> Y
ScoreTime.to_double
instance ToVal RealTime where
    to_val :: RealTime -> Val
to_val = Typed Y -> Val
VNum (Typed Y -> Val) -> (RealTime -> Typed Y) -> RealTime -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Y -> Typed Y
forall a. Type -> a -> Typed a
ScoreT.Typed Type
ScoreT.Real (Y -> Typed Y) -> (RealTime -> Y) -> RealTime -> Typed Y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Y
RealTime.to_seconds

instance ToVal a => ToVal [a] where to_val :: [a] -> Val
to_val = [Val] -> Val
VList ([Val] -> Val) -> ([a] -> [Val]) -> [a] -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Val) -> [a] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map a -> Val
forall a. ToVal a => a -> Val
to_val

-- ** rest

instance ToVal Attrs.Attributes where to_val :: Attributes -> Val
to_val = Attributes -> Val
VAttributes
instance ToVal DeriveT.ControlRef where to_val :: ControlRef -> Val
to_val = ControlRef -> Val
VControlRef
instance ToVal Pitch.Pitch where to_val :: Pitch -> Val
to_val = Pitch -> Val
VNotePitch
instance ToVal ScoreT.Instrument where
    to_val :: Instrument -> Val
to_val (ScoreT.Instrument Key
a) = Str -> Val
VStr (Key -> Str
Expr.Str Key
a)
instance ToVal Expr.Str where to_val :: Str -> Val
to_val = Str -> Val
VStr
instance ToVal Text where to_val :: Key -> Val
to_val = Str -> Val
VStr (Str -> Val) -> (Key -> Str) -> Key -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Str
Expr.Str
instance ToVal Expr where to_val :: Expr -> Val
to_val = Expr -> Val
VQuoted

data ConstantPitch = ConstantPitch !Pitch.ScaleId !Pitch.Note !Pitch.NoteNumber
    deriving (Int -> ConstantPitch -> ShowS
[ConstantPitch] -> ShowS
ConstantPitch -> String
(Int -> ConstantPitch -> ShowS)
-> (ConstantPitch -> String)
-> ([ConstantPitch] -> ShowS)
-> Show ConstantPitch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstantPitch] -> ShowS
$cshowList :: [ConstantPitch] -> ShowS
show :: ConstantPitch -> String
$cshow :: ConstantPitch -> String
showsPrec :: Int -> ConstantPitch -> ShowS
$cshowsPrec :: Int -> ConstantPitch -> ShowS
Show, ConstantPitch -> ConstantPitch -> Bool
(ConstantPitch -> ConstantPitch -> Bool)
-> (ConstantPitch -> ConstantPitch -> Bool) -> Eq ConstantPitch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstantPitch -> ConstantPitch -> Bool
$c/= :: ConstantPitch -> ConstantPitch -> Bool
== :: ConstantPitch -> ConstantPitch -> Bool
$c== :: ConstantPitch -> ConstantPitch -> Bool
Eq)

instance ToVal ConstantPitch where to_val :: ConstantPitch -> Val
to_val = ConstantPitch -> Val
VConstantPitch

-- * call

type Expr = Expr.Expr Val
type Call = Expr.Call Val
type Term = Expr.Term Val

instance Serialize.Serialize Val where
    put :: Putter Val
put Val
val = case Val
val of
        VNum Typed Y
v -> Word8 -> Put
Serialize.put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Typed Y)
forall a. Serialize a => Putter a
put Typed Y
v
        VAttributes Attributes
v -> Word8 -> Put
Serialize.put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Attributes
forall a. Serialize a => Putter a
put Attributes
v
        VControlRef ControlRef
v -> Word8 -> Put
Serialize.put_tag Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ControlRef
forall a. Serialize a => Putter a
put ControlRef
v
        VNotePitch Pitch
v -> Word8 -> Put
Serialize.put_tag Word8
3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Pitch
forall a. Serialize a => Putter a
put Pitch
v
        -- tag 4 was VInstrument
        VStr Str
v -> Word8 -> Put
Serialize.put_tag Word8
5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Str
forall a. Serialize a => Putter a
put Str
v
        VQuoted Expr
v -> Word8 -> Put
Serialize.put_tag Word8
6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Expr
forall a. Serialize a => Putter a
put Expr
v
        VList [Val]
v -> Word8 -> Put
Serialize.put_tag Word8
7 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [Val]
forall a. Serialize a => Putter a
put [Val]
v
        VConstantPitch (ConstantPitch ScaleId
scale_id Note
note NoteNumber
nn) -> Word8 -> Put
Serialize.put_tag Word8
8
            Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScaleId
forall a. Serialize a => Putter a
put ScaleId
scale_id Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Note
forall a. Serialize a => Putter a
put Note
note Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter NoteNumber
forall a. Serialize a => Putter a
put NoteNumber
nn
    get :: Get Val
get = do
        Word8
tag <- Get Word8
Serialize.get_tag
        case Word8
tag of
            Word8
0 -> Typed Y -> Val
VNum (Typed Y -> Val) -> Get (Typed Y) -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Typed Y)
forall a. Serialize a => Get a
get
            Word8
1 -> Attributes -> Val
VAttributes (Attributes -> Val) -> Get Attributes -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Attributes
forall a. Serialize a => Get a
get
            Word8
2 -> ControlRef -> Val
VControlRef (ControlRef -> Val) -> Get ControlRef -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ControlRef
forall a. Serialize a => Get a
get
            Word8
3 -> Pitch -> Val
VNotePitch (Pitch -> Val) -> Get Pitch -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Pitch
forall a. Serialize a => Get a
get
            Word8
4 -> Str -> Val
VStr (Str -> Val) -> Get Str -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Str
forall a. Serialize a => Get a
get -- tag 4 was VInstrument
            Word8
5 -> Str -> Val
VStr (Str -> Val) -> Get Str -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Str
forall a. Serialize a => Get a
get
            Word8
6 -> Expr -> Val
VQuoted (Expr -> Val) -> Get Expr -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Expr
forall a. Serialize a => Get a
get
            Word8
7 -> [Val] -> Val
VList ([Val] -> Val) -> Get [Val] -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Val]
forall a. Serialize a => Get a
get
            Word8
8 -> (ConstantPitch -> Val) -> Get ConstantPitch -> Get Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstantPitch -> Val
VConstantPitch (Get ConstantPitch -> Get Val) -> Get ConstantPitch -> Get Val
forall a b. (a -> b) -> a -> b
$ ScaleId -> Note -> NoteNumber -> ConstantPitch
ConstantPitch (ScaleId -> Note -> NoteNumber -> ConstantPitch)
-> Get ScaleId -> Get (Note -> NoteNumber -> ConstantPitch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ScaleId
forall a. Serialize a => Get a
get Get (Note -> NoteNumber -> ConstantPitch)
-> Get Note -> Get (NoteNumber -> ConstantPitch)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Note
forall a. Serialize a => Get a
get Get (NoteNumber -> ConstantPitch)
-> Get NoteNumber -> Get ConstantPitch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NoteNumber
forall a. Serialize a => Get a
get
            Word8
_ -> String -> Word8 -> Get Val
forall a. String -> Word8 -> Get a
Serialize.bad_tag String
"REnv.Val" Word8
tag

instance Serialize.Serialize Call where
    put :: Putter (Call Val)
put (Expr.Call Symbol
a [Term Val]
b) = Putter Symbol
forall a. Serialize a => Putter a
put Symbol
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [Term Val]
forall a. Serialize a => Putter a
put [Term Val]
b
    get :: Get (Call Val)
get = Symbol -> [Term Val] -> Call Val
forall val. Symbol -> [Term val] -> Call val
Expr.Call (Symbol -> [Term Val] -> Call Val)
-> Get Symbol -> Get ([Term Val] -> Call Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Symbol
forall a. Serialize a => Get a
get Get ([Term Val] -> Call Val) -> Get [Term Val] -> Get (Call Val)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Term Val]
forall a. Serialize a => Get a
get

instance Serialize.Serialize Term where
    put :: Putter (Term Val)
put Term Val
term = case Term Val
term of
        Expr.ValCall Call Val
v -> Word8 -> Put
Serialize.put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Call Val)
forall a. Serialize a => Putter a
put Call Val
v
        Expr.Literal Val
v -> Word8 -> Put
Serialize.put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Val
forall a. Serialize a => Putter a
put Val
v
    get :: Get (Term Val)
get = Get Word8
Serialize.get_tag Get Word8 -> (Word8 -> Get (Term Val)) -> Get (Term Val)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Call Val -> Term Val
forall val. Call val -> Term val
Expr.ValCall (Call Val -> Term Val) -> Get (Call Val) -> Get (Term Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Call Val)
forall a. Serialize a => Get a
get
        Word8
1 -> Val -> Term Val
forall val. val -> Term val
Expr.Literal (Val -> Term Val) -> Get Val -> Get (Term Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Val
forall a. Serialize a => Get a
get
        Word8
n -> String -> Word8 -> Get (Term Val)
forall a. String -> Word8 -> Get a
Serialize.bad_tag String
"REnv.Term" Word8
n