{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Information about a record
--
-- Intended for qualified import.
--
-- > import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow(..))
-- > import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow
module Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (
    -- * Definition
    KnownRow(..)
    -- * Fields
  , KnownRowField(..)
  , FieldIndex
  , toKnownRowField
  , fromKnownRowField
    -- * Conversion
  , fromList
  , inRowOrder
  , inFieldOrder
  , visibleMap
    -- * Query
  , lookup
    -- * Combinators
  , traverse
    -- * Check for subrows
  , NotSubRow(..)
  , Source(..)
  , Target(..)
  , isSubRowOf
  ) where

import Prelude hiding (traverse, lookup)
import qualified Prelude

import Data.Either (partitionEithers)
import Data.List (sortBy)
import Data.Ord (comparing)

import Data.Record.Anon.Internal.Core.FieldName (FieldName)
import Data.Record.Anon.Internal.Util.SmallHashMap (SmallHashMap)

import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..))
import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI

import qualified Data.Record.Anon.Internal.Util.SmallHashMap as HashMap

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Record with statically known shape
data KnownRow a = KnownRow {
      -- | Information about each field in the record, in user-specified order.
      --
      -- Order matters, because records with the same fields in a different
      -- order are not considered equal by the library (merely isomorphic).
      --
      -- May contain duplicates (if fields are shadowed).
      forall a. KnownRow a -> [KnownRowField a]
knownRecordVector :: [KnownRowField a]

      -- | "Most recent" position of each field in the record
      --
      -- Shadowed fields are not included in this map.
      --
      -- Invariant:
      --
      -- >     HashMap.lookup n knownRecordNames == Just i
      -- > ==> knownFieldName (knownRecordVector V.! i) == n
    , forall a. KnownRow a -> SmallHashMap FieldName Int
knownRecordVisible :: SmallHashMap FieldName Int

      -- | Are all fields in this record visible?
      --
      -- 'False' if some fields are shadowed.
    , forall a. KnownRow a -> Bool
knownRecordAllVisible :: Bool
    }
  deriving ((forall a b. (a -> b) -> KnownRow a -> KnownRow b)
-> (forall a b. a -> KnownRow b -> KnownRow a) -> Functor KnownRow
forall a b. a -> KnownRow b -> KnownRow a
forall a b. (a -> b) -> KnownRow a -> KnownRow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> KnownRow a -> KnownRow b
fmap :: forall a b. (a -> b) -> KnownRow a -> KnownRow b
$c<$ :: forall a b. a -> KnownRow b -> KnownRow a
<$ :: forall a b. a -> KnownRow b -> KnownRow a
Functor)

{-------------------------------------------------------------------------------
  Individual fields
-------------------------------------------------------------------------------}

-- | Field in a known row
data KnownRowField a = KnownRowField {
      forall a. KnownRowField a -> FieldName
knownRowFieldName  :: FieldName
    , forall a. KnownRowField a -> Int
knownRowFieldIndex :: FieldIndex
    , forall a. KnownRowField a -> a
knownRowFieldInfo  :: a
    }
  deriving ((forall a b. (a -> b) -> KnownRowField a -> KnownRowField b)
-> (forall a b. a -> KnownRowField b -> KnownRowField a)
-> Functor KnownRowField
forall a b. a -> KnownRowField b -> KnownRowField a
forall a b. (a -> b) -> KnownRowField a -> KnownRowField b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> KnownRowField a -> KnownRowField b
fmap :: forall a b. (a -> b) -> KnownRowField a -> KnownRowField b
$c<$ :: forall a b. a -> KnownRowField b -> KnownRowField a
<$ :: forall a b. a -> KnownRowField b -> KnownRowField a
Functor)

type FieldIndex = Int

-- | Drop index information
fromKnownRowField :: KnownRowField a -> KnownField a
fromKnownRowField :: forall a. KnownRowField a -> KnownField a
fromKnownRowField KnownRowField a
field = KnownField {
      knownFieldName :: FieldName
knownFieldName = KnownRowField a -> FieldName
forall a. KnownRowField a -> FieldName
knownRowFieldName KnownRowField a
field
    , knownFieldInfo :: a
knownFieldInfo = KnownRowField a -> a
forall a. KnownRowField a -> a
knownRowFieldInfo KnownRowField a
field
    }

