{-# LANGUAGE OverloadedStrings #-}

module Funcons.Operations.Strings where

import Funcons.Operations.Libraries
import Funcons.Operations.Internal
import Funcons.Operations.Types

import Data.String

library :: HasValues t => Library t
library :: Library t
library = [(OP, ValueOp t)] -> Library t
forall t. [(OP, ValueOp t)] -> Library t
libFromList [
    (OP
"is-string", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
is_string)
  , (OP
"strings", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr (OP -> NullaryVOp t -> NullaryExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"strings" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"strings" [])))
  , (OP
"to-string", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
to_string)
  ]

is_string_ :: HasValues t => [OpExpr t] -> OpExpr t
is_string_ :: [OpExpr t] -> OpExpr t
is_string_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
is_string
is_string :: OpExpr t -> OpExpr t
is_string OpExpr t
x = OP -> OpExpr t -> [OpExpr t] -> OpExpr t
forall t. OP -> OpExpr t -> [OpExpr t] -> OpExpr t
RewritesTo OP
"is-string" (OpExpr t -> OpExpr t -> OpExpr t
forall t. HasValues t => OpExpr t -> OpExpr t -> OpExpr t
type_member OpExpr t
x (Values t -> OpExpr t
forall t. Values t -> OpExpr t
ValExpr (ComputationTypes t -> Values t
forall t. ComputationTypes t -> Values t
ComputationType (Types t -> ComputationTypes t
forall t. Types t -> ComputationTypes t
Type (Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"strings" []))))) [OpExpr t
x]

to_string_ :: HasValues t => [OpExpr t] -> OpExpr t
to_string_ :: [OpExpr t] -> OpExpr t
to_string_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
to_string
to_string :: HasValues t => OpExpr t -> OpExpr t 
to_string :: OpExpr t -> OpExpr t
to_string = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"to-string" UnaryVOp t
forall t. HasValues t => Values t -> Result t
stepTo_String

stepTo_String :: Values t -> Result t
stepTo_String Values t
s | Values t -> Bool
forall t. HasValues t => Values t -> Bool
isString_ Values t
s   = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ Values t
s
stepTo_String (Rational Rational
r)      = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string (Double -> OP
forall a. Show a => a -> OP
show (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r))
stepTo_String Values t
v | Just Char
c <- Values t -> Maybe Char
forall t. HasValues t => Values t -> Maybe Char
upcastCharacter Values t
v = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string ([Char
c])
stepTo_String (Atom OP
s)          = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string  OP
s
stepTo_String (Int Integer
i)           = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string  (Integer -> OP
forall a. Show a => a -> OP
show Integer
i)
stepTo_String (Nat Integer
n)           = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string  (Integer -> OP
forall a. Show a => a -> OP
show Integer
n)
stepTo_String (Float Double
f)         = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string  (Double -> OP
forall a. Show a => a -> OP
show Double
f)
stepTo_String (IEEE_Float_32 Float
f) = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string  (Float -> OP
forall a. Show a => a -> OP
show Float
f)
stepTo_String (IEEE_Float_64 Double
d) = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string  (Double -> OP
forall a. Show a => a -> OP
show Double
d)
stepTo_String (ADTVal Name
"true" []) = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string OP
"true"
stepTo_String (ADTVal Name
"false"[]) = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string OP
"false"
stepTo_String (ADTVal Name
"null"[]) = OP -> Result t
forall t. HasValues t => OP -> Result t
mk_string OP
"null"
stepTo_String Values t
v                 = OP -> Result t
forall t. OP -> Result t
DomErr (OP
"to-string undefined on this type")

mk_string :: HasValues t => String -> Result t
mk_string :: OP -> Result t
mk_string = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> (OP -> t) -> OP -> Result t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> (OP -> Values t) -> OP -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OP -> Values t
forall a. IsString a => OP -> a
fromString