{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Record.Internal.Record (
    -- * Record description
    Record(..)
  , Field(..)
    -- * Combinators
  , matchRecordFields
  , dropMissingRecordFields
  ) where

import Control.Monad.State
import Data.List (sortBy)
import Data.Map (Map)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import Language.Haskell.TH

import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as Map

{-------------------------------------------------------------------------------
  Description
-------------------------------------------------------------------------------}

-- | Record description
data Record a = Record {
      -- | Record type name
      Record a -> String
recordType :: String

      -- | Record constructor name
    , Record a -> String
recordConstr :: String

      -- | Type variables in the records type
    , Record a -> [TyVarBndr]
recordTVars :: [TyVarBndr]

      -- | Fields in the record
    , Record a -> [Field a]
recordFields :: [Field a]
    }
  deriving stock (Int -> Record a -> ShowS
[Record a] -> ShowS
Record a -> String
(Int -> Record a -> ShowS)
-> (Record a -> String) -> ([Record a] -> ShowS) -> Show (Record a)
forall a. Show a => Int -> Record a -> ShowS
forall a. Show a => [Record a] -> ShowS
forall a. Show a => Record a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Record a] -> ShowS
$cshowList :: forall a. Show a => [Record a] -> ShowS
show :: Record a -> String
$cshow :: forall a. Show a => Record a -> String
showsPrec :: Int -> Record a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Record a -> ShowS
Show, a -> Record b -> Record a
(a -> b) -> Record a -> Record b
(forall a b. (a -> b) -> Record a -> Record b)
-> (forall a b. a -> Record b -> Record a) -> Functor Record
forall a b. a -> Record b -> Record a
forall a b. (a -> b) -> Record a -> Record b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Record b -> Record a
$c<$ :: forall a b. a -> Record b -> Record a
fmap :: (a -> b) -> Record a -> Record b
$cfmap :: forall a b. (a -> b) -> Record a -> Record b
Functor, Record a -> Bool
(a -> m) -> Record a -> m
(a -> b -> b) -> b -> Record a -> b
(forall m. Monoid m => Record m -> m)
-> (forall m a. Monoid m => (a -> m) -> Record a -> m)
-> (forall m a. Monoid m => (a -> m) -> Record a -> m)
-> (forall a b. (a -> b -> b) -> b -> Record a -> b)
-> (forall a b. (a -> b -> b) -> b -> Record a -> b)
-> (forall b a. (b -> a -> b) -> b -> Record a -> b)
-> (forall b a. (b -> a -> b) -> b -> Record a -> b)
-> (forall a. (a -> a -> a) -> Record a -> a)
-> (forall a. (a -> a -> a) -> Record a -> a)
-> (forall a. Record a -> [a])
-> (forall a. Record a -> Bool)
-> (forall a. Record a -> Int)
-> (forall a. Eq a => a -> Record a -> Bool)
-> (forall a. Ord a => Record a -> a)
-> (forall a. Ord a => Record a -> a)
-> (forall a. Num a => Record a -> a)
-> (forall a. Num a => Record a -> a)
-> Foldable Record
forall a. Eq a => a -> Record a -> Bool
forall a. Num a => Record a -> a
forall a. Ord a => Record a -> a
forall m. Monoid m => Record m -> m
forall a. Record a -> Bool
forall a. Record a -> Int
forall a. Record a -> [a]
forall a. (a -> a -> a) -> Record a -> a
forall m a. Monoid m => (a -> m) -> Record a -> m
forall b a. (b -> a -> b) -> b -> Record a -> b
forall a b. (a -> b -> b) -> b -> Record a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Record a -> a
$cproduct :: forall a. Num a => Record a -> a
sum :: Record a -> a
$csum :: forall a. Num a => Record a -> a
minimum :: Record a -> a
$cminimum :: forall a. Ord a => Record a -> a
maximum :: Record a -> a
$cmaximum :: forall a. Ord a => Record a -> a
elem :: a -> Record a -> Bool
$celem :: forall a. Eq a => a -> Record a -> Bool
length :: Record a -> Int
$clength :: forall a. Record a -> Int
null :: Record a -> Bool
$cnull :: forall a. Record a -> Bool
toList :: Record a -> [a]
$ctoList :: forall a. Record a -> [a]
foldl1 :: (a -> a -> a) -> Record a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Record a -> a
foldr1 :: (a -> a -> a) -> Record a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Record a -> a
foldl' :: (b -> a -> b) -> b -> Record a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Record a -> b
foldl :: (b -> a -> b) -> b -> Record a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Record a -> b
foldr' :: (a -> b -> b) -> b -> Record a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Record a -> b
foldr :: (a -> b -> b) -> b -> Record a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Record a -> b
foldMap' :: (a -> m) -> Record a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Record a -> m
foldMap :: (a -> m) -> Record a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Record a -> m
fold :: Record m -> m
$cfold :: forall m. Monoid m => Record m -> m
Foldable, Functor Record
Foldable Record
Functor Record
-> Foldable Record
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Record a -> f (Record b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Record (f a) -> f (Record a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Record a -> m (Record b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Record (m a) -> m (Record a))
-> Traversable Record
(a -> f b) -> Record a -> f (Record b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
Record (m a) -> m (Record a)
forall (f :: Type -> Type) a.
Applicative f =>
Record (f a) -> f (Record a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Record a -> m (Record b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Record a -> f (Record b)
sequence :: Record (m a) -> m (Record a)
$csequence :: forall (m :: Type -> Type) a.
Monad m =>
Record (m a) -> m (Record a)
mapM :: (a -> m b) -> Record a -> m (Record b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Record a -> m (Record b)
sequenceA :: Record (f a) -> f (Record a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Record (f a) -> f (Record a)
traverse :: (a -> f b) -> Record a -> f (Record b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Record a -> f (Record b)
$cp2Traversable :: Foldable Record
$cp1Traversable :: Functor Record
Traversable)

-- | Record field description
data Field a = Field {
      -- | Field name
      Field a -> String
fieldName :: String

      -- | Type of the field
    , Field a -> Type
fieldType :: Type

      -- | Index of the field (field 0, field 1, ..)
      --
      -- This is strictly speaking redundant information, as this is already
      -- implied by the position of the field in 'recordFields'. However, since
      -- we do a lot of positional processing (every field corresponds to a
      -- vector element), it is convenient to have the index readily available.
    , Field a -> Int
fieldIndex :: Int

      -- | Value associated with this field ('Nothing' if not present)
    , Field a -> a
fieldVal :: a
    }
  deriving stock (Int -> Field a -> ShowS
[Field a] -> ShowS
Field a -> String
(Int -> Field a -> ShowS)
-> (Field a -> String) -> ([Field a] -> ShowS) -> Show (Field a)
forall a. Show a => Int -> Field a -> ShowS
forall a. Show a => [Field a] -> ShowS
forall a. Show a => Field a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field a] -> ShowS
$cshowList :: forall a. Show a => [Field a] -> ShowS
show :: Field a -> String
$cshow :: forall a. Show a => Field a -> String
showsPrec :: Int -> Field a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Field a -> ShowS
Show, a -> Field b -> Field a
(a -> b) -> Field a -> Field b
(forall a b. (a -> b) -> Field a -> Field b)
-> (forall a b. a -> Field b -> Field a) -> Functor Field
forall a b. a -> Field b -> Field a
forall a b. (a -> b) -> Field a -> Field b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Field b -> Field a
$c<$ :: forall a b. a -> Field b -> Field a
fmap :: (a -> b) -> Field a -> Field b
$cfmap :: forall a b. (a -> b) -> Field a -> Field b
Functor, Field a -> Bool
(a -> m) -> Field a -> m
(a -> b -> b) -> b -> Field a -> b
(forall m. Monoid m => Field m -> m)
-> (forall m a. Monoid m => (a -> m) -> Field a -> m)
-> (forall m a. Monoid m => (a -> m) -> Field a -> m)
-> (forall a b. (a -> b -> b) -> b -> Field a -> b)
-> (forall a b. (a -> b -> b) -> b -> Field a -> b)
-> (forall b a. (b -> a -> b) -> b -> Field a -> b)
-> (forall b a. (b -> a -> b) -> b -> Field a -> b)
-> (forall a. (a -> a -> a) -> Field a -> a)
-> (forall a. (a -> a -> a) -> Field a -> a)
-> (forall a. Field a -> [a])
-> (forall a. Field a -> Bool)
-> (forall a. Field a -> Int)
-> (forall a. Eq a => a -> Field a -> Bool)
-> (forall a. Ord a => Field a -> a)
-> (forall a. Ord a => Field a -> a)
-> (forall a. Num a => Field a -> a)
-> (forall a. Num a => Field a -> a)
-> Foldable Field
forall a. Eq a => a -> Field a -> Bool
forall a. Num a => Field a -> a
forall a. Ord a => Field a -> a
forall m. Monoid m => Field m -> m
forall a. Field a -> Bool
forall a. Field a -> Int
forall a. Field a -> [a]
forall a. (a -> a -> a) -> Field a -> a
forall m a. Monoid m => (a -> m) -> Field a -> m
forall b a. (b -> a -> b) -> b -> Field a -> b
forall a b. (a -> b -> b) -> b -> Field a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Field a -> a
$cproduct :: forall a. Num a => Field a -> a
sum :: Field a -> a
$csum :: forall a. Num a => Field a -> a
minimum :: Field a -> a
$cminimum :: forall a. Ord a => Field a -> a
maximum :: Field a -> a
$cmaximum :: forall a. Ord a => Field a -> a
elem :: a -> Field a -> Bool
$celem :: forall a. Eq a => a -> Field a -> Bool
length :: Field a -> Int
$clength :: forall a. Field a -> Int
null :: Field a -> Bool
$cnull :: forall a. Field a -> Bool
toList :: Field a -> [a]
$ctoList :: forall a. Field a -> [a]
foldl1 :: (a -> a -> a) -> Field a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Field a -> a
foldr1 :: (a -> a -> a) -> Field a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Field a -> a
foldl' :: (b -> a -> b) -> b -> Field a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Field a -> b
foldl :: (b -> a -> b) -> b -> Field a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Field a -> b
foldr' :: (a -> b -> b) -> b -> Field a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Field a -> b
foldr :: (a -> b -> b) -> b -> Field a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Field a -> b
foldMap' :: (a -> m) -> Field a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Field a -> m
foldMap :: (a -> m) -> Field a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Field a -> m
fold :: Field m -> m
$cfold :: forall m. Monoid m => Field m -> m
Foldable, Functor Field
Foldable Field
Functor Field
-> Foldable Field
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Field a -> f (Field b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Field (f a) -> f (Field a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Field a -> m (Field b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Field (m a) -> m (Field a))
-> Traversable Field
(a -> f b) -> Field a -> f (Field b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a. Monad m => Field (m a) -> m (Field a)
forall (f :: Type -> Type) a.
Applicative f =>
Field (f a) -> f (Field a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Field a -> m (Field b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Field a -> f (Field b)
sequence :: Field (m a) -> m (Field a)
$csequence :: forall (m :: Type -> Type) a. Monad m => Field (m a) -> m (Field a)
mapM :: (a -> m b) -> Field a -> m (Field b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Field a -> m (Field b)
sequenceA :: Field (f a) -> f (Field a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Field (f a) -> f (Field a)
traverse :: (a -> f b) -> Field a -> f (Field b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Field a -> f (Field b)
$cp2Traversable :: Foldable Field
$cp1Traversable :: Functor Field
Traversable)

{-------------------------------------------------------------------------------
  Combinators
-------------------------------------------------------------------------------}

-- | Match field values against field definitions
--
-- We explicit mark missing fields; one use case for this is record
-- construction, where we want to issue a warning for missing fields.
matchRecordFields :: forall a b.
     [(String, b)]
  -> Record a
  -> (Record (a, Maybe b), [String])
matchRecordFields :: [(String, b)] -> Record a -> (Record (a, Maybe b), [String])
matchRecordFields [(String, b)]
values Record a
r = (
      Record a
r { recordFields :: [Field (a, Maybe b)]
recordFields = (Field (a, Maybe b) -> Field (a, Maybe b) -> Ordering)
-> [Field (a, Maybe b)] -> [Field (a, Maybe b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Field (a, Maybe b) -> Int)
-> Field (a, Maybe b) -> Field (a, Maybe b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Field (a, Maybe b) -> Int
forall a. Field a -> Int
fieldIndex) ([Field (a, Maybe b)] -> [Field (a, Maybe b)])
-> [Field (a, Maybe b)] -> [Field (a, Maybe b)]
forall a b. (a -> b) -> a -> b
$
                               Map String (Field (a, Maybe b)) -> [Field (a, Maybe b)]
forall k a. Map k a -> [a]
Map.elems Map String (Field (a, Maybe b))
matched
        }
    , [String]
unknown
    )
  where
    given :: Map String b
    given :: Map String b
given = [(String, b)] -> Map String b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, b)]
values

    defined :: Map String (Field a)
    defined :: Map String (Field a)
defined = [(String, Field a)] -> Map String (Field a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Field a)] -> Map String (Field a))
-> [(String, Field a)] -> Map String (Field a)
forall a b. (a -> b) -> a -> b
$
                (Field a -> (String, Field a)) -> [Field a] -> [(String, Field a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Field a
f -> (Field a -> String
forall a. Field a -> String
fieldName Field a
f, Field a
f)) (Record a -> [Field a]
forall a. Record a -> [Field a]
recordFields Record a
r)

    matched :: Map String (Field (a, Maybe b))
    unknown :: [String]
    (Map String (Field (a, Maybe b))
matched, [String]
unknown) = (State [String] (Map String (Field (a, Maybe b)))
 -> [String] -> (Map String (Field (a, Maybe b)), [String]))
-> [String]
-> State [String] (Map String (Field (a, Maybe b)))
-> (Map String (Field (a, Maybe b)), [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [String] (Map String (Field (a, Maybe b)))
-> [String] -> (Map String (Field (a, Maybe b)), [String])
forall s a. State s a -> s -> (a, s)
runState [] (State [String] (Map String (Field (a, Maybe b)))
 -> (Map String (Field (a, Maybe b)), [String]))
-> State [String] (Map String (Field (a, Maybe b)))
-> (Map String (Field (a, Maybe b)), [String])
forall a b. (a -> b) -> a -> b
$
        WhenMissing
  (StateT [String] Identity) String (Field a) (Field (a, Maybe b))
-> WhenMissing
     (StateT [String] Identity) String b (Field (a, Maybe b))
-> WhenMatched
     (StateT [String] Identity) String (Field a) b (Field (a, Maybe b))
-> Map String (Field a)
-> Map String b
-> State [String] (Map String (Field (a, Maybe b)))
forall (f :: Type -> Type) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
          ((String
 -> Field a -> StateT [String] Identity (Field (a, Maybe b)))
-> WhenMissing
     (StateT [String] Identity) String (Field a) (Field (a, Maybe b))
forall (f :: Type -> Type) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Map.traverseMissing      String -> Field a -> StateT [String] Identity (Field (a, Maybe b))
fieldMissing)
          ((String
 -> b -> StateT [String] Identity (Maybe (Field (a, Maybe b))))
-> WhenMissing
     (StateT [String] Identity) String b (Field (a, Maybe b))
forall (f :: Type -> Type) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
Map.traverseMaybeMissing String
-> b -> StateT [String] Identity (Maybe (Field (a, Maybe b)))
fieldUnknown)
          ((String
 -> Field a -> b -> StateT [String] Identity (Field (a, Maybe b)))
-> WhenMatched
     (StateT [String] Identity) String (Field a) b (Field (a, Maybe b))
forall (f :: Type -> Type) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
Map.zipWithAMatched      String
-> Field a -> b -> StateT [String] Identity (Field (a, Maybe b))
fieldPresent)
          Map String (Field a)
defined
          Map String b
given

    fieldPresent :: String -> Field a -> b -> State [String]        (Field (a, Maybe b))
    fieldMissing :: String -> Field a      -> State [String]        (Field (a, Maybe b))
    fieldUnknown :: String ->            b -> State [String] (Maybe (Field (a, Maybe b)))

    fieldPresent :: String
-> Field a -> b -> StateT [String] Identity (Field (a, Maybe b))
fieldPresent String
_nm  Field a
f  b
a = Field (a, Maybe b) -> StateT [String] Identity (Field (a, Maybe b))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Field (a, Maybe b)
 -> StateT [String] Identity (Field (a, Maybe b)))
-> Field (a, Maybe b)
-> StateT [String] Identity (Field (a, Maybe b))
forall a b. (a -> b) -> a -> b
$ Field a
f { fieldVal :: (a, Maybe b)
fieldVal = (Field a -> a
forall a. Field a -> a
fieldVal Field a
f, b -> Maybe b
forall a. a -> Maybe a
Just b
a) }
    fieldMissing :: String -> Field a -> StateT [String] Identity (Field (a, Maybe b))
fieldMissing String
_nm  Field a
f    = Field (a, Maybe b) -> StateT [String] Identity (Field (a, Maybe b))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Field (a, Maybe b)
 -> StateT [String] Identity (Field (a, Maybe b)))
-> Field (a, Maybe b)
-> StateT [String] Identity (Field (a, Maybe b))
forall a b. (a -> b) -> a -> b
$ Field a
f { fieldVal :: (a, Maybe b)
fieldVal = (Field a -> a
forall a. Field a -> a
fieldVal Field a
f, Maybe b
forall a. Maybe a
Nothing) }
    fieldUnknown :: String
-> b -> StateT [String] Identity (Maybe (Field (a, Maybe b)))
fieldUnknown  String
nm    b
_a = ([String] -> [String]) -> StateT [String] Identity ()
forall s (m :: Type -> Type). MonadState s m => (s -> s) -> m ()
modify (String
nmString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) StateT [String] Identity ()
-> StateT [String] Identity (Maybe (Field (a, Maybe b)))
-> StateT [String] Identity (Maybe (Field (a, Maybe b)))
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Maybe (Field (a, Maybe b))
-> StateT [String] Identity (Maybe (Field (a, Maybe b)))
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (Field (a, Maybe b))
forall a. Maybe a
Nothing

dropMissingRecordFields :: Record (Maybe a) -> Record a
dropMissingRecordFields :: Record (Maybe a) -> Record a
dropMissingRecordFields Record (Maybe a)
r =
    Record (Maybe a)
r { recordFields :: [Field a]
recordFields = (Field (Maybe a) -> Maybe (Field a))
-> [Field (Maybe a)] -> [Field a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Field (Maybe a) -> Maybe (Field a)
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Record (Maybe a) -> [Field (Maybe a)]
forall a. Record a -> [Field a]
recordFields Record (Maybe a)
r) }