{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{-|
Module      : Polytropos.Cassava
Description : cassava CSV codecs for Polytropos open records
Copyright   : (c) 2026 The Polytropos Authors
License     : EUPL-1.2 OR Apache-2.0
Maintainer  : nadia.yvette.chambers@ik.me
Stability   : experimental
Portability : non-portable (GHC extensions)

Connects @polytropos@ open records to the standard Haskell CSV library
@cassava@ without intermediate nominal conversions: 'Csv.ToNamedRecord'
serializes field names and values straight from the flat
@t'Polytropos.Core.Rep'@ payload, and 'Csv.FromNamedRecord' looks up each field
label in the CSV header map in \(O(1)\).

= Architectural Overview & Rationale

== Heterogeneous Row Support

Unlike satellites that require homogeneous rows, @polytropos-cassava@ is
genuinely heterogeneous: the 'AllToField' and 'AllFromField' row constraint walks
require the CSV field classes ('Csv.ToField' \/ 'Csv.FromField') at /each field's own type/,
so a row mixing @String@, @Int@, and @Double@ columns encodes and decodes directly.

Decoding is strict about field presence (a missing header column fails),
but ignores extra columns in the CSV input, matching cassava's own generic behaviour.

= When to Use This Module

* When reading or writing CSV files, spreadsheets, or tabular datasets using open records.

= Worked Example

> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE OverloadedStrings #-}
> {-# LANGUAGE TypeApplications #-}
> {-# OPTIONS_GHC -fplugin=Polytropos.Plugin #-}
>
> import qualified Data.Csv as Csv
> import Polytropos
> import Polytropos.Cassava
>
> type UserRow = Record '["username" ':= String, "score" ':= Int]
>
> row :: UserRow
> row = REC { username = "Alice", score = 95 }
>
> -- Encodes to CSV named record:
> namedRec = Csv.toNamedRecord row
-}
module Polytropos.Cassava
  ( -- * Row Constraint Walks
    AllToField (..)
  , AllFromField (..)

    -- * Row Introspection
  , FieldNames (..)
  ) where

import Data.Functor.Identity (Identity (..))
import Data.Proxy           (Proxy (..))
import GHC.Exts             (Any, toList)
import GHC.TypeLits         (KnownSymbol, symbolVal)
import Polytropos           (Record)
import Polytropos.Core      (Pair (..), Row, RowRep (..), noInlineUnsafeCo,
                              productRep, repVals)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Csv            as Csv

{-------------------------------------------------------------------------------
  Row introspection
-------------------------------------------------------------------------------}

-- | The field names of a row, in row order, reified from the type level.
class FieldNames (r :: Row) where
  fieldNames :: Proxy r -> [String]

instance FieldNames '[] where
  fieldNames :: Proxy '[] -> [String]
fieldNames Proxy '[]
_ = []

instance (KnownSymbol n, FieldNames r) => FieldNames ((n ':= a) ': r) where
  fieldNames :: Proxy ((n ':= a) : r) -> [String]
fieldNames Proxy ((n ':= a) : r)
_ = Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @n) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Proxy r -> [String]
forall (r :: Row). FieldNames r => Proxy r -> [String]
fieldNames (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r)

{-------------------------------------------------------------------------------
  Row constraint walk
-------------------------------------------------------------------------------}

-- | Evidence that every field of the row @r@ has a 'Csv.ToField' instance
-- at that field's own type — the heterogeneous analogue of a constraint
-- fold. The walk applies @toField@ to each erased payload slot exactly where
-- the row structure guarantees the slot's type.
class AllToField (r :: Row) where
  encFields :: Proxy r -> [Identity Any] -> [BS8.ByteString]

instance AllToField '[] where
  encFields :: Proxy '[] -> [Identity Any] -> [ByteString]
encFields Proxy '[]
_ [Identity Any]
_ = []

instance (KnownSymbol n, Csv.ToField a, AllToField r)
      => AllToField ((n ':= a) ': r) where
  encFields :: Proxy ((n ':= a) : r) -> [Identity Any] -> [ByteString]
encFields Proxy ((n ':= a) : r)
_ (Identity Any
x : [Identity Any]
xs) =
    a -> ByteString
forall a. ToField a => a -> ByteString
Csv.toField (Any -> a
forall a b. a -> b
noInlineUnsafeCo Any
x :: a) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Proxy r -> [Identity Any] -> [ByteString]
forall (r :: Row).
AllToField r =>
Proxy r -> [Identity Any] -> [ByteString]
encFields (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r) [Identity Any]
xs
  encFields Proxy ((n ':= a) : r)
_ [] = String -> [ByteString]
forall a. HasCallStack => String -> a
error String
"polytropos-cassava: payload arity mismatch"

-- | Heterogeneous decode walk: every field of the row @r@ has a
-- 'Csv.FromField' instance at its own type, and 'decFields' looks each
-- column up by name in O(1).
class AllFromField (r :: Row) where
  decFields :: Proxy r -> Csv.NamedRecord -> Csv.Parser [Identity Any]

instance AllFromField '[] where
  decFields :: Proxy '[] -> NamedRecord -> Parser [Identity Any]
decFields Proxy '[]
_ NamedRecord
_ = [Identity Any] -> Parser [Identity Any]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance (KnownSymbol n, Csv.FromField a, AllFromField r)
      => AllFromField ((n ':= a) ': r) where
  decFields :: Proxy ((n ':= a) : r) -> NamedRecord -> Parser [Identity Any]
decFields Proxy ((n ':= a) : r)
_ NamedRecord
nr = do
    v <- NamedRecord
nr NamedRecord -> ByteString -> Parser a
forall a. FromField a => NamedRecord -> ByteString -> Parser a
Csv..: String -> ByteString
BS8.pack (Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @n)) :: Csv.Parser a
    vs <- decFields (Proxy @r) nr
    pure (Identity (noInlineUnsafeCo v :: Any) : vs)

{-------------------------------------------------------------------------------
  cassava instances
-------------------------------------------------------------------------------}

instance (FieldNames r, AllToField r) => Csv.ToNamedRecord (Record r) where
  toNamedRecord :: Record r -> NamedRecord
toNamedRecord (RowRep Rep Identity ()
rep) = [(ByteString, ByteString)] -> NamedRecord
Csv.namedRecord
    ([ByteString] -> [ByteString] -> [(ByteString, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BS8.pack (Proxy r -> [String]
forall (r :: Row). FieldNames r => Proxy r -> [String]
fieldNames (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r)))
         (Proxy r -> [Identity Any] -> [ByteString]
forall (r :: Row).
AllToField r =>
Proxy r -> [Identity Any] -> [ByteString]
encFields (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r) (SmallArray (Identity Any) -> [Item (SmallArray (Identity Any))]
forall l. IsList l => l -> [Item l]
toList (Rep Identity () -> SmallArray (Identity Any)
forall {k} (f :: * -> *) (a :: k). Rep f a -> SmallArray (f Any)
repVals Rep Identity ()
rep))))

instance AllFromField r => Csv.FromNamedRecord (Record r) where
  parseNamedRecord :: NamedRecord -> Parser (Record r)
parseNamedRecord NamedRecord
nr = do
    vs <- Proxy r -> NamedRecord -> Parser [Identity Any]
forall (r :: Row).
AllFromField r =>
Proxy r -> NamedRecord -> Parser [Identity Any]
decFields (forall (t :: Row). Proxy t
forall {k} (t :: k). Proxy t
Proxy @r) NamedRecord
nr
    pure (RowRep (productRep vs))