{- |
Module      : Language.Egison.Primitives.String
Licence     : MIT

This module implements primitive functions that operates on / returns strings.
-}

module Language.Egison.Primitives.String
  ( primitiveStringFunctions
  ) where

import           Control.Monad.Except

import qualified Data.Sequence                    as Sq
import qualified Data.Text                        as T

import           Text.Regex.TDFA                  ((=~~))

import           Language.Egison.Data
import           Language.Egison.Eval
import           Language.Egison.Parser
import           Language.Egison.Pretty
import           Language.Egison.Primitives.Utils


primitiveStringFunctions :: [(String, EgisonValue)]
primitiveStringFunctions :: [(String, EgisonValue)]
primitiveStringFunctions =
  ((String, String -> PrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> PrimitiveFunc)] -> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> PrimitiveFunc
fn) -> (String
name, PrimitiveFunc -> EgisonValue
PrimitiveFunc (String -> PrimitiveFunc
fn String
name))) [(String, String -> PrimitiveFunc)]
strictPrimitives

strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives =
  [ (String
"pack", String -> PrimitiveFunc
pack)
  , (String
"unpack", String -> PrimitiveFunc
unpack)
  , (String
"unconsString", String -> PrimitiveFunc
unconsString)
  , (String
"lengthString", String -> PrimitiveFunc
lengthString)
  , (String
"appendString", String -> PrimitiveFunc
appendString)
  , (String
"splitString", String -> PrimitiveFunc
splitString)
  , (String
"regex", String -> PrimitiveFunc
regexString)
  , (String
"regexCg", String -> PrimitiveFunc
regexStringCaptureGroup)

  , (String
"read", String -> PrimitiveFunc
read')
  , (String
"readTsv", String -> PrimitiveFunc
readTSV)
  , (String
"show", String -> PrimitiveFunc
show')
  , (String
"showTsv", String -> PrimitiveFunc
showTSV')
  ]

pack :: String -> PrimitiveFunc
pack :: String -> PrimitiveFunc
pack = (String -> Text) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp String -> Text
T.pack

unpack :: String -> PrimitiveFunc
unpack :: String -> PrimitiveFunc
unpack = (Text -> String) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp Text -> String
T.unpack

unconsString :: String -> PrimitiveFunc
unconsString :: String -> PrimitiveFunc
unconsString = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Text
str <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  case Text -> Maybe (Char, Text)
T.uncons Text
str of
    Just (Char
c, Text
rest) -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ [EgisonValue] -> EgisonValue
Tuple [Char -> EgisonValue
Char Char
c, Text -> EgisonValue
String Text
rest]
    Maybe (Char, Text)
Nothing        -> EgisonError -> EvalM EgisonValue
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM EgisonValue)
-> EgisonError -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"Tried to unsnoc empty string"

lengthString :: String -> PrimitiveFunc
lengthString :: String -> PrimitiveFunc
lengthString = (Text -> Integer) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Text -> Int) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length)

appendString :: String -> PrimitiveFunc
appendString :: String -> PrimitiveFunc
appendString = (Text -> Text -> Text) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> a -> b) -> String -> PrimitiveFunc
binaryOp Text -> Text -> Text
T.append

splitString :: String -> PrimitiveFunc
splitString :: String -> PrimitiveFunc
splitString = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
pat EgisonValue
src -> do
  Text
patStr <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
pat
  Text
srcStr <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
src
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> ([EgisonValue] -> EgisonValue) -> PrimitiveFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList PrimitiveFunc -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ (Text -> EgisonValue) -> [Text] -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map Text -> EgisonValue
String ([Text] -> [EgisonValue]) -> [Text] -> [EgisonValue]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
patStr Text
srcStr

regexString :: String -> PrimitiveFunc
regexString :: String -> PrimitiveFunc
regexString = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
pat EgisonValue
src -> do
  Text
patStr <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
pat
  Text
srcStr <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
src
  case (Text -> String
T.unpack Text
srcStr String -> String -> Maybe (String, String, String)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text -> String
T.unpack Text
patStr) :: (Maybe (String, String, String)) of
    Maybe (String, String, String)
Nothing      -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> ([EgisonValue] -> EgisonValue) -> PrimitiveFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList PrimitiveFunc -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ []
    Just (String
a,String
b,String
c) -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> ([EgisonValue] -> EgisonValue) -> PrimitiveFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList PrimitiveFunc -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ [[EgisonValue] -> EgisonValue
Tuple [Text -> EgisonValue
String (String -> Text
T.pack String
a), Text -> EgisonValue
String (String -> Text
T.pack String
b), Text -> EgisonValue
String (String -> Text
T.pack String
c)]]

regexStringCaptureGroup :: String -> PrimitiveFunc
regexStringCaptureGroup :: String -> PrimitiveFunc
regexStringCaptureGroup = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
pat EgisonValue
src -> do
  Text
patStr <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
pat
  Text
srcStr <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
src
  case (Text -> String
T.unpack Text
srcStr String -> String -> Maybe [[String]]
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text -> String
T.unpack Text
patStr) :: (Maybe [[String]]) of
    Maybe [[String]]
Nothing -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> ([EgisonValue] -> EgisonValue) -> PrimitiveFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList PrimitiveFunc -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ []
    Just ((String
x:[String]
xs):[[String]]
_) -> do let (Text
a, Text
c) = Text -> Text -> (Text, Text)
T.breakOn (String -> Text
T.pack String
x) Text
srcStr
                          EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> ([EgisonValue] -> EgisonValue) -> PrimitiveFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList PrimitiveFunc -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ [[EgisonValue] -> EgisonValue
Tuple [Text -> EgisonValue
String Text
a, Seq EgisonValue -> EgisonValue
Collection ([EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList ((String -> EgisonValue) -> [String] -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> EgisonValue
String (Text -> EgisonValue) -> (String -> Text) -> String -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
xs)), Text -> EgisonValue
String (Int -> Text -> Text
T.drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) Text
c)]]

--
-- Read / Show
--

read' :: String -> PrimitiveFunc
read' :: String -> PrimitiveFunc
read'= (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Text
str <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  Expr
ast <- String -> EvalM Expr
readExpr (Text -> String
T.unpack Text
str)
  Env -> Expr -> EvalM EgisonValue
evalExpr Env
nullEnv Expr
ast

readTSV :: String -> PrimitiveFunc
readTSV :: String -> PrimitiveFunc
readTSV = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Text
str   <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  [Expr]
exprs <- (Text -> EvalM Expr)
-> [Text] -> StateT EvalState (ExceptT EgisonError RuntimeM) [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> EvalM Expr
readExpr (String -> EvalM Expr) -> (Text -> String) -> Text -> EvalM Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') Text
str)
  [EgisonValue]
rets  <- (Expr -> EvalM EgisonValue)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> EvalM EgisonValue
evalExpr Env
nullEnv) [Expr]
exprs
  case [EgisonValue]
rets of
    [EgisonValue
ret] -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
ret
    [EgisonValue]
_     -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return ([EgisonValue] -> EgisonValue
Tuple [EgisonValue]
rets)

show' :: String -> PrimitiveFunc
show' :: String -> PrimitiveFunc
show'= (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Text -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Text -> EgisonValue) -> Text -> EgisonValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
val

showTSV' :: String -> PrimitiveFunc
showTSV' :: String -> PrimitiveFunc
showTSV'= (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Text -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Text -> EgisonValue) -> Text -> EgisonValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ EgisonValue -> String
showTSV EgisonValue
val