{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, TemplateHaskell, FlexibleContexts, TypeSynonymInstances, UndecidableInstances, Trustworthy #-}

{-
  This module is part of Chatty.
  Copyleft (c) 2014 Marvin Cohrs

  All wrongs reversed. Sharing is an act of love, not crime.
  Please share Antisplice with everyone you like.

  Chatty is free software: you can redistribute it and/or modify
  it under the terms of the GNU Affero General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Chatty is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  GNU Affero General Public License for more details.

  You should have received a copy of the GNU Affero General Public License
  along with Chatty. If not, see <http://www.gnu.org/licenses/>.
-}

-- | Provides a bunch of derived instances for the various typeclasses.
module Text.Chatty.Interactor where

import Data.Chatty.Atoms
import Data.Chatty.Counter
import Text.Chatty.Printer
import Text.Chatty.Scanner
import Text.Chatty.Scanner.Buffered
import Text.Chatty.Finalizer
import Text.Chatty.Expansion
import Text.Chatty.Expansion.Vars
import Text.Chatty.Expansion.History
import Text.Chatty.Extended.HTML
import Text.Chatty.Extended.ANSI
import Text.Chatty.Channel.Printer
import Text.Chatty.Interactor.Templates
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans.Class
import Control.Monad.Identity
import System.IO

mkInteractor ''RecorderT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkCounter mkAtoms 
mkInteractor ''DeafT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkCounter mkAtoms 
mkInteractor ''OutRedirT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkCounter mkAtoms 
mkInteractor ''HandleCloserT mkScanner mkBufferedScanner mkPrinter mkExpander mkExpanderEnv mkHistoryEnv mkDefCP mkCounter mkAtoms 
mkInteractor ''ExpanderT mkScanner mkBufferedScanner mkPrinter mkFinalizer mkHistoryEnv mkDefCP mkCounter mkAtoms 
mkInteractor ''HereStringT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkDefCP mkCounter mkAtoms 
mkInteractor ''QuietT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkDefCP mkCounter mkAtoms 
mkInteractor ''InRedirT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkDefCP mkCounter mkAtoms 
mkInteractor ''HtmlPrinterT mkScanner mkBufferedScanner mkExpanderEnv mkHistoryEnv mkFinalizer mkDefCP mkCounter mkAtoms 
mkInteractor ''AnsiPrinterT mkScanner mkBufferedScanner mkExpanderEnv mkHistoryEnv mkFinalizer mkDefCP mkCounter mkAtoms 
mkInteractor ''NullExpanderT mkScanner mkBufferedScanner mkPrinter mkExtendedPrinter mkFinalizer mkDefCP mkCounter mkAtoms 
mkInteractor ''HistoryT  mkScanner mkBufferedScanner mkPrinter mkExtendedPrinter mkFinalizer mkExpanderEnv mkDefCP mkCounter mkAtoms 
mkInteractor ''ScannerBufferT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkFinalizer mkDefCP mkCounter mkAtoms
mkInteractor ''CounterT mkScanner mkPrinter mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkDefCP mkExtendedPrinter
mkInteractor ''AtomStoreT mkScanner mkPrinter mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkDefCP mkExtendedPrinter
mkInteractor ''IntArchiverT mkArchiver
mkInteractor ''BoolArchiverT mkArchiver
mkInteractor ''HandleArchiverT mkArchiver
mkInteractor ''IntFilterT mkArchiver
mkInteractor ''BoolFilterT mkArchiver
mkInteractor ''HandleFilterT mkArchiver
mkInteractor ''JoinerT mkArchiver

-- | IgnorantT ignores all output and does not provide any input.
type IgnorantT m = QuietT (DeafT m)
-- | Ignorant is IgnorantT on the identity
type Ignorant = IgnorantT Identity
-- | ChattyT simulates a console, actually taking input as a string and recording output.
type ChattyT m = HereStringT (RecorderT m)
-- | Chatty is ChattyT on the identity
type Chatty = ChattyT Identity

-- | Run IgnorantT (does not take anything)
runIgnorantT :: Monad m => IgnorantT m a -> m a
runIgnorantT :: IgnorantT m a -> m a
runIgnorantT = DeafT m a -> m a
forall (m :: * -> *) a. DeafT m a -> m a
runDeafT (DeafT m a -> m a)
-> (IgnorantT m a -> DeafT m a) -> IgnorantT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IgnorantT m a -> DeafT m a
forall (m :: * -> *) a. QuietT m a -> m a
runQuietT

-- | Run Ignorant (does not take anything)
runIgnorant :: Ignorant a -> a
runIgnorant :: Ignorant a -> a
runIgnorant = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (Ignorant a -> Identity a) -> Ignorant a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ignorant a -> Identity a
forall (m :: * -> *) a. Monad m => IgnorantT m a -> m a
runIgnorantT

-- | Run ChattyT. Takes input as a string and returns (result, remaining input, output).
runChattyT :: (Monad m,Functor m) => ChattyT m a -> String -> m (a,String,Replayable)
runChattyT :: ChattyT m a -> String -> m (a, String, Replayable)
runChattyT ChattyT m a
m String
input = (((a, String), Replayable) -> (a, String, Replayable))
-> m ((a, String), Replayable) -> m (a, String, Replayable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((a
a,String
u),Replayable
r) -> (a
a,String
u,Replayable
r)) (m ((a, String), Replayable) -> m (a, String, Replayable))
-> m ((a, String), Replayable) -> m (a, String, Replayable)
forall a b. (a -> b) -> a -> b
$ RecorderT m (a, String) -> m ((a, String), Replayable)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
RecorderT m a -> m (a, Replayable)
runRecorderT (RecorderT m (a, String) -> m ((a, String), Replayable))
-> RecorderT m (a, String) -> m ((a, String), Replayable)
forall a b. (a -> b) -> a -> b
$ ChattyT m a -> String -> RecorderT m (a, String)
forall (m :: * -> *) a. HereStringT m a -> String -> m (a, String)
runHereStringT ChattyT m a
m String
input

-- | Run Chatty. Takes input as a string and returns (result, remaining input, output).
runChatty :: Chatty a -> String -> (a,String,Replayable)
runChatty :: Chatty a -> String -> (a, String, Replayable)
runChatty Chatty a
m = Identity (a, String, Replayable) -> (a, String, Replayable)
forall a. Identity a -> a
runIdentity (Identity (a, String, Replayable) -> (a, String, Replayable))
-> (String -> Identity (a, String, Replayable))
-> String
-> (a, String, Replayable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatty a -> String -> Identity (a, String, Replayable)
forall (m :: * -> *) a.
(Monad m, Functor m) =>
ChattyT m a -> String -> m (a, String, Replayable)
runChattyT Chatty a
m

-- Shell-like syntax
-- | Connect the output of some function to the input of another one. Compare with a pipe (cmd1 | cmd2).
(.|.) :: (Monad m,Functor m) => RecorderT m a -> HereStringT m b -> m b
RecorderT m a
m1 .|. :: RecorderT m a -> HereStringT m b -> m b
.|. HereStringT m b
m2 = do
  (a
_,Replayable
r) <- RecorderT m a -> m (a, Replayable)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
RecorderT m a -> m (a, Replayable)
runRecorderT RecorderT m a
m1
  ((b, String) -> b) -> m (b, String) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, String) -> b
forall a b. (a, b) -> a
fst (m (b, String) -> m b) -> m (b, String) -> m b
forall a b. (a -> b) -> a -> b
$ HereStringT m b -> String -> m (b, String)
forall (m :: * -> *) a. HereStringT m a -> String -> m (a, String)
runHereStringT HereStringT m b
m2 (Replayable -> String
replay Replayable
r)

-- | Runs the second function and feeds its output as an argument to the first one. Compare with process expansion ($(cmd)).
(.<$.) :: (Functor m,Monad m) => (String -> m b) -> RecorderT m a -> m b
String -> m b
m1 .<$. :: (String -> m b) -> RecorderT m a -> m b
.<$. RecorderT m a
m2 = do
  (a
_,Replayable
r) <- RecorderT m a -> m (a, Replayable)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
RecorderT m a -> m (a, Replayable)
runRecorderT RecorderT m a
m2
  String -> m b
m1 (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ Replayable -> String
replay Replayable
r