{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Sindre.Lib
-- License     :  MIT-style (see LICENSE)
--
-- Stability   :  provisional
-- Portability :  portable
--
-- Library routines and helper functions for the Sindre programming
-- language.
--
-----------------------------------------------------------------------------
module Sindre.Lib ( stdFunctions
                  , ioFunctions
                  , ioGlobals
                  , LiftFunction(..)
                  , KeyLike(..)
                  )
    where

import Sindre.Sindre
import Sindre.Compiler
import Sindre.Runtime
import Sindre.Util

import System.Environment
import System.Exit
import System.IO
import System.Process hiding (env)
import Text.Regex.PCRE

import Control.Monad
import Control.Monad.Trans
import Data.Char
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S

lengthFun :: Value -> Integer
lengthFun :: Value -> Integer
lengthFun (Dict Map Value Value
m) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Map Value Value -> Int
forall k a. Map k a -> Int
M.size Map Value Value
m
lengthFun Value
v = Integer -> ([Char] -> Integer) -> Maybe [Char] -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 [Char] -> Integer
forall i a. Num i => [a] -> i
genericLength (Value -> Maybe [Char]
forall a. Mold a => Value -> Maybe a
mold Value
v :: Maybe String)

builtin :: LiftFunction im m a => a -> Compiler im ([Value] -> m im Value)
builtin :: a -> Compiler im ([Value] -> m im Value)
builtin a
f = ([Value] -> m im Value) -> Compiler im ([Value] -> m im Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Value] -> m im Value) -> Compiler im ([Value] -> m im Value))
-> ([Value] -> m im Value) -> Compiler im ([Value] -> m im Value)
forall a b. (a -> b) -> a -> b
$ a -> [Value] -> m im Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> [Value] -> m im Value
function a
f