-- | Add index information
toKnownRowField :: KnownField a -> FieldIndex -> KnownRowField a
toKnownRowField :: forall a. KnownField a -> Int -> KnownRowField a
toKnownRowField KnownField a
field Int
ix = KnownRowField {
      knownRowFieldName :: FieldName
knownRowFieldName  = KnownField a -> FieldName
forall a. KnownField a -> FieldName
knownFieldName KnownField a
field
    , knownRowFieldInfo :: a
knownRowFieldInfo  = KnownField a -> a
forall a. KnownField a -> a
knownFieldInfo KnownField a
field
    , knownRowFieldIndex :: Int
knownRowFieldIndex = Int
ix
    }

{-------------------------------------------------------------------------------
  Conversion
-------------------------------------------------------------------------------}

-- | List of all fields, in row order
--
-- This may /NOT/ be the order in which the fields are stored.
inRowOrder :: KnownRow a -> [KnownField a]
inRowOrder :: forall a. KnownRow a -> [KnownField a]
inRowOrder =
      (KnownRowField a -> KnownField a)
-> [KnownRowField a] -> [KnownField a]
forall a b. (a -> b) -> [a] -> [b]
map KnownRowField a -> KnownField a
forall a. KnownRowField a -> KnownField a
fromKnownRowField
    ([KnownRowField a] -> [KnownField a])
