Reg.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}

module Descript.Sugar.Data.Value.Reg
  ( Property
  , Record
  , Part (..)
  , Value
  ) where

import Descript.Sugar.Data.Value.Gen
import Descript.Sugar.Data.Atom
import Descript.Misc
import Prelude hiding (head)

-- | A regular property.
type Property an = GenProperty (GenValue Part) an

-- | A regular record.
type Record an = GenRecord (GenValue Part) an

-- | A regular part.
data Part an
  = PartPrim (Prim an)
  | PartRecord (Record an)
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

-- | A regular value.
type Value an = GenValue Part an

instance GenPart Part where
  type PartPropVal Part = GenValue Part

  partToPrim (PartPrim prim) = Just prim
  partToPrim _ = Nothing

  partToRec (PartRecord record) = Just record
  partToRec _ = Nothing

  primToPart _ = PartPrim
  recToPart _ = PartRecord

instance Ann Part where
  getAnn (PartPrim x) = getAnn x
  getAnn (PartRecord x) = getAnn x

instance Printable Part where
  aprintRec sub (PartPrim prim) = sub prim
  aprintRec sub (PartRecord record) = sub record

instance (Show an) => Summary (Part an) where
  summaryRec = pprintSummaryRec