{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module Gyehoek.Sexp
  ( let_
  , sexp
  , nonempty
  , nonEmptyGrammar
  , encode
  , decode
  )
where

import Data.Text (Text)
import Language.SexpGrammar as Sexp hiding (List, encode, decode, iso)
import Language.SexpGrammar qualified as Sexp
import Language.SexpGrammar.Generic
import Data.InvertibleGrammar.Base qualified as IGB
import Data.InvertibleGrammar qualified as IG
import Data.InvertibleGrammar.Base ((:-)((:-)))
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List (List)
import Data.Text.Encoding
import Data.Either (either)
import GHC.Generics (Generic)
import Control.Lens


sexp :: SexpIso a => Iso' a Text
sexp = iso
  (either error id . encode)
  (either error id . decode)

encode :: SexpIso a => a -> Either String Text
encode = (_Right %~ decodeUtf8 . view strict) . Sexp.encode

decode :: SexpIso a => Text -> Either String a
decode = Sexp.decode . view lazy . encodeUtf8

nonEmptyGrammar :: Grammar p (NonEmpty x :- t) (List x :- x :- t)
nonEmptyGrammar = IGB.Iso
  (\((x:|xs) :- t) -> xs :- x :- t)
  (\(xs :- x :- t) -> (x:|xs) :- t)

nonempty :: SexpGrammar a -> SexpGrammar (NonEmpty a)
nonempty a =
  list (el a >>> rest a) >>>
    IG.flipped nonEmptyGrammar

let_
  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> (forall t. Grammar Position (Sexp :- t) (b :- t))
  -> Grammar Position (Sexp :- (NonEmpty (a, b) :- t1)) t2
  -> Grammar Position (Sexp :- t1) t2
let_ name rhs e = list (el (sym "let") >>> el bindings >>> el e)
  where
    -- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
    bindings = nonempty binding
    binding :: Grammar Position (Sexp :- t) ((_, _) :- t)
    binding = list (el name >>> el rhs) >>> pair

data DotList a = MkDotList (NonEmpty a) a
  deriving (Show, Generic)

dotlist :: (forall t. Grammar Position (Sexp :- t) (a :- t)) -> _
dotlist x = list $ rest $ coproduct
  [ x >>> _
  ]

lambda
  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (Sexp :- List a :- t1) t2
  -> Grammar Position (Sexp :- t1) t2
lambda name e = list $
  el (sym "lambda")
  >>> el (list $ rest name)
  >>> el e