{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# LANGUAGE OverloadedStrings #-}

module Actions where

import           Common               (Action, Focus (FList, FText),
                                       Focuser (FTrav), Mapping, Parser,
                                       foldMappings, lexeme, symbol,
                                       toTextUnsafe)
import           Control.Lens         ((%~), (&), (.~), (^..))
import           Control.Lens.Extras  (biplate)
import           Data.Char            (isAlphaNum)
import           Data.Functor         (($>))
import           Data.Text            (Text)
import qualified Data.Text            as T
import qualified Data.Text.IO         as TIO
import           Parsers              (parseMappings, stringLiteral)
import           Text.Megaparsec      (MonadParsec (label, notFollowedBy),
                                       choice, satisfy)
import           Text.Megaparsec.Char (string)

parseAction :: Parser Action
parseAction :: Parser Action
parseAction = String -> Parser Action -> Parser Action
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"valid action" (Parser Action -> Parser Action) -> Parser Action -> Parser Action
forall a b. (a -> b) -> a -> b
$ [Parser Action] -> Parser Action
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parser Text
symbol Text
"get-tree" Parser Text -> Action -> Parser Action
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Action
getTree
    , Text -> Parser Text
symbol Text
"get" Parser Text -> Action -> Parser Action
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Action
actionGet
    , Parser Action
parseActionOver
    , Parser Action
parseActionSet
    ]

actionGet :: Action
actionGet :: Action
actionGet Text
input (FTrav Traversal' Focus Focus
trav) = do
    let focus :: Focus
focus = [Focus] -> Focus
FList ([Focus] -> Focus) -> [Focus] -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Focus
FText Text
input Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav
    Focus -> IO ()
printFocus Focus
focus
  where
    printFocus :: Focus -> IO ()
printFocus (FText Text
str) = Text -> IO ()
TIO.putStrLn Text
str
    printFocus (FList [Focus]
lst) = (Focus -> IO ()) -> [Focus] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Focus -> IO ()
printFocus [Focus]
lst

actionOver :: Mapping -> Action
actionOver :: Mapping -> Action
actionOver Mapping
mapping Text
input (FTrav Traversal' Focus Focus
trav) = do
    let output :: Text
output = Focus -> Text
toTextUnsafe (Focus -> Text) -> Focus -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Focus
FText Text
input Focus -> Mapping -> Focus
forall a b. a -> (a -> b) -> b
& (Focus -> Identity Focus) -> Focus -> Identity Focus
Traversal' Focus Focus
trav ((Focus -> Identity Focus) -> Focus -> Identity Focus)
-> Mapping -> Mapping
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Mapping
mapping
    Text -> IO ()
TIO.putStr Text
output

parseActionOver :: Parser Action
parseActionOver :: Parser Action
parseActionOver = do
    Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"over" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    [Mapping]
mappings <- Parser [Mapping]
parseMappings
    let mapping :: Mapping
mapping = [Mapping] -> Mapping
foldMappings [Mapping]
mappings
    Action -> Parser Action
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Action -> Parser Action) -> Action -> Parser Action
forall a b. (a -> b) -> a -> b
$ Mapping -> Action
actionOver Mapping
mapping

actionSet :: Text -> Action
actionSet :: Text -> Action
actionSet Text
str Text
input (FTrav Traversal' Focus Focus
trav) = do
    let output :: Text
output = Focus -> Text
toTextUnsafe (Focus -> Text) -> Focus -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Focus
FText Text
input Focus -> Mapping -> Focus
forall a b. a -> (a -> b) -> b
& (Focus -> Identity Focus) -> Focus -> Identity Focus
Traversal' Focus Focus
trav ((Focus -> Identity Focus) -> Focus -> Identity Focus)
-> ((Text -> Identity Text) -> Focus -> Identity Focus)
-> (Text -> Identity Text)
-> Focus
-> Identity Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> Focus -> Identity Focus
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' Focus Text
biplate ((Text -> Identity Text) -> Focus -> Identity Focus)
-> Text -> Mapping
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
str
    Text -> IO ()
TIO.putStrLn Text
output

parseActionSet :: Parser Action
parseActionSet :: Parser Action
parseActionSet = do
    Text -> Parser Text
symbol Text
"set"
    Text -> Action
actionSet (Text -> Action) -> Parser Text -> Parser Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral

getTree :: Action
getTree :: Action
getTree Text
input (FTrav Traversal' Focus Focus
trav) = do
    String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [Focus] -> String
forall a. Show a => a -> String
show ([Focus] -> String) -> [Focus] -> String
forall a b. (a -> b) -> a -> b
$ Text -> Focus
FText Text
input Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav