jrec/bin/genrecord

#!/usr/bin/env cabal

{-# LANGUAGE OverloadedStrings #-}

{- cabal:
build-depends: base, fmt
-}

import Data.List
import Fmt

main = do
  let n = 62 -- max tuple size
  putStrLn
    "-- Generated with cabal run -v0 bin/genrecord > src/JRec/Tuple.hs\n\
    \\n\
    \module JRec.Tuple where\n\
    \\n\
    \import qualified JRec.Internal as R\n\
    \import Unsafe.Coerce\n\
    \\n\
    \class RecTuple tuple fields | tuple -> fields, fields -> tuple where\n\
    \  fromTuple :: tuple -> R.Rec fields\n\
    \  toTuple :: R.Rec fields -> tuple\n\
    \\n\
    \"
  mapM_ (putStrLn . genInstance) [0 .. n]

genInstance :: Int -> String
genInstance 0 =
  "instance RecTuple () '[] where\n\
  \  fromTuple _ = R.rnil\n\
  \  toTuple _ = ()\n\
  \"
genInstance i =
  let fromTuple, toTuple, constraints :: Builder
      fromTuple =
        format
          "fromTuple {} = R.create $ {} R.unsafeRNil {}"
          exprTuple
          consApps
          i
      toTuple =
        format
          "toTuple r = let n = R.FldProxy :: R.FldProxy \"\" in unsafeCoerce {}"
          exprGetTuple
      constraints =
        tupleF $
          [format "n{} ~ n{}'" j j :: Builder | j <- [1 .. i]]
            ++ [format "v{} ~ v{}'" j j :: Builder | j <- [1 .. i]]
   in format
        "instance {} => RecTuple {} {} where\n\
        \  {}\n\
        \  {}\n\
        \"
        constraints
        typeTuple
        typeList
        fromTuple
        toTuple
  where
    -- '[n1' R.:= v1', n2' R.:= v2']
    typeList = "'" <> listF [format "n{}' R.:= v{}'" j j :: Builder | j <- [1 .. i]]
    -- (n1 R.:= v1, n2 R.:= v2)
    typeTuple = tupleF [format "n{} R.:= v{}" j j :: Builder | j <- [1 .. i]]
    -- (f1, f2)
    exprTuple = tupleF ["f" <> show j | j <- [1 .. i]]
    -- [f1, f2]
    exprList = listF ["f" <> show j | j <- [1 .. i]]
    -- R.unsafeRCons f1 $ R.unsafeRCons f2 $
    consApps = mconcat [format "R.unsafeRCons f{} =<< " j :: Builder | j <- [1 .. i]]
    -- (n R.:= R.unsafeGet 0 r, n R.:= R.unsafeGet 1 r)
    exprGetTuple = tupleF [format "n R.:= R.unsafeGet {} r" j :: Builder | j <- [0 .. i-1]]