module Gyehoek.Sexp.Grammar
  ( module Gyehoek.Sexp.Grammar.Base
  , module Data.InvertibleGrammar.Combinators
  , (>>>)
  , toDatum
  , fromDatum
  , toData
  , fromData
  , encodeWith
  , encodeWith'
  , encodeDataWith
  , decodeWith
  , encodeTest
  , encodeTestColour
  , encodeDataTest
  , encodeDataTestColour
  , encodeOrShow'
  , decodeDataWith
  , encodeDataWith'
  , decodeTest
  , decodeDataTest
  , DataIso(..)
  , DatumIso(..)
  -- * generics
  , with
  , match
  , Coproduct(..)
  , fromDatumUnsafe
  , Control.Category.id
  , fromDataUnsafe
  )
  where

import Gyehoek.Sexp.Grammar.Base
import Gyehoek.Prelude hiding (snoc, Iso, flipped, cons, traversed, iso)
import Data.InvertibleGrammar (backward, sealed, forward, runGrammar)
import Gyehoek.Sexp.Print (printDatum, printDatum', printData, printData')
import Gyehoek.Jalmot
import Data.InvertibleGrammar.Combinators
import qualified Gyehoek.Sexp.Read as Read
import qualified Data.Text.IO as TIO
import Text.Pretty.Simple (pPrintNoColor)
import Data.InvertibleGrammar.Generic
import qualified Control.Category
import qualified Data.Vector as V
import Data.String (IsString (fromString))
import qualified Data.Text as T


toDatum :: Jalmot :> es => DatumGrammar a -> a -> Eff es Datum
toDatum g =
  backward (sealed g)
  >>> runGrammar noAnn
  >>> either (throwError . GrammarError) pure

toData :: Jalmot :> es => DataGrammar a -> a -> Eff es (List Datum)
toData g =
  backward (sealed g)
  >>> runGrammar noAnn
  >>> either (throwError . GrammarError) pure

fromDatum :: (HasCallStack, Jalmot :> es) => DatumGrammar a -> Datum -> Eff es a
fromDatum g =
  forward (sealed g)
  >>> runGrammar noAnn
  >>> either (throwError . GrammarError) pure

fromDatumUnsafe :: HasCallStack => DatumGrammar a -> Datum -> a
fromDatumUnsafe g = runJalmotUnsafe . fromDatum g

fromDataUnsafe :: HasCallStack => DataGrammar a -> List Datum -> a
fromDataUnsafe g = runJalmotUnsafe . fromData g

fromData
  :: (HasCallStack, Jalmot :> es)
  => DataGrammar a -> List Datum -> Eff es a
fromData g =
  forward (sealed g)
  >>> runGrammar noAnn
  >>> either (throwError . GrammarError) pure

encodeWith :: Jalmot :> es => DatumGrammar a -> a -> Eff es Text
encodeWith g = toDatum g >>> fmap printDatum

encodeDataWith :: Jalmot :> es => DataGrammar a -> a -> Eff es Text
encodeDataWith g = toData g >>> fmap printData

encodeDataWith' :: Jalmot :> es => DataGrammar a -> a -> Eff es Text
encodeDataWith' g = toData g >>> fmap printData'

encodeWith' :: Jalmot :> es => DatumGrammar a -> a -> Eff es Text
encodeWith' g = toDatum g >>> fmap printDatum'

decodeWith :: forall es a. Jalmot :> es => DatumGrammar a -> Text -> Eff es a
decodeWith g = Read.readString1 @es >=> fromDatum g

decodeDataWith
  :: forall es a. Jalmot :> es => DataGrammar a -> Text -> Eff es a
decodeDataWith g = Read.readString @es >=> fromData g

-- | run a grammar, quick and dirty.
decodeTest :: Show a => DatumGrammar a -> Text -> IO ()
decodeTest g = pPrintNoColor <=< (runJalmotIO . decodeWith g)

-- | run a grammar, quick and dirty.
encodeTest :: DatumGrammar a -> a -> IO ()
encodeTest g = TIO.putStrLn <=< (runJalmotIO . encodeWith' g)

-- | run a grammar, quick and dirty.
encodeTestColour :: DatumGrammar a -> a -> IO ()
encodeTestColour g = TIO.putStrLn <=< (runJalmotIO . encodeWith g)

encodeDataTest :: DataGrammar a -> a -> IO ()
encodeDataTest g = TIO.putStrLn <=< (runJalmotIO . encodeDataWith' g)

encodeDataTestColour :: DataGrammar a -> a -> IO ()
encodeDataTestColour g = TIO.putStrLn <=< (runJalmotIO . encodeDataWith g)

-- | run a grammar, quick and dirty.
decodeDataTest :: Show a => DataGrammar a -> Text -> IO ()
decodeDataTest g = pPrintNoColor <=< (runJalmotIO . decodeDataWith g)

encodeOrShow' :: (IsString s, Show a) => DatumGrammar a -> a -> s
encodeOrShow' g x = fromString $
  case runPureEff . runJalmot . encodeWith' g $ x of
    Left _ -> show x
    Right t -> T.unpack t

class DatumIso a where
  datumIso :: DatumGrammar a

class DataIso a where
  dataIso :: DataGrammar a



instance DatumIso a => DatumIso (List a) where
  datumIso = list $ rest datumIso

instance DatumIso Bool where datumIso = boolean

instance DatumIso Int where datumIso = int

instance DatumIso Datum where datumIso = Control.Category.id

instance DatumIso a => DataIso (List a) where
  dataIso = onHead . traversed . sealed $ datumIso @a

instance DatumIso a => DataIso (V.Vector a) where
  dataIso = iso fromList V.toList
    >>> (onHead . traversed . sealed $ datumIso @a)

instance (DatumIso a, DatumIso b) => DatumIso (a, b) where
  datumIso = with \tup2 -> list (el datumIso >>> el datumIso) >>> tup2