In.hs

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

module Descript.Sugar.Data.Value.In
  ( Property
  , Record
  , Part (..)
  , Value
  , OptValue (..)
  , optValToMaybeVal
  , maybeValToOptVal
  , mapOptVal
  , traverseOptVal
  ) where

import Descript.Sugar.Data.Value.Gen
import Descript.Sugar.Data.Atom
import Descript.Misc

-- | An input property.
type Property an = GenProperty OptValue an

-- | An input record.
type Record an = GenRecord OptValue an

-- | An input part.
data Part an
  = PartPrim (Prim an)
  | PartPrimType (PrimType an)
  | PartRecord (Record an)
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

-- | An input value.
type Value an = GenValue Part an

-- | Either nothing or a value. Composition of 'Maybe' and 'Value'.
data OptValue an
  = NothingValue
  | JustValue (Value an)
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

instance GenPropVal OptValue where
  doesPrint NothingValue = False
  doesPrint (JustValue _) = True

instance GenPart Part where
  type PartPropVal Part = OptValue

  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 (PartPrimType x) = getAnn x
  getAnn (PartRecord x) = getAnn x

instance FwdPrintable OptValue where
  afprintRec _ NothingValue = mempty
  afprintRec sub (JustValue x) = sub x

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

instance (Show an) => Summary (OptValue an) where
  summaryRec sub = pprintSummaryRecF sub

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

-- | Converts the 'OptValue' to an equivalent maybe value.
optValToMaybeVal :: OptValue an -> Maybe (Value an)
optValToMaybeVal NothingValue = Nothing
optValToMaybeVal (JustValue val) = Just val

-- | Converts the maybe value to an equivalent 'OptValue'.
maybeValToOptVal :: Maybe (Value an) -> OptValue an
maybeValToOptVal Nothing = NothingValue
maybeValToOptVal (Just val) = JustValue val

-- | Transform the value.
mapOptVal :: (Value an1 -> Value an2) -> OptValue an1 -> OptValue an2
mapOptVal _ NothingValue = NothingValue
mapOptVal f (JustValue x) = JustValue $ f x

-- | Transform the value with side effects if it exists.
traverseOptVal :: (Applicative w)
               => (Value an1 -> w (Value an2))
               -> OptValue an1
               -> w (OptValue an2)
traverseOptVal _ NothingValue = pure NothingValue
traverseOptVal f (JustValue x) = JustValue <$> f x