-- | A set of pure functions that can work with any Sindre backend.
-- Includes the functions @abs@, @atan2@, @cos@, @sin@, @exp@, @log@,
-- @int@, @sqrt@, @length@, @substr@, @index@, @match@, @sub@, @gsub@,
-- @tolower@, and @toupper@.
stdFunctions :: forall im. MonadBackend im => FuncMap im
stdFunctions :: FuncMap im
stdFunctions = [([Char], Compiler im ([Value] -> Sindre im Value))] -> FuncMap im
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
               [ ([Char]
"abs" , (Int -> Sindre im Int) -> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Int -> Sindre im Int)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Int -> Sindre im Int)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Int -> Sindre im Int
forall a. Mold a => a -> Sindre im a
return' (Int -> Sindre im Int) -> (Int -> Int) -> Int -> Sindre im Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int
forall a. Num a => a -> a
abs :: Int -> Int))
               , ([Char]
"atan2", (Double -> Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Double -> Sindre im Double)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ \(Double
x::Double) (Double
y::Double) ->
                    Double -> Sindre im Double
forall a. Mold a => a -> Sindre im a
return' (Double -> Sindre im Double) -> Double -> Sindre im Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
x Double
y)
               , ([Char]
"cos", (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Sindre im Double)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Double -> Sindre im Double
forall a. Mold a => a -> Sindre im a
return' (Double -> Sindre im Double)
-> (Double -> Double) -> Double -> Sindre im Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a. Floating a => a -> a
cos :: Double -> Double))
               , ([Char]
"sin", (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Sindre im Double)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Double -> Sindre im Double
forall a. Mold a => a -> Sindre im a
return' (Double -> Sindre im Double)
-> (Double -> Double) -> Double -> Sindre im Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a. Floating a => a -> a
sin :: Double -> Double))
               , ([Char]
"exp", (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Sindre im Double)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Double -> Sindre im Double
forall a. Mold a => a -> Sindre im a
return' (Double -> Sindre im Double)
-> (Double -> Double) -> Double -> Sindre im Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a. Floating a => a -> a
exp :: Double -> Double))
               , ([Char]
"log", (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Sindre im Double)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Double -> Sindre im Double
forall a. Mold a => a -> Sindre im a
return' (Double -> Sindre im Double)
-> (Double -> Double) -> Double -> Sindre im Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a. Floating a => a -> a
log :: Double -> Double))
               , ([Char]
"int", (Double -> Sindre im Integer)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Sindre im Integer)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Sindre im Integer)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Integer -> Sindre im Integer
forall a. Mold a => a -> Sindre im a
return' (Integer -> Sindre im Integer)
-> (Double -> Integer) -> Double -> Sindre im Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor :: Double -> Integer))
               , ([Char]
"sqrt", (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Double -> Sindre im Double)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Double -> Sindre im Double)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Double -> Sindre im Double
forall a. Mold a => a -> Sindre im a
return' (Double -> Sindre im Double)
-> (Double -> Double) -> Double -> Sindre im Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a. Floating a => a -> a
sqrt :: Double -> Double))
               , ([Char]
"length", (Value -> Sindre im Integer)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin ((Value -> Sindre im Integer)
 -> Compiler im ([Value] -> Sindre im Value))
-> (Value -> Sindre im Integer)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ Integer -> Sindre im Integer
forall a. Mold a => a -> Sindre im a
return' (Integer -> Sindre im Integer)
-> (Value -> Integer) -> Value -> Sindre im Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Integer
lengthFun)
               , ([Char]
"substr", ([Char] -> Int -> Int -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin (([Char] -> Int -> Int -> Sindre im [Char])
 -> Compiler im ([Value] -> Sindre im Value))
-> ([Char] -> Int -> Int -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ \([Char]
s::String) Int
m Int
n ->
                   [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' ([Char] -> Sindre im [Char]) -> [Char] -> Sindre im [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
n ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Char]
s)
               , ([Char]
"index",  ([Char] -> [Char] -> Sindre im Int)
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin (([Char] -> [Char] -> Sindre im Int)
 -> Compiler im ([Value] -> Sindre im Value))
-> ([Char] -> [Char] -> Sindre im Int)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ \([Char]
s::String) [Char]
t ->
                   Int -> Sindre im Int
forall a. Mold a => a -> Sindre im a
return' (Int -> Sindre im Int) -> Int -> Sindre im Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
t) ([[Char]] -> Maybe Int) -> [[Char]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
forall a. [a] -> [[a]]
tails [Char]
s)
               , ([Char]
"match", do
                     Value -> Execution im ()
rstart  <- [Char] -> Compiler im (Value -> Execution im ())
forall (m :: * -> *).
MonadBackend m =>
[Char] -> Compiler m (Value -> Execution m ())
setValue [Char]
"RSTART"
                     Value -> Execution im ()
rlength <- [Char] -> Compiler im (Value -> Execution im ())
forall (m :: * -> *).
MonadBackend m =>
[Char] -> Compiler m (Value -> Execution m ())
setValue [Char]
"RLENGTH"
                     ([Value] -> Sindre im Value)
-> Compiler im ([Value] -> Sindre im Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Value] -> Sindre im Value)
 -> Compiler im ([Value] -> Sindre im Value))
-> ([Value] -> Sindre im Value)
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> Sindre im Value) -> [Value] -> Sindre im Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> [Value] -> m im Value
function (([Char] -> [Char] -> Sindre im Value)
 -> [Value] -> Sindre im Value)
-> ([Char] -> [Char] -> Sindre im Value)
-> [Value]
-> Sindre im Value
forall a b. (a -> b) -> a -> b
$ \([Char]
s::String) ([Char]
r::String) -> do
                       let (Int
stt, Int
len) = [Char]
s [Char] -> [Char] -> (Int, Int)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ [Char]
r :: (Int, Int)
                       Execution im () -> Sindre im ()
