package CShow where

import ListN
import Vector

{-
 - Classic (Haskell)-syntax version of FShow, using generics.
 -}

--@ XXX THIS PACKAGE IS NOT YET DOCUMENTED

class CShow a where
  -- Show a top-level value with classic syntax
  cshow :: a -> Fmt

  -- Unambigously show a value with parentheses, if required
  cshowP :: a -> Fmt
  cshowP = cshow

-- Explicit instances for various primitive types
instance CShow (Bit n) where
  cshow x = $format "0x%h" x

instance CShow (UInt a) where
  cshow x = $format "%d" x

instance CShow (Int a) where
  cshow x = $format "%d" x

instance CShow Real where
  cshow x = $format (realToString x)

instance CShow Char where
  cshow x = $format "'%s'" (charToString x)

instance CShow String where
  cshow x = $format "\"%s\"" x

instance CShow Fmt where
  cshow = id

-- Show tuple types with tuple syntax rather than PrimPair {...}
instance CShow () where
  cshow () = $format "()"

instance (CShowTuple (a, b)) => CShow (a, b) where
  cshow x = $format "(" (cshowTuple x) ")"

class CShowTuple a where
  cshowTuple :: a -> Fmt

instance (CShow a, CShowTuple b) => CShowTuple (a, b) where
  cshowTuple (x, y) = $format (cshow x) ", " (cshowTuple y)

instance (CShow a) => CShowTuple a where
  cshowTuple = cshow

-- Default generic instance uses the CShow' type class over generic representations
instance (Generic a r, CShow' r) => CShow a where
  cshow x = cshow' $ from x
  cshowP x = cshowP' $ from x

class CShow' a where
  cshow' :: a -> Fmt
  cshowP' :: a -> Fmt
  cshowP' = cshow'

-- Note that there is no instance for CShow' ConcPrim - all showable primitive
-- types should eventually have CShow instances.  This is because there is no
-- generic way to show any primitive type.

instance (CShow a) => CShow' (Conc a) where
  cshow' (Conc x) = cshow x
  cshowP' (Conc x) = cshowP x

-- Note that below there are more specific instances for
-- CShow' (Meta (MetaConsNamed ...)) and CShow' (Meta (MetaConsAnon ...))
instance (CShow' a) => CShow' (Meta m a) where
  cshow' (Meta x) = cshow' x
  cshowP' (Meta x) = cshowP' x

instance (CShow' a, CShow' b) => CShow' (Either a b) where
  cshow' (Left x) = cshow' x
  cshow' (Right x) = cshow' x
  cshowP' (Left x) = cshowP' x
  cshowP' (Right x) = cshowP' x

instance (CShowSummand a) => CShow' (Meta (MetaConsNamed name idx nfields) a) where
  cshow' (Meta x) = $format (stringOf name) " {" (cshowSummandNamed x) "}"
  cshowP' x = $format "(" (cshow' x) ")"

instance (CShowSummand a) => CShow' (Meta (MetaConsAnon name idx nfields) a) where
  cshow' (Meta x) = $format (stringOf name) (cshowSummandAnon x)
  cshowP' x = if (valueOf nfields) > 0 then $format "(" (cshow' x) ")" else cshow' x

-- Defines the classic-syntax show operation for the representation type of a
-- single summand's constructor.
-- We only know whether a constructor is named or anonymous at the top of the
-- constructor's representation type, so we propagate that information by calling
-- the appropriate function of this type class.
class CShowSummand a where
  cshowSummandNamed :: a -> Fmt
  cshowSummandAnon  :: a -> Fmt

instance (CShowSummand a, CShowSummand b) => CShowSummand (a, b) where
  cshowSummandNamed (x, y) = $format (cshowSummandNamed x) (cshowSummandNamed y)
  cshowSummandAnon  (x, y) = $format (cshowSummandAnon x) (cshowSummandAnon y)

instance CShowSummand () where
  cshowSummandNamed () = $format ""
  cshowSummandAnon  () = $format ""

instance (CShow' a) => CShowSummand (Meta (MetaField name idx) a) where
  cshowSummandNamed (Meta x) = $format (if valueOf idx > 0 then "; " else "") (stringOf name) "=" (cshow' x)
  cshowSummandAnon  (Meta x) = $format " " (cshowP' x)

-- CShow for collection types uses [] mirroring Haskell, even though we don't
-- actually support that syntax for constructing values.
instance (CShow' a) => CShow' (Vector n a) where
  cshow' v =
    let contents =
          if valueOf n > 0
          then List.foldr1 (\ a b -> $format a ", " b) $ List.map cshow' $ Vector.toList v
          else $format ""
    in $format "[" contents "]"