-- |
-- Module      :  Codec.Scale.Skip
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- This type helps to skip fields in encoded data type.
--

module Codec.Scale.Skip (Skip(..)) where

import           Data.Default      (Default (..))

import           Codec.Scale.Class (Decode (..), Encode (..))

-- | This type hide filed from encoding context.
-- It's useful in cases when serialization impossible or not needed.
-- For decoding wrapped type should have 'Default' instance.
newtype Skip a = Skip { Skip a -> a
unSkip :: a }
  deriving (Skip a -> Skip a -> Bool
(Skip a -> Skip a -> Bool)
-> (Skip a -> Skip a -> Bool) -> Eq (Skip a)
forall a. Eq a => Skip a -> Skip a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Skip a -> Skip a -> Bool
$c/= :: forall a. Eq a => Skip a -> Skip a -> Bool
== :: Skip a -> Skip a -> Bool
$c== :: forall a. Eq a => Skip a -> Skip a -> Bool
Eq, Eq (Skip a)
Eq (Skip a)
-> (Skip a -> Skip a -> Ordering)
-> (Skip a -> Skip a -> Bool)
-> (Skip a -> Skip a -> Bool)
-> (Skip a -> Skip a -> Bool)
-> (Skip a -> Skip a -> Bool)
-> (Skip a -> Skip a -> Skip a)
-> (Skip a -> Skip a -> Skip a)
-> Ord (Skip a)
Skip a -> Skip a -> Bool
Skip a -> Skip a -> Ordering
Skip a -> Skip a -> Skip a
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
forall a. Ord a => Eq (Skip a)
forall a. Ord a => Skip a -> Skip a -> Bool
forall a. Ord a => Skip a -> Skip a -> Ordering
forall a. Ord a => Skip a -> Skip a -> Skip a
min :: Skip a -> Skip a -> Skip a
$cmin :: forall a. Ord a => Skip a -> Skip a -> Skip a
max :: Skip a -> Skip a -> Skip a
$cmax :: forall a. Ord a => Skip a -> Skip a -> Skip a
>= :: Skip a -> Skip a -> Bool
$c>= :: forall a. Ord a => Skip a -> Skip a -> Bool
> :: Skip a -> Skip a -> Bool
$c> :: forall a. Ord a => Skip a -> Skip a -> Bool
<= :: Skip a -> Skip a -> Bool
$c<= :: forall a. Ord a => Skip a -> Skip a -> Bool
< :: Skip a -> Skip a -> Bool
$c< :: forall a. Ord a => Skip a -> Skip a -> Bool
compare :: Skip a -> Skip a -> Ordering
$ccompare :: forall a. Ord a => Skip a -> Skip a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Skip a)
Ord, Int -> Skip a -> ShowS
[Skip a] -> ShowS
Skip a -> String
(Int -> Skip a -> ShowS)
-> (Skip a -> String) -> ([Skip a] -> ShowS) -> Show (Skip a)
forall a. Show a => Int -> Skip a -> ShowS
forall a. Show a => [Skip a] -> ShowS
forall a. Show a => Skip a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Skip a] -> ShowS
$cshowList :: forall a. Show a => [Skip a] -> ShowS
show :: Skip a -> String
$cshow :: forall a. Show a => Skip a -> String
showsPrec :: Int -> Skip a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Skip a -> ShowS
Show)

instance Encode (Skip a) where
    put :: Putter (Skip a)
put Skip a
_ = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Default a => Decode (Skip a) where
    get :: Get (Skip a)
get = Skip a -> Get (Skip a)
forall (m :: * -> *) a. Monad m => a -> m a
return Skip a
forall a. Default a => a
def

instance Default a => Default (Skip a) where
    def :: Skip a
def = a -> Skip a
forall a. a -> Skip a
Skip a
forall a. Default a => a
def