-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
--
-- SPDX-License-Identifier: MPL-2.0

{- | Core of the @nyan-interpolation@ library.

Use it to define your own variation of the interpolator,
customizing the default switches and other parameters to your preferences.

@
int :: QuasiQuoter
int = mkInt defaultInterpolatorOptions
  { defaultSwitchesOptions = recommendedDefaultSwitchesOptions
    { defSpacesTrimming = Just True
    }
  }
@

-}
module Text.Interpolation.Nyan.Core
  ( -- * Interpolator
    mkInt
    -- * Interpolator options
  , InterpolatorOptions
  , defaultInterpolatorOptions
    -- ** Field accessors for interpolator options
  , defaultSwitchesOptions
  , valueInterpolator
  , invisibleCharsPreview
    -- * Default switches options
  , DefaultSwitchesOptions
  , basicDefaultSwitchesOptions
  , recommendedDefaultSwitchesOptions
    -- ** Field accessors for default switches options
  , defSpacesTrimming
  , defIndentationStripping
  , defLeadingNewlineStripping
  , defTrailingSpacesStripping
  , defReducedNewlines
  , defReturnType
  , defMonadic

    -- * Value interpolators
  , ValueInterpolator (..)
  , simpleValueInterpolator
  , tickedValueInterpolator

    -- * Adjusting preview
  , InvisibleCharsPreview (..)
  , simpleInvisibleCharsPreview

    -- * Rendering modes
  , RMode (..)

    -- * Re-exports
  , TH.QuasiQuoter

  , nyan
  ) where

import qualified Data.Text as T
import qualified Language.Haskell.TH.Quote as TH

import Text.Interpolation.Nyan.Core.Internal.Base
import Text.Interpolation.Nyan.Core.Internal.Parser
import Text.Interpolation.Nyan.Core.Internal.Processor
import Text.Interpolation.Nyan.Core.Internal.RMode
import Text.Interpolation.Nyan.Core.Internal.Splice

import Control.Concurrent
import qualified Data.Text as T
import GHC.IO.Handle
import System.Process

-- | Construct an interpolator.
--
-- Usually you pass some options here that you consider canonical and use
-- the resulting interolator throughout your project.
mkInt :: InterpolatorOptions -> TH.QuasiQuoter
mkInt :: InterpolatorOptions -> QuasiQuoter
mkInt InterpolatorOptions
iopts = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp = \String
s -> do
      (SwitchesOptions
sopts, ParsedInterpolatedString
sint) <-
        (String -> Q (SwitchesOptions, ParsedInterpolatedString))
-> ((SwitchesOptions, ParsedInterpolatedString)
    -> Q (SwitchesOptions, ParsedInterpolatedString))
-> Either String (SwitchesOptions, ParsedInterpolatedString)
-> Q (SwitchesOptions, ParsedInterpolatedString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Q (SwitchesOptions, ParsedInterpolatedString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SwitchesOptions, ParsedInterpolatedString)
-> Q (SwitchesOptions, ParsedInterpolatedString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (SwitchesOptions, ParsedInterpolatedString)
 -> Q (SwitchesOptions, ParsedInterpolatedString))
-> Either String (SwitchesOptions, ParsedInterpolatedString)
-> Q (SwitchesOptions, ParsedInterpolatedString)
forall a b. (a -> b) -> a -> b
$
        DefaultSwitchesOptions
-> Text
-> Either String (SwitchesOptions, ParsedInterpolatedString)
parseIntString (InterpolatorOptions -> DefaultSwitchesOptions
defaultSwitchesOptions InterpolatorOptions
iopts) (String -> Text
T.pack String
s)
      let sint' :: InterpolatedString
sint' = SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
processIntString SwitchesOptions
sopts ParsedInterpolatedString
sint
      InterpolatorOptions
-> (SwitchesOptions, InterpolatedString) -> Q Exp
intSplice InterpolatorOptions
iopts (SwitchesOptions
sopts, InterpolatedString
sint')
  , quotePat :: String -> Q Pat
TH.quotePat = \String
_ ->
      String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot interpolate at pattern position"
  , quoteType :: String -> Q Type
TH.quoteType = \String
_ ->
      String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot interpolate at type position"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec = \String
_ ->
      String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot interpolate at declaration position"
  }

-- | The most interpolator options.
--
-- * Tries to keep the text as much unchanged as possible.
-- * Interpolates only variables.
defaultInterpolatorOptions :: InterpolatorOptions
defaultInterpolatorOptions :: InterpolatorOptions
defaultInterpolatorOptions = InterpolatorOptions :: DefaultSwitchesOptions
-> ValueInterpolator
-> InvisibleCharsPreview
-> InterpolatorOptions
InterpolatorOptions
  { defaultSwitchesOptions :: DefaultSwitchesOptions
defaultSwitchesOptions = DefaultSwitchesOptions
basicDefaultSwitchesOptions
  , valueInterpolator :: ValueInterpolator
valueInterpolator = ValueInterpolator
simpleValueInterpolator
  , invisibleCharsPreview :: InvisibleCharsPreview
invisibleCharsPreview = InvisibleCharsPreview
simpleInvisibleCharsPreview
  }

nyan :: IO T.Text
nyan :: IO Text
nyan = CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Text)
-> IO Text
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess (String -> [String] -> CreateProcess
proc String
"cat" [String
"kek.txt"]){ std_out :: StdStream
std_out = StdStream
CreatePipe }
  \Maybe Handle
_mStdin Maybe Handle
mStdout Maybe Handle
_mStderr ProcessHandle
phandler ->
    case Maybe Handle
mStdout of
      Maybe Handle
Nothing     -> String -> IO Text
forall a. HasCallStack => String -> a
error String
"No handler"
      Just Handle
stdout -> do
        String -> IO ()
putStrLn String
"Connected, getting"
        !Text
output <- String -> Text
T.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO String
hGetContents Handle
stdout
        ExitCode
res <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
phandler
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Awaited: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ExitCode -> String
forall a. Show a => a -> String
show ExitCode
res
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Result: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Text -> Int
T.length Text
output)
        Int -> IO ()
threadDelay Int
100000
        String -> IO ()
putStrLn String
"Waiting"
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
output