-> (KnownRow a -> [KnownRowField a])
-> KnownRow a
-> [KnownField a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownRow a -> [KnownRowField a]
forall a. KnownRow a -> [KnownRowField a]
knownRecordVector

-- | List of all fields, ordered by fieldIndex
inFieldOrder :: KnownRow a -> [KnownField a]
inFieldOrder :: forall a. KnownRow a -> [KnownField a]
inFieldOrder =
      (KnownRowField a -> KnownField a)
-> [KnownRowField a] -> [KnownField a]
forall a b. (a -> b) -> [a] -> [b]
map KnownRowField a -> KnownField a
forall a. KnownRowField a -> KnownField a
fromKnownRowField
    ([KnownRowField a] -> [KnownField a])
-> (KnownRow a -> [KnownRowField a])
-> KnownRow a
-> [KnownField a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KnownRowField a -> KnownRowField a -> Ordering)
-> [KnownRowField a] -> [KnownRowField a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((KnownRowField a -> Int)
-> KnownRowField a -> KnownRowField a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing KnownRowField a -> Int
forall a. KnownRowField a -> Int
knownRowFieldIndex)
    ([KnownRowField a] -> [KnownRowField a])
-> (KnownRow a -> [KnownRowField a])
-> KnownRow a
-> [KnownRowField a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownRow a -> [KnownRowField a]
forall a. KnownRow a -> [KnownRowField a]
knownRecordVector

visibleMap :: KnownRow a -> SmallHashMap FieldName (KnownRowField a)
visibleMap :: forall a. KnownRow a -> SmallHashMap FieldName (KnownRowField a)
visibleMap KnownRow{Bool
[KnownRowField a]
SmallHashMap FieldName Int
knownRecordVector :: forall a. KnownRow a -> [KnownRowField a]
knownRecordVisible :: forall a. KnownRow a -> SmallHashMap FieldName Int
knownRecordAllVisible :: forall a. KnownRow a -> Bool
knownRecordVector :: [KnownRowField a]
knownRecordVisible :: SmallHashMap FieldName Int
knownRecordAllVisible :: Bool
..} = ([KnownRowField a]
knownRecordVector [KnownRowField a] -> Int -> KnownRowField a
forall a. HasCallStack => [a] -> Int -> a
!!) (Int -> KnownRowField a)
-> SmallHashMap FieldName Int
-> SmallHashMap FieldName (KnownRowField a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SmallHashMap FieldName Int
knownRecordVisible

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

fromList :: forall a.
     [KnownRowField a]
     -- ^ Fields of the record in the order they appear in the row types
     --
     -- In other words, fields earlier in the list shadow later fields.
  -> KnownRow a
fromList :: forall a. [KnownRowField a] -> KnownRow a
fromList = [KnownRowField a]
-> Int
-> SmallHashMap FieldName Int
-> Bool
-> [KnownRowField a]
-> KnownRow a
go [] Int
0 SmallHashMap FieldName Int
forall k a. SmallHashMap k a
HashMap.empty Bool
True
  where
    go :: [KnownRowField a]           -- Acc fields, rev order (incl shadowed)
       -> Int                         -- Next index
       -> SmallHashMap FieldName Int  -- Acc indices of visible fields
       -> Bool                        -- All already processed fields visible?
       -> [KnownRowField a]           -- To process
       -> KnownRow a
    go :: [KnownRowField a]
-> Int
-> SmallHashMap FieldName Int
-> Bool
-> [KnownRowField a]
-> KnownRow a
go [KnownRowField a]
accFields !Int
nextIndex !SmallHashMap FieldName Int
accVisible !Bool
accAllVisible = \case
        [] -> KnownRow {
            knownRecordVector :: [KnownRowField a]
knownRecordVector     = [KnownRowField a] -> [KnownRowField a]
forall a. [a] -> [a]
reverse [KnownRowField a]
accFields
          , knownRecordVisible :: SmallHashMap FieldName Int
knownRecordVisible    = SmallHashMap FieldName Int
accVisible
          , knownRecordAllVisible :: Bool
knownRecordAllVisible = Bool
accAllVisible
          }
        KnownRowField a
f:[KnownRowField a]
fs
          | FieldName
name FieldName -> SmallHashMap FieldName Int -> Bool
forall k a. (Hashable k, Ord k) => k -> SmallHashMap k a -> Bool
`HashMap.member` SmallHashMap FieldName Int
accVisible ->
              -- Field shadowed
              [KnownRowField a]
-> Int
-> SmallHashMap FieldName Int
-> Bool
-> [KnownRowField a]
-> KnownRow a
go (KnownRowField a
f KnownRowField a -> [KnownRowField a] -> [KnownRowField a]
forall a. a -> [a] -> [a]
: [KnownRowField a]
accFields)
                 (Int -> Int
forall a. Enum a => a -> a
succ Int
nextIndex)
                 SmallHashMap FieldName Int
accVisible
                 Bool
False
                 [KnownRowField a]
fs
          | Bool
otherwise ->
              [KnownRowField a]
-> Int
-> SmallHashMap FieldName Int
-> Bool
-> [KnownRowField a]
-> KnownRow a
go (KnownRowField a
f KnownRowField a -> [KnownRowField a] -> [KnownRowField a]
forall a. a -> [a] -> [a]
: [KnownRowField a]
accFields)
                 (Int -> Int
forall a. Enum a => a -> a
succ Int
nextIndex)
                 (FieldName
-> Int -> SmallHashMap FieldName Int -> SmallHashMap FieldName Int
forall k a.
(Hashable k, Ord k) =>
k -> a -> SmallHashMap k a -> SmallHashMap k a
HashMap.insert FieldName
name Int
nextIndex SmallHashMap FieldName Int
accVisible)
                 Bool
accAllVisible
                 [KnownRowField a]
fs
          where
            name :: FieldName
name = KnownRowField a -> FieldName
forall a. KnownRowField a -> FieldName
knownRowFieldName KnownRowField a
f

{-------------------------------------------------------------------------------
  Query
-------------------------------------------------------------------------------}

lookup :: FieldName -> KnownRow a -> Maybe (KnownRowField a)
lookup :: forall a. FieldName -> KnownRow a -> Maybe (KnownRowField a)
lookup FieldName
field KnownRow{Bool
[KnownRowField a]
SmallHashMap FieldName Int
knownRecordVector :: forall a. KnownRow a -> [KnownRowField a]
knownRecordVisible :: forall a. KnownRow a -> SmallHashMap FieldName Int
knownRecordAllVisible :: forall a. KnownRow a -> Bool
knownRecordVector :: [KnownRowField a]
knownRecordVisible :: SmallHashMap FieldName Int
knownRecordAllVisible :: Bool
..} =
    ([KnownRowField a]
knownRecordVector [KnownRowField a] -> Int -> KnownRowField a
forall a. HasCallStack => [a] -> Int -> a
!!) (Int -> KnownRowField a) -> Maybe Int -> Maybe (KnownRowField a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      FieldName -> SmallHashMap FieldName Int -> Maybe Int
forall k a. (Hashable k, Ord k) => k -> SmallHashMap k a -> Maybe a
HashMap.lookup FieldName
field SmallHashMap FieldName Int
knownRecordVisible

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

traverse :: forall m a b.
     Applicative m
  => KnownRow a
  -> (FieldName -> FieldIndex -> a -> m b)
  -> m (KnownRow b)
traverse :: forall (m :: * -> *) a b.
Applicative m =>
KnownRow a -> (FieldName -> Int -> a -> m b) -> m (KnownRow b)
traverse KnownRow{Bool
[KnownRowField a]
SmallHashMap FieldName Int
knownRecordVector :: forall a. KnownRow a -> [KnownRowField a]
knownRecordVisible :: forall a. KnownRow a -> SmallHashMap FieldName Int
knownRecordAllVisible :: forall a. KnownRow a -> Bool
knownRecordVector :: [KnownRowField a]
knownRecordVisible :: SmallHashMap FieldName Int
knownRecordAllVisible :: Bool
..} FieldName -> Int -> a -> m b
f =
    [KnownRowField b] -> KnownRow b
mkRow ([KnownRowField b] -> KnownRow b)
-> m [KnownRowField b] -> m (KnownRow b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KnownRowField a -> m (KnownRowField b))
-> [KnownRowField a] -> m [KnownRowField b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Prelude.traverse KnownRowField a -> m (KnownRowField b)
f' [KnownRowField a]
knownRecordVector
  where
    mkRow :: [KnownRowField b] -> KnownRow b
    mkRow :: [KnownRowField b] -> KnownRow b
mkRow [KnownRowField b]
updated = KnownRow {
          knownRecordVector :: [KnownRowField b]
knownRecordVector     = [KnownRowField b]
updated
        , knownRecordVisible :: SmallHashMap FieldName Int
knownRecordVisible    = SmallHashMap FieldName Int
knownRecordVisible
        , knownRecordAllVisible :: Bool
knownRecordAllVisible = Bool
knownRecordAllVisible
        }

    f' :: KnownRowField a -> m (KnownRowField b)
    f' :: KnownRowField a -> m (KnownRowField b)
f' (KnownRowField FieldName
nm Int
ix a
info) = FieldName -> Int -> b -> KnownRowField b
forall a. FieldName -> Int -> a -> KnownRowField a
KnownRowField FieldName
nm Int
ix (b -> KnownRowField b) -> m b -> m (KnownRowField b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> Int -> a -> m b
f FieldName
nm Int
ix a
info

{-------------------------------------------------------------------------------
  Check for projections
-------------------------------------------------------------------------------}

-- | Reason why we cannot failed to prove 'SubRow'
data NotSubRow =
    -- | We do not support records with shadowed fields
    --
    -- Since these fields can only come from the source record, and shadowed
    -- fields in the source record are invisible, shadowed fields in the target
    -- could only be duplicates of the same field in the source. This is not
    -- particularly useful, so we don't support it. Moreover, since we actually
    -- create /lenses/ from these subrows, it is important that every field in
    -- the source record corresponds to at most /one/ field in the target.
    TargetContainsShadowedFields

    -- | Some fields in the target are missing in the source
  | SourceMissesFields [FieldName]
  deriving (Int -> NotSubRow -> ShowS
[NotSubRow] -> ShowS
NotSubRow -> String
(Int -> NotSubRow -> ShowS)
-> (NotSubRow -> String)
-> ([NotSubRow] -> ShowS)
-> Show NotSubRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotSubRow -> ShowS
showsPrec :: Int -> NotSubRow -> ShowS
$cshow :: NotSubRow -> String
show :: NotSubRow -> String
$cshowList :: [NotSubRow] -> ShowS
showList :: [NotSubRow] -> ShowS
Show, NotSubRow -> NotSubRow -> Bool
(NotSubRow -> NotSubRow -> Bool)
-> (NotSubRow -> NotSubRow -> Bool) -> Eq NotSubRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotSubRow -> NotSubRow -> Bool
== :: NotSubRow -> NotSubRow -> Bool
$c/= :: NotSubRow -> NotSubRow -> Bool
/= :: NotSubRow -> NotSubRow -> Bool
Eq)

newtype Source a = Source { forall a. Source a -> a
getSource :: a } deriving (Int -> Source a -> ShowS
[Source a] -> ShowS
Source a -> String
(Int -> Source a -> ShowS)
-> (Source a -> String) -> ([Source a] -> ShowS) -> Show (Source a)
forall a. Show a => Int -> Source a -> ShowS
forall a. Show a => [Source a] -> ShowS
forall a. Show a => Source a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Source a -> ShowS
showsPrec :: Int -> Source a -> ShowS
$cshow :: forall a. Show a => Source a -> String
show :: Source a -> String
$cshowList :: forall a. Show a => [Source a] -> ShowS
showList :: [Source a] -> ShowS
Show, (forall a b. (a -> b) -> Source a -> Source b)
-> (forall a b. a -> Source b -> Source a) -> Functor Source
forall a b. a -> Source b -> Source a
forall a b. (a -> b) -> Source a -> Source b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Source a -> Source b
fmap :: forall a b. (a -> b) -> Source a -> Source b
$c<$ :: forall a b. a -> Source b -> Source a
<$ :: forall a b. a -> Source b -> Source a
Functor)
newtype Target a = Target { forall a. Target a -> a
getTarget :: a } deriving (Int -> Target a -> ShowS
[Target a] -> ShowS
Target a -> String
(Int -> Target a -> ShowS)
-> (Target a -> String) -> ([Target a] -> ShowS) -> Show (Target a)
forall a. Show a => Int -> Target a -> ShowS
forall a. Show a => [Target a] -> ShowS
forall a. Show a => Target a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Target a -> ShowS
showsPrec :: Int -> Target a -> ShowS
$cshow :: forall a. Show a => Target a -> String
show :: Target a -> String
$cshowList :: forall a. Show a => [Target a] -> ShowS
showList :: [Target a] -> ShowS
Show, (forall a b. (a -> b) -> Target a -> Target b)
-> (forall a b. a -> Target b -> Target a) -> Functor Target
forall a b. a -> Target b -> Target a
forall a b. (a -> b) -> Target a -> Target b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Target a -> Target b
fmap :: forall a b. (a -> b) -> Target a -> Target b
$c<$ :: forall a b. a -> Target b -> Target a
<$ :: forall a b. a -> Target b -> Target a
Functor)

-- | Check if one row is a subrow of another
--
-- If it is, returns the paired information from both records. If @a@ is a
-- subrow of @b@, then we can project from @b@ to @a@; for improved clarity,
-- we therefore mark @a@ as the /target/ and @b@ as the source.
--
-- Results are returned in row order of the target.
--
-- See 'NotSubRow' for some discussion of shadowing.
isSubRowOf :: forall a b.
     KnownRow a  -- ^ Target
  -> KnownRow b  -- ^ Source
  -> Either NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
KnownRow a
target isSubRowOf :: forall a b.
KnownRow a
-> KnownRow b
-> Either
     NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
`isSubRowOf` KnownRow b
source =
    if Bool -> Bool
not (KnownRow a -> Bool
forall a. KnownRow a -> Bool
knownRecordAllVisible KnownRow a
target) then
      NotSubRow
-> Either
     NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
forall a b. a -> Either a b
Left NotSubRow
TargetContainsShadowedFields
    else
        ([FieldName]
 -> [(Target (KnownField a), Source (KnownRowField b))]
 -> Either
      NotSubRow [(Target (KnownField a), Source (KnownRowField b))])
-> ([FieldName],
    [(Target (KnownField a), Source (KnownRowField b))])
-> Either
     NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [FieldName]
-> [(Target (KnownField a), Source (KnownRowField b))]
-> Either
     NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
forall x. [FieldName] -> x -> Either NotSubRow x
checkMissing
      (([FieldName], [(Target (KnownField a), Source (KnownRowField b))])
 -> Either
      NotSubRow [(Target (KnownField a), Source (KnownRowField b))])
-> ([Either
       FieldName (Target (KnownField a), Source (KnownRowField b))]
    -> ([FieldName],
        [(Target (KnownField a), Source (KnownRowField b))]))
-> [Either
      FieldName (Target (KnownField a), Source (KnownRowField b))]
-> Either
     NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either
   FieldName (Target (KnownField a), Source (KnownRowField b))]
-> ([FieldName],
    [(Target (KnownField a), Source (KnownRowField b))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
        -- It doesn't matter which order we process 'target' in:
      ([Either
    FieldName (Target (KnownField a), Source (KnownRowField b))]
 -> Either
      NotSubRow [(Target (KnownField a), Source (KnownRowField b))])
-> [Either
      FieldName (Target (KnownField a), Source (KnownRowField b))]
-> Either
     NotSubRow [(Target (KnownField a), Source (KnownRowField b))]
forall a b. (a -> b) -> a -> b
$ (KnownField a
 -> Either
      FieldName (Target (KnownField a), Source (KnownRowField b)))
-> [KnownField a]
-> [Either
      FieldName (Target (KnownField a), Source (KnownRowField b))]
forall a b. (a -> b) -> [a] -> [b]
map KnownField a
-> Either
     FieldName (Target (KnownField a), Source (KnownRowField b))
findInSrc (KnownRow a -> [KnownField a]
forall a. KnownRow a -> [KnownField a]
inRowOrder KnownRow a
target)
  where
    findInSrc ::
         KnownField a
      -> Either FieldName (Target (KnownField a), Source (KnownRowField b))
    findInSrc :: KnownField a
-> Either
     FieldName (Target (KnownField a), Source (KnownRowField b))
findInSrc KnownField a
a =
        case FieldName
-> SmallHashMap FieldName (KnownRowField b)
-> Maybe (KnownRowField b)
forall k a. (Hashable k, Ord k) => k -> SmallHashMap k a -> Maybe a
HashMap.lookup (KnownField a -> FieldName
forall a. KnownField a -> FieldName
knownFieldName KnownField a
a) (KnownRow b -> SmallHashMap FieldName (KnownRowField b)
forall a. KnownRow a -> SmallHashMap FieldName (KnownRowField a)
visibleMap KnownRow b
source) of
          Maybe (KnownRowField b)
Nothing -> FieldName
-> Either
     FieldName (Target (KnownField a), Source (KnownRowField b))
forall a b. a -> Either a b
Left  (FieldName
 -> Either
      FieldName (Target (KnownField a), Source (KnownRowField b)))
-> FieldName
-> Either
     FieldName (Target (KnownField a), Source (KnownRowField b))
forall a b. (a -> b) -> a -> b
$ KnownField a -> FieldName
forall a. KnownField a -> FieldName
knownFieldName KnownField a
a
          Just KnownRowField b
b  -> (Target (KnownField a), Source (KnownRowField b))
-> Either
     FieldName (Target (KnownField a), Source (KnownRowField b))
forall a b. b -> Either a b
Right ((Target (KnownField a), Source (KnownRowField b))
 -> Either
      FieldName (Target (KnownField a), Source (KnownRowField b)))
-> (Target (KnownField a), Source (KnownRowField b))
-> Either
     FieldName (Target (KnownField a), Source (KnownRowField b))
forall a b. (a -> b) -> a -> b
$ (KnownField a -> Target (KnownField a)
forall a. a -> Target a
Target KnownField a
a, KnownRowField b -> Source (KnownRowField b)
forall a. a -> Source a
Source KnownRowField b
b)

    checkMissing :: [FieldName] -> x -> Either NotSubRow x
    checkMissing :: forall x. [FieldName] -> x -> Either NotSubRow x
checkMissing []      x
x = x -> Either NotSubRow x
forall a b. b -> Either a b
Right x
x
    checkMissing [FieldName]
missing x
_ = NotSubRow -> Either NotSubRow x
forall a b. a -> Either a b
Left (NotSubRow -> Either NotSubRow x)
-> NotSubRow -> Either NotSubRow x
forall a b. (a -> b) -> a -> b
$ [FieldName] -> NotSubRow
SourceMissesFields [FieldName]
missing

{-------------------------------------------------------------------------------
  Outputable
-------------------------------------------------------------------------------}

instance Outputable a => Outputable (KnownRow a) where
  ppr :: KnownRow a -> SDoc
ppr = [KnownField a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([KnownField a] -> SDoc)
-> (KnownRow a -> [KnownField a]) -> KnownRow a -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownRow a -> [KnownField a]
forall a. KnownRow a -> [KnownField a]
inRowOrder