{-# LANGUAGE OverloadedStrings #-}

module Data.ECTA.Internal.Term (
    Symbol(.., Symbol)

  , Term(..)
  ) where


import Data.Hashable ( Hashable(..) )
import qualified Data.Interned as OrigInterned
import Data.Maybe ( maybeToList )
import Data.String (IsString(..) )
import Data.Text ( Text )
import qualified Data.Text as Text
import GHC.Generics ( Generic )
import Text.Read ( Read(..) )

import Data.Interned.Text ( InternedText, internedTextId )


import Control.Lens ( (&), ix, (^?), (%~) )

import Data.ECTA.Paths
import Data.Text.Extended.Pretty

---------------------------------------------------------------
-------------------------- Symbols ----------------------------
---------------------------------------------------------------

data Symbol = Symbol' {-# UNPACK #-} !InternedText
  deriving ( Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Eq Symbol
Eq Symbol
-> (Symbol -> Symbol -> Ordering)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Symbol -> Symbol -> Symbol)
-> Ord Symbol
Symbol -> Symbol -> Bool
Symbol -> Symbol -> Ordering
Symbol -> Symbol -> Symbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Symbol -> Symbol -> Symbol
$cmin :: Symbol -> Symbol -> Symbol
max :: Symbol -> Symbol -> Symbol
$cmax :: Symbol -> Symbol -> Symbol
>= :: Symbol -> Symbol -> Bool
$c>= :: Symbol -> Symbol -> Bool
> :: Symbol -> Symbol -> Bool
$c> :: Symbol -> Symbol -> Bool
<= :: Symbol -> Symbol -> Bool
$c<= :: Symbol -> Symbol -> Bool
< :: Symbol -> Symbol -> Bool
$c< :: Symbol -> Symbol -> Bool
compare :: Symbol -> Symbol -> Ordering
$ccompare :: Symbol -> Symbol -> Ordering
$cp1Ord :: Eq Symbol
Ord )

pattern Symbol :: Text -> Symbol
pattern $bSymbol :: Text -> Symbol
$mSymbol :: forall r. Symbol -> (Text -> r) -> (Void# -> r) -> r
Symbol t <- Symbol' (OrigInterned.unintern -> t) where
  Symbol Text
t = InternedText -> Symbol
Symbol' (Uninterned InternedText -> InternedText
forall t. Interned t => Uninterned t -> t
OrigInterned.intern Uninterned InternedText
Text
t)

{-# COMPLETE Symbol #-}

instance Pretty Symbol where
  pretty :: Symbol -> Text
pretty (Symbol Text
t) = Text
t

instance Show Symbol where
  show :: Symbol -> String
show (Symbol Text
it) = Text -> String
forall a. Show a => a -> String
show Text
it

instance Hashable Symbol where
  hashWithSalt :: Int -> Symbol -> Int
hashWithSalt Int
s (Symbol' InternedText
t) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (InternedText -> Int
internedTextId InternedText
t)

instance IsString Symbol where
  fromString :: String -> Symbol
fromString = Text -> Symbol
Symbol (Text -> Symbol) -> (String -> Text) -> String -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

instance Read Symbol where
  readPrec :: ReadPrec Symbol
readPrec = Text -> Symbol
Symbol (Text -> Symbol) -> ReadPrec Text -> ReadPrec Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Text
forall a. Read a => ReadPrec a
readPrec

---------------------------------------------------------------
---------------------------- Terms ----------------------------
---------------------------------------------------------------

data Term = Term !Symbol ![Term]
  deriving ( Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, Eq Term
Eq Term
-> (Term -> Term -> Ordering)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Term)
-> (Term -> Term -> Term)
-> Ord Term
Term -> Term -> Bool
Term -> Term -> Ordering
Term -> Term -> Term
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Term -> Term -> Term
$cmin :: Term -> Term -> Term
max :: Term -> Term -> Term
$cmax :: Term -> Term -> Term
>= :: Term -> Term -> Bool
$c>= :: Term -> Term -> Bool
> :: Term -> Term -> Bool
$c> :: Term -> Term -> Bool
<= :: Term -> Term -> Bool
$c<= :: Term -> Term -> Bool
< :: Term -> Term -> Bool
$c< :: Term -> Term -> Bool
compare :: Term -> Term -> Ordering
$ccompare :: Term -> Term -> Ordering
$cp1Ord :: Eq Term
Ord, ReadPrec [Term]
ReadPrec Term
Int -> ReadS Term
ReadS [Term]
(Int -> ReadS Term)
-> ReadS [Term] -> ReadPrec Term -> ReadPrec [Term] -> Read Term
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Term]
$creadListPrec :: ReadPrec [Term]
readPrec :: ReadPrec Term
$creadPrec :: ReadPrec Term
readList :: ReadS [Term]
$creadList :: ReadS [Term]
readsPrec :: Int -> ReadS Term
$creadsPrec :: Int -> ReadS Term
Read, Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show, (forall x. Term -> Rep Term x)
-> (forall x. Rep Term x -> Term) -> Generic Term
forall x. Rep Term x -> Term
forall x. Term -> Rep Term x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Term x -> Term
$cfrom :: forall x. Term -> Rep Term x
Generic )

instance Hashable Term

instance Pretty Term where
  pretty :: Term -> Text
pretty (Term Symbol
s [])            = Symbol -> Text
forall a. Pretty a => a -> Text
pretty Symbol
s
  pretty (Term Symbol
s [Term]
ts)            = Symbol -> Text
forall a. Pretty a => a -> Text
pretty Symbol
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Term -> Text) -> [Term] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Text
forall a. Pretty a => a -> Text
pretty [Term]
ts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

---------------------
------ Term ops
---------------------

instance Pathable Term Term where
  type Emptyable Term = Maybe Term

  getPath :: Path -> Term -> Emptyable Term
getPath Path
EmptyPath       Term
t           = Term -> Maybe Term
forall a. a -> Maybe a
Just Term
t
  getPath (ConsPath Int
p Path
ps) (Term Symbol
_ [Term]
ts) = case [Term]
ts [Term] -> Getting (First Term) [Term] Term -> Maybe Term
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index [Term] -> Traversal' [Term] (IxValue [Term])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [Term]
p of
                                          Maybe Term
Nothing -> Emptyable Term
forall a. Maybe a
Nothing
                                          Just Term
t  -> Path -> Term -> Emptyable Term
forall t t'. Pathable t t' => Path -> t -> Emptyable t'
getPath Path
ps Term
t

  getAllAtPath :: Path -> Term -> [Term]
getAllAtPath Path
p Term
t = Maybe Term -> [Term]
forall a. Maybe a -> [a]
maybeToList (Maybe Term -> [Term]) -> Maybe Term -> [Term]
forall a b. (a -> b) -> a -> b
$ Path -> Term -> Emptyable Term
forall t t'. Pathable t t' => Path -> t -> Emptyable t'
getPath Path
p Term
t

  modifyAtPath :: (Term -> Term) -> Path -> Term -> Term
modifyAtPath Term -> Term
f Path
EmptyPath       Term
t           = Term -> Term
f Term
t
  modifyAtPath Term -> Term
f (ConsPath Int
p Path
ps) (Term Symbol
s [Term]
ts) = Symbol -> [Term] -> Term
Term Symbol
s ([Term]
ts [Term] -> ([Term] -> [Term]) -> [Term]
forall a b. a -> (a -> b) -> b
& Index [Term] -> Traversal' [Term] (IxValue [Term])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [Term]
p ((Term -> Identity Term) -> [Term] -> Identity [Term])
-> (Term -> Term) -> [Term] -> [Term]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Term -> Term) -> Path -> Term -> Term
forall t t'. Pathable t t' => (t' -> t') -> Path -> t -> t
modifyAtPath Term -> Term
f Path
ps)