PropPath.hs

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

module Descript.Free.Data.Atom.PropPath
  ( PropPath (..)
  , SubPropPath
  , PathElem (..)
  , immPath
  , subPath
  , mkPathElem
  ) where

import Descript.Lex.Data.Atom
import Descript.Misc
import Data.Monoid
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty

-- | A property path. Refers to a top-level value's property, or
-- property of a property, or property of a property of a property, etc.
data PropPath an
  = PropPath an (NonEmpty (PathElem an))
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

-- | A part of a property path. It can refer to a top-level value, or
-- a property, or a property of a property, etc.
type SubPropPath an = [PathElem an]

-- | A property path element. Refers to a property key in a type of
-- record. For example, `a<Foo` would refer to `5` in `Foo[a: 5]`.
data PathElem an
  = PathElemImp (Symbol an)
  | PathElemExp an (Symbol an) (Symbol an)
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

instance Ann PropPath where
  getAnn (PropPath ann _) = ann

instance Ann PathElem where
  getAnn (PathElemImp x) = getAnn x
  getAnn (PathElemExp ann _ _) = ann

instance Printable PropPath where
  aprintRec sub (PropPath _ elems) = pintercal ">" $ map sub $ NonEmpty.toList elems

instance Printable PathElem where
  aprintRec sub (PathElemImp key) = sub key
  aprintRec sub (PathElemExp _ key head') = sub key <> "<" <> sub head'

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

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

-- | A 'PropPath' with 1 element.
immPath :: PathElem () -> PropPath ()
immPath x = PropPath () $ x :| []

-- | Prepends the element to the path.
subPath :: PathElem () -> PropPath () -> PropPath ()
subPath x (PropPath () xs) = PropPath () $ x NonEmpty.<| xs

-- | Creates an implicit element if the head reference is 'Nothing', or
-- an explicit one if it's something.
mkPathElem :: an -> Symbol an -> Maybe (Symbol an) -> PathElem an
mkPathElem _ key Nothing = PathElemImp key
mkPathElem ann key (Just head') = PathElemExp ann key head'