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

module Descript.BasicInj.Data.Atom.PropPath
  ( PropPath (..)
  , SubPropPath
  , PathElem (..)
  , immPath
  , subPath
  , appendSubpath
  , stripPrefixPath
  ) where

import Descript.BasicInj.Data.Atom.Scope
import Descript.Lex.Data.Atom
import Descript.Misc
import Data.Monoid
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Core.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
  = PathElem
  { pathElemAnn :: an
  , keyRef :: Symbol an -- ^ Refers to the property key (e.g. `a`).
  , headRef :: FSymbol an -- ^ Refers to the type of record (e.g. `Foo`).
  } deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

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

instance Ann PathElem where
  getAnn = pathElemAnn

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

instance Printable PathElem where
  aprintRec sub (PathElem _ key head') = sub key <> pimp ("<" <> 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

-- | Adds the elements in the subpath to the end of the path.
appendSubpath :: PropPath () -> SubPropPath () -> PropPath ()
appendSubpath (PropPath () (x :| xs)) suf = PropPath () $ x :| xs ++ suf

-- | If the second path starts with the first, returns the part after.
-- Otherwise returns 'Nothing'.
stripPrefixPath :: PropPath () -> PropPath () -> Maybe (SubPropPath ())
PropPath _ xs `stripPrefixPath` PropPath _ ys
  = xs `NonEmpty.stripPrefix` ys