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'
  , encodeOrShowData'
  , decodeDataWith
  , encodeDataWith'
  , decodeTest
  , decodeDataTest
  , DataIso(..)
  , DatumIso(..)
  -- * generics
  , with
  , match
  , Coproduct(..)
  , fromDatumUnsafe
  , Control.Category.id
  , fromDataUnsafe
  , writeDatum
  , writeData
  )
  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
import System.Environment (lookupEnv)
import Data.Foldable (toList)


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

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

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

encodeOrShowData :: (IsString s, Show a) => DataGrammar a -> a -> s
encodeOrShowData g x = fromString $
  case runPureEff . runJalmot . encodeDataWith g $ x of
    Left _ -> show x
    Right t -> T.unpack t

useColour :: IO Bool
useColour = maybe True (const False) <$> lookupEnv "NO_COLOR"

writeDatum :: (Show a, DatumIso a, MonadIO m) => a -> m ()
writeDatum x = do
  c <- liftIO useColour 
  let f = if c then encodeOrShow else encodeOrShow'
  liftIO . TIO.putStrLn . f datumIso $ x

writeData :: (Show a, DataIso a, MonadIO m) => a -> m ()
writeData x = do
  c <- liftIO useColour 
  let f = if c then encodeOrShowData else encodeOrShowData'
  liftIO . TIO.putStrLn . f dataIso $ x

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 => DataIso (NonEmpty a) where
  dataIso = nonEmptyData datumIso

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