forall (m :: * -> *) a.
MonadBackend m =>
Execution m a -> Sindre m ()
execute_ (Execution im () -> Sindre im ())
-> Execution im () -> Sindre im ()
forall a b. (a -> b) -> a -> b
$ do Value -> Execution im ()
rstart (Value -> Execution im ()) -> Value -> Execution im ()
forall a b. (a -> b) -> a -> b
$ Int -> Value
forall a. Mold a => a -> Value
unmold (Int
sttInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                                     Value -> Execution im ()
rlength (Value -> Execution im ()) -> Value -> Execution im ()
forall a b. (a -> b) -> a -> b
$ Int -> Value
forall a. Mold a => a -> Value
unmold Int
len
                       Value -> Sindre im Value
forall a. Mold a => a -> Sindre im a
return' (Value -> Sindre im Value) -> Value -> Sindre im Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
forall a. Mold a => a -> Value
unmold (Int
sttInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
               , ([Char]
"sub", ([Char] -> [Char] -> [Char] -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin [Char] -> [Char] -> [Char] -> Sindre im [Char]
sub)
               , ([Char]
"gsub", ([Char] -> [Char] -> [Char] -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin [Char] -> [Char] -> [Char] -> Sindre im [Char]
gsub)
               , ([Char]
"tolower", ([Char] -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin (([Char] -> Sindre im [Char])
 -> Compiler im ([Value] -> Sindre im Value))
-> ([Char] -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' ([Char] -> Sindre im [Char])
-> ([Char] -> [Char]) -> [Char] -> Sindre im [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower)
               , ([Char]
"toupper", ([Char] -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin (([Char] -> Sindre im [Char])
 -> Compiler im ([Value] -> Sindre im Value))
-> ([Char] -> Sindre im [Char])
-> Compiler im ([Value] -> Sindre im Value)
forall a b. (a -> b) -> a -> b
$ [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' ([Char] -> Sindre im [Char])
-> ([Char] -> [Char]) -> [Char] -> Sindre im [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper)
               ]
    where return' :: Mold a => a -> Sindre im a
          return' :: a -> Sindre im a
return' = a -> Sindre im a
forall (m :: * -> *) a. Monad m => a -> m a
return
          sub :: [Char] -> [Char] -> [Char] -> Sindre im [Char]
sub ([Char]
r::String) [Char]
t ([Char]
s::String) =
            case [Char]
s [Char] -> [Char] -> (Int, Int)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ [Char]
r of
              (-1,Int
_) -> [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' [Char]
s
              (Int
i,Int
n)  -> [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' ([Char] -> Sindre im [Char]) -> [Char] -> Sindre im [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
i [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) [Char]
s
          gsub :: [Char] -> [Char] -> [Char] -> Sindre im [Char]
gsub ([Char]
r::String) [Char]
t ([Char]
s::String) =
            case [Char]
s [Char] -> [Char] -> (Int, Int)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ [Char]
r of
              (-1,Int
_) -> [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' [Char]
s
              (Int
i,Int
n)  -> do [Char]
s' <- [Char] -> [Char] -> [Char] -> Sindre im [Char]
gsub [Char]
r [Char]
t ([Char] -> Sindre im [Char]) -> [Char] -> Sindre im [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) [Char]
s
                           [Char] -> Sindre im [Char]
forall a. Mold a => a -> Sindre im a
return' ([Char] -> Sindre im [Char]) -> [Char] -> Sindre im [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
i [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s'
-- | A set of impure functions that only work in IO backends.
-- Includes the @system@ function.
ioFunctions :: (MonadIO m, MonadBackend m) => FuncMap m
ioFunctions :: FuncMap m
ioFunctions = [([Char],
  RWST
    (CompilerEnv m)
    (Initialisation m)
    CompilerState
    Identity
    ([Value] -> Sindre m Value))]
-> FuncMap m
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              [ ([Char]
"system", do
                   Value -> Execution m ()
exitval <- [Char] -> Compiler m (Value -> Execution m ())
forall (m :: * -> *).
MonadBackend m =>
[Char] -> Compiler m (Value -> Execution m ())
setValue [Char]
"EXITVAL"
                   ([Char] -> Sindre m Int)
-> RWST
     (CompilerEnv m)
     (Initialisation m)
     CompilerState
     Identity
     ([Value] -> Sindre m Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> Compiler im ([Value] -> m im Value)
builtin (([Char] -> Sindre m Int)
 -> RWST
      (CompilerEnv m)
      (Initialisation m)
      CompilerState
      Identity
      ([Value] -> Sindre m Value))
-> ([Char] -> Sindre m Int)
-> RWST
     (CompilerEnv m)
     (Initialisation m)
     CompilerState
     Identity
     ([Value] -> Sindre m Value)
forall a b. (a -> b) -> a -> b
$ \[Char]
s -> do
                     ExitCode
c <- IO ExitCode -> Sindre m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ExitCode -> Sindre m ExitCode)
-> IO ExitCode -> Sindre m ExitCode
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ExitCode
system [Char]
s
                     let v :: Int
v = case ExitCode
c of ExitCode
ExitSuccess   -> Int
0
                                       ExitFailure Int
e -> Int
e
                     Execution m () -> Initialisation m
forall (m :: * -> *) a.
MonadBackend m =>
Execution m a -> Sindre m ()
execute_ (Execution m () -> Initialisation m)
-> Execution m () -> Initialisation m
forall a b. (a -> b) -> a -> b
$ Value -> Execution m ()
exitval (Value -> Execution m ()) -> Value -> Execution m ()
forall a b. (a -> b) -> a -> b
$ Int -> Value
forall a. Mold a => a -> Value
unmold Int
v
                     Int -> Sindre m Int
forall a (im :: * -> *). Mold a => a -> Sindre im a
return' Int
v)
              , ([Char]
"osystem", do
                    Value -> Execution m ()
exitval <- [Char] -> Compiler m (Value -> Execution m ())
forall (m :: * -> *).
MonadBackend m =>
[Char] -> Compiler m (Value -> Execution m ())
setValue [Char]
"EXITVAL"
                    ([Value] -> Sindre m Value)
-> RWST
     (CompilerEnv m)
     (Initialisation m)
     CompilerState
     Identity
     ([Value] -> Sindre m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Value] -> Sindre m Value)
 -> RWST
      (CompilerEnv m)
      (Initialisation m)
      CompilerState
      Identity
      ([Value] -> Sindre m Value))
-> ([Value] -> Sindre m Value)
-> RWST
     (CompilerEnv m)
     (Initialisation m)
     CompilerState
     Identity
     ([Value] -> Sindre m Value)
forall a b. (a -> b) -> a -> b
$ ([Char] -> Sindre m [Char]) -> [Value] -> Sindre m Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> [Value] -> m im Value
function (([Char] -> Sindre m [Char]) -> [Value] -> Sindre m Value)
-> ([Char] -> Sindre m [Char]) -> [Value] -> Sindre m Value
forall a b. (a -> b) -> a -> b
$ \[Char]
s -> do
                      (Just Handle
inh, Just Handle
outh, Maybe Handle
_, ProcessHandle
pid) <-
                        IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Sindre
     m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> Sindre
      m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Sindre
     m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ([Char] -> CreateProcess
shell [Char]
s) { std_in :: StdStream
std_in  = StdStream
CreatePipe,
                                                       std_out :: StdStream
std_out = StdStream
CreatePipe,
                                                       std_err :: StdStream
std_err = StdStream
Inherit }
                      IO () -> Initialisation m
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> Initialisation m) -> IO () -> Initialisation m
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
inh
                      [Char]
output <- IO [Char] -> Sindre m [Char]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Char] -> Sindre m [Char]) -> IO [Char] -> Sindre m [Char]
forall a b. (a -> b) -> a -> b
$ Handle -> IO [Char]
hGetContents Handle
outh
                      ExitCode
ex <- IO ExitCode -> Sindre m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ExitCode -> Sindre m ExitCode)
-> IO ExitCode -> Sindre m ExitCode
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid
                      Execution m () -> Initialisation m
forall (m :: * -> *) a.
MonadBackend m =>
Execution m a -> Sindre m ()
execute_ (Execution m () -> Initialisation m)
-> Execution m () -> Initialisation m
forall a b. (a -> b) -> a -> b
$ Value -> Execution m ()
exitval (Value -> Execution m ()) -> Value -> Execution m ()
forall a b. (a -> b) -> a -> b
$ Int -> Value
forall a. Mold a => a -> Value
unmold (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ case ExitCode
ex of
                        ExitCode
ExitSuccess   -> Int
0
                        ExitFailure Int
r -> Int
r
                      [Char] -> Sindre m [Char]
forall a (im :: * -> *). Mold a => a -> Sindre im a
return' [Char]
output)
              ]
    where return' :: Mold a => a -> Sindre im a
          return' :: a -> Sindre im a
return' = a -> Sindre im a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Global variables that require an IO backend.  Includes the
-- @ENVIRON@ global.
ioGlobals :: MonadIO im => M.Map Identifier (im Value)
ioGlobals :: Map [Char] (im Value)
ioGlobals = [([Char], im Value)] -> Map [Char] (im Value)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [([Char]
"ENVIRON", do
                           [([Char], [Char])]
env <- IO [([Char], [Char])] -> im [([Char], [Char])]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO [([Char], [Char])]
getEnvironment
                           let f :: (a, a) -> (Value, Value)
f (a
k, a
s) = (a -> Value
forall a. Mold a => a -> Value
unmold a
k, a -> Value
forall a. Mold a => a -> Value
unmold a
s)
                           Value -> im Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> im Value) -> Value -> im Value
forall a b. (a -> b) -> a -> b
$ Map Value Value -> Value
Dict (Map Value Value -> Value) -> Map Value Value -> Value
forall a b. (a -> b) -> a -> b
$ [(Value, Value)] -> Map Value Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Value, Value)] -> Map Value Value)
-> [(Value, Value)] -> Map Value Value
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> (Value, Value))
-> [([Char], [Char])] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> (Value, Value)
forall a a. (Mold a, Mold a) => (a, a) -> (Value, Value)
f [([Char], [Char])]
env)
                       ]

-- | A class making it easy to adapt Haskell functions as Sindre
-- functions that take and return 'Value's.
class (MonadBackend im, MonadSindre im m) => LiftFunction im m a where
  function :: a -> [Value] -> m im Value
  -- ^ @function f@ is a monadic function that accepts a list of
  -- 'Value's and returns a 'Value'.  If the list does not contain the
  -- number, or type, of arguments expected by @f@, 'fail' will be
  -- called with an appropriate error message.

instance (Mold a, MonadSindre im m) => LiftFunction im m (m im a) where
  function :: m im a -> [Value] -> m im Value
function m im a
x [] = (a -> Value) -> m im a -> m im Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Value
forall a. Mold a => a -> Value
unmold m im a
x
  function m im a
_ [Value]
_ = [Char] -> m im Value
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Too many arguments"

instance (Mold a, LiftFunction im m b, MonadSindre im m)
    => LiftFunction im m (a -> b) where
  function :: (a -> b) -> [Value] -> m im Value
function a -> b
f (Value
x:[Value]
xs) = case Value -> Maybe a
forall a. Mold a => Value -> Maybe a
mold Value
x of
                        Maybe a
Nothing -> [Char] -> m im Value
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot mold argument"
                        Just a
x' -> a -> b
f a
x' b -> [Value] -> m im Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
LiftFunction im m a =>
a -> [Value] -> m im Value
`function` [Value]
xs
  function a -> b
_ [] = [Char] -> m im Value
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Not enough arguments"

-- | Convenience class for writing 'Chord' values.
class KeyLike a where
  chord :: [KeyModifier] -> a -> Chord
  -- ^ Given a list of modifiers and either a 'char' or a 'String',
  -- yield a 'Chord'.  If given a character, the Chord will contain a
  -- 'CharKey', if given a string, it will contain a 'CtrlKey'.

instance KeyLike Char where
  chord :: [KeyModifier] -> Char -> Chord
chord [KeyModifier]
ms Char
c = ([KeyModifier] -> Set KeyModifier
forall a. Ord a => [a] -> Set a
S.fromList [KeyModifier]
ms, Char -> Key
CharKey Char
c)

instance KeyLike String where
  chord :: [KeyModifier] -> [Char] -> Chord
chord [KeyModifier]
ms [Char]
s = ([KeyModifier] -> Set KeyModifier
forall a. Ord a => [a] -> Set a
S.fromList [KeyModifier]
ms, [Char] -> Key
CtrlKey [Char]
s)