module Common.ConvertLiteral
( SplitM
, isGenLiteral
, isGenNumber
, isGenNum
, isGenString
, isGenList
, isGenFloat
, isGenFrac
, toNumber
, toFrac
, toFloat
, toString
, toMixfixList
, toChar
) where
import Common.Id
import Common.GlobalAnnotations
import Data.Char (isDigit)
import Data.List (isPrefixOf)
type SplitM a = a -> Maybe (Id, [a])
isGenLiteral :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenLiteral :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenLiteral splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i trm :: [a]
trm =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNumber SplitM a
splt GlobalAnnos
ga Id
i [a]
trm
, SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenString SplitM a
splt GlobalAnnos
ga Id
i [a]
trm
, SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenList SplitM a
splt GlobalAnnos
ga Id
i [a]
trm
, SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFloat SplitM a
splt GlobalAnnos
ga Id
i [a]
trm
, SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFrac SplitM a
splt GlobalAnnos
ga Id
i [a]
trm
]
isGenNum :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i trs :: [a]
trs = case [a]
trs of
[] -> Id -> Bool
digitTest Id
i
_ -> SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNumber SplitM a
splt GlobalAnnos
ga Id
i [a]
trs
isGenNumber :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNumber :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNumber splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i trs :: [a]
trs = case [a]
trs of
[_, _] -> GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i LiteralType -> LiteralType -> Bool
forall a. Eq a => a -> a -> Bool
== LiteralType
Number
Bool -> Bool -> Bool
&& (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SplitM a -> (Id -> Bool) -> Id -> a -> Bool
forall a. SplitM a -> (Id -> Bool) -> Id -> a -> Bool
sameId SplitM a
splt Id -> Bool
digitTest Id
i) [a]
trs
_ -> Bool
False
digitTest :: Id -> Bool
digitTest :: Id -> Bool
digitTest ii :: Id
ii = case Id
ii of
Id [t :: Token
t] [] _ -> case Token -> String
tokStr Token
t of
[d :: Char
d] -> Char -> Bool
isDigit Char
d
_ -> Bool
False
_ -> Bool
False
isGenSignedNumber :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenSignedNumber :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenSignedNumber splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i trs :: [a]
trs =
case [a]
trs of
[hd :: a
hd] -> case SplitM a
splt a
hd of
Just (ni :: Id
ni, nt :: [a]
nt) -> Id -> Bool
isSign Id
i Bool -> Bool -> Bool
&& SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum SplitM a
splt GlobalAnnos
ga Id
ni [a]
nt
Nothing -> Bool
False
_ -> Bool
False
isSign :: Id -> Bool
isSign :: Id -> Bool
isSign i :: Id
i = case Id
i of
Id [tok :: Token
tok, p :: Token
p] [] _ | Token -> Bool
isPlace Token
p ->
let ts :: String
ts = Token -> String
tokStr Token
tok in String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-" Bool -> Bool -> Bool
|| String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "+"
_ -> Bool
False
isGenString :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenString :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenString splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i trs :: [a]
trs = case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i of
StringNull -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
trs
StringCons _ -> (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SplitM a -> (Id -> Bool) -> Id -> a -> Bool
forall a. SplitM a -> (Id -> Bool) -> Id -> a -> Bool
sameId SplitM a
splt Id -> Bool
stringTest Id
i) [a]
trs
_ -> Bool
False
where
stringTest :: Id -> Bool
stringTest ii :: Id
ii = case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
ii of
StringNull -> Bool
True
_ -> case Id
ii of
Id [t :: Token
t] [] _ -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "'" (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Token -> String
tokStr Token
t
_ -> Bool
False
isGenList :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenList :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenList splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i trms :: [a]
trms = case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i of
ListNull _ -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
trms
ListCons _ n :: Id
n -> Id -> Id -> [a] -> Bool
listTest Id
n Id
i [a]
trms
_ -> Bool
False
where listTest :: Id -> Id -> [a] -> Bool
listTest n1 :: Id
n1 i1 :: Id
i1 terms :: [a]
terms = case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i1 of
ListNull _ -> Id
n1 Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
i1 Bool -> Bool -> Bool
&& [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
terms
ListCons _ n2 :: Id
n2 -> Id
n1 Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
n2 Bool -> Bool -> Bool
&& case [a]
terms of
[_, hd :: a
hd] -> case SplitM a
splt a
hd of
Just (i2 :: Id
i2, ts :: [a]
ts) -> Id -> Id -> [a] -> Bool
listTest Id
n1 Id
i2 [a]
ts
Nothing -> Bool
False
_ -> Bool
False
_ -> Bool
False
isGenFloat :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFloat :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFloat splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i [l :: a
l, r :: a
r] =
case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i of
Floating -> case (SplitM a
splt a
l, SplitM a
splt a
r) of
(Just (li :: Id
li, ltrm :: [a]
ltrm), Just (ri :: Id
ri, rtrm :: [a]
rtrm)) ->
(SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum SplitM a
splt GlobalAnnos
ga Id
li [a]
ltrm Bool -> Bool -> Bool
|| SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFrac SplitM a
splt GlobalAnnos
ga Id
li [a]
ltrm) Bool -> Bool -> Bool
&&
(SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenSignedNumber SplitM a
splt GlobalAnnos
ga Id
ri [a]
rtrm Bool -> Bool -> Bool
|| SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum SplitM a
splt GlobalAnnos
ga Id
ri [a]
rtrm)
_ -> Bool
False
_ -> Bool
False
isGenFloat _ _ _ _ = Bool
False
isGenFrac :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFrac :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFrac splt :: SplitM a
splt ga :: GlobalAnnos
ga i :: Id
i [l :: a
l, r :: a
r] =
case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i of
Fraction -> case (SplitM a
splt a
l, SplitM a
splt a
r) of
(Just (li :: Id
li, ltrm :: [a]
ltrm), Just (ri :: Id
ri, rtrm :: [a]
rtrm)) ->
SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum SplitM a
splt GlobalAnnos
ga Id
li [a]
ltrm Bool -> Bool -> Bool
&& SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenNum SplitM a
splt GlobalAnnos
ga Id
ri [a]
rtrm
_ -> Bool
False
_ -> Bool
False
isGenFrac _ _ _ _ = Bool
False
sameId :: SplitM a -> (Id -> Bool) -> Id -> a -> Bool
sameId :: SplitM a -> (Id -> Bool) -> Id -> a -> Bool
sameId splt :: SplitM a
splt test :: Id -> Bool
test i :: Id
i t :: a
t = case SplitM a
splt a
t of
Just (j :: Id
j, ts :: [a]
ts) -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ts then Id -> Bool
test Id
j
else Id
j Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
i Bool -> Bool -> Bool
&& (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SplitM a -> (Id -> Bool) -> Id -> a -> Bool
forall a. SplitM a -> (Id -> Bool) -> Id -> a -> Bool
sameId SplitM a
splt Id -> Bool
test Id
i) [a]
ts
_ -> Bool
False
joinToken :: Token -> Token -> Token
joinToken :: Token -> Token -> Token
joinToken (Token s1 :: String
s1 _) (Token s2 :: String
s2 _) =
String -> Range -> Token
Token (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2) Range
nullRange
toSignedNumber :: (a -> (Id, [a])) -> Id -> [a] -> Token
toSignedNumber :: (a -> (Id, [a])) -> Id -> [a] -> Token
toSignedNumber splt :: a -> (Id, [a])
splt (Id [sign :: Token
sign, p :: Token
p] [] _) [hd :: a
hd] | Token -> Bool
isPlace Token
p = case a -> (Id, [a])
splt a
hd of
(i :: Id
i, ts :: [a]
ts) -> Token -> Token -> Token
joinToken Token
sign (Token -> Token) -> Token -> Token
forall a b. (a -> b) -> a -> b
$ (a -> (Id, [a])) -> Id -> [a] -> Token
forall a. (a -> (Id, [a])) -> Id -> [a] -> Token
toNumber a -> (Id, [a])
splt Id
i [a]
ts
toSignedNumber _ _ _ = String -> Token
forall a. HasCallStack => String -> a
error "toSignedNumber"
toNumber :: (a -> (Id, [a])) -> Id -> [a] -> Token
toNumber :: (a -> (Id, [a])) -> Id -> [a] -> Token
toNumber splt :: a -> (Id, [a])
splt i :: Id
i ts :: [a]
ts = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ts then case Id
i of
Id [d :: Token
d] [] _ -> Token
d
_ -> String -> Token
forall a. HasCallStack => String -> a
error "toNumber"
else (Token -> Token -> Token) -> [Token] -> Token
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Token -> Token -> Token
joinToken ([Token] -> Token) -> [Token] -> Token
forall a b. (a -> b) -> a -> b
$ (a -> Token) -> [a] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> (Id, [a])) -> a -> Token
forall a. (a -> (Id, [a])) -> a -> Token
toNumber2 a -> (Id, [a])
splt) [a]
ts
toNumber2 :: (a -> (Id, [a])) -> a -> Token
toNumber2 :: (a -> (Id, [a])) -> a -> Token
toNumber2 splt :: a -> (Id, [a])
splt t :: a
t = case a -> (Id, [a])
splt a
t of (j :: Id
j, args :: [a]
args) -> (a -> (Id, [a])) -> Id -> [a] -> Token
forall a. (a -> (Id, [a])) -> Id -> [a] -> Token
toNumber a -> (Id, [a])
splt Id
j [a]
args
toFrac :: (a -> (Id, [a])) -> [a] -> Token
toFrac :: (a -> (Id, [a])) -> [a] -> Token
toFrac splt :: a -> (Id, [a])
splt [lt :: a
lt, rt :: a
rt] =
Token -> Token -> Token
joinToken ((a -> (Id, [a])) -> a -> Token
forall a. (a -> (Id, [a])) -> a -> Token
toNumber2 a -> (Id, [a])
splt a
lt) (Token -> Token) -> Token -> Token
forall a b. (a -> b) -> a -> b
$
Token -> Token -> Token
joinToken (String -> Range -> Token
Token "." Range
nullRange) (Token -> Token) -> Token -> Token
forall a b. (a -> b) -> a -> b
$
(a -> (Id, [a])) -> a -> Token
forall a. (a -> (Id, [a])) -> a -> Token
toNumber2 a -> (Id, [a])
splt a
rt
toFrac _ _ = String -> Token
forall a. HasCallStack => String -> a
error "toFrac"
toFloat :: (a -> (Id, [a])) -> GlobalAnnos -> [a] -> Token
toFloat :: (a -> (Id, [a])) -> GlobalAnnos -> [a] -> Token
toFloat splt :: a -> (Id, [a])
splt ga :: GlobalAnnos
ga [lt :: a
lt, rt :: a
rt] =
case (a -> (Id, [a])
splt a
lt, a -> (Id, [a])
splt a
rt) of
((bas_i :: Id
bas_i, bas_t :: [a]
bas_t), (ex_i :: Id
ex_i, ex_t :: [a]
ex_t)) ->
let t1 :: Token
t1 = if SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenFrac ((Id, [a]) -> Maybe (Id, [a])
forall a. a -> Maybe a
Just ((Id, [a]) -> Maybe (Id, [a])) -> (a -> (Id, [a])) -> SplitM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Id, [a])
splt) GlobalAnnos
ga Id
bas_i [a]
bas_t then
(a -> (Id, [a])) -> [a] -> Token
forall a. (a -> (Id, [a])) -> [a] -> Token
toFrac a -> (Id, [a])
splt [a]
bas_t else
(a -> (Id, [a])) -> Id -> [a] -> Token
forall a. (a -> (Id, [a])) -> Id -> [a] -> Token
toNumber a -> (Id, [a])
splt Id
bas_i [a]
bas_t
t2 :: Token
t2 = if SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
forall a. SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
isGenSignedNumber ((Id, [a]) -> Maybe (Id, [a])
forall a. a -> Maybe a
Just ((Id, [a]) -> Maybe (Id, [a])) -> (a -> (Id, [a])) -> SplitM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Id, [a])
splt) GlobalAnnos
ga Id
ex_i [a]
ex_t then
(a -> (Id, [a])) -> Id -> [a] -> Token
forall a. (a -> (Id, [a])) -> Id -> [a] -> Token
toSignedNumber a -> (Id, [a])
splt Id
ex_i [a]
ex_t else
(a -> (Id, [a])) -> Id -> [a] -> Token
forall a. (a -> (Id, [a])) -> Id -> [a] -> Token
toNumber a -> (Id, [a])
splt Id
ex_i [a]
ex_t
in Token -> Token -> Token
joinToken Token
t1 (Token -> Token) -> Token -> Token
forall a b. (a -> b) -> a -> b
$ Token -> Token -> Token
joinToken (String -> Range -> Token
Token "E" Range
nullRange) Token
t2
toFloat _ _ _ = String -> Token
forall a. HasCallStack => String -> a
error "toFloat2"
toChar :: Token -> String
toChar :: Token -> String
toChar t :: Token
t = case Token -> String
tokStr Token
t of
'\'' : rt :: String
rt -> String -> String
forall a. [a] -> [a]
init String
rt
_ -> String -> String
forall a. HasCallStack => String -> a
error "toChar"
toString :: (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> Token
toString :: (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> Token
toString splt :: a -> (Id, [a])
splt ga :: GlobalAnnos
ga i :: Id
i ts :: [a]
ts =
String -> Range -> Token
Token ( "\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
forall a. (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
toString1 a -> (Id, [a])
splt GlobalAnnos
ga Id
i [a]
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"") Range
nullRange
toString1 :: (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
toString1 :: (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
toString1 splt :: a -> (Id, [a])
splt ga :: GlobalAnnos
ga i :: Id
i ts :: [a]
ts = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ts then
case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i of
StringNull -> ""
_ -> case Id
i of
Id [c :: Token
c] [] _ -> Token -> String
toChar Token
c
_ -> String -> String
forall a. HasCallStack => String -> a
error "toString"
else (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> (Id, [a])) -> GlobalAnnos -> a -> String
forall a. (a -> (Id, [a])) -> GlobalAnnos -> a -> String
toString2 a -> (Id, [a])
splt GlobalAnnos
ga) [a]
ts
toString2 :: (a -> (Id, [a])) -> GlobalAnnos -> a -> String
toString2 :: (a -> (Id, [a])) -> GlobalAnnos -> a -> String
toString2 splt :: a -> (Id, [a])
splt ga :: GlobalAnnos
ga t :: a
t = case a -> (Id, [a])
splt a
t of (i :: Id
i, ts :: [a]
ts) -> (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
forall a. (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
toString1 a -> (Id, [a])
splt GlobalAnnos
ga Id
i [a]
ts
getListElems :: (a -> (Id, [a])) -> [a] -> [a]
getListElems :: (a -> (Id, [a])) -> [a] -> [a]
getListElems splt :: a -> (Id, [a])
splt ts :: [a]
ts = case [a]
ts of
[] -> []
[ft :: a
ft, rt :: a
rt] -> a
ft a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> (Id, [a])) -> [a] -> [a]
forall a. (a -> (Id, [a])) -> [a] -> [a]
getListElems a -> (Id, [a])
splt ((Id, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Id, [a]) -> [a]) -> (Id, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ a -> (Id, [a])
splt a
rt)
_ -> String -> [a]
forall a. HasCallStack => String -> a
error "getListElems"
toMixfixList :: (Id -> [a] -> Id -> b) -> (a -> (Id, [a]))
-> GlobalAnnos -> Id -> [a] -> b
toMixfixList :: (Id -> [a] -> Id -> b)
-> (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> b
toMixfixList mkList :: Id -> [a] -> Id -> b
mkList splt :: a -> (Id, [a])
splt ga :: GlobalAnnos
ga i :: Id
i ts :: [a]
ts =
let args :: [a]
args = (a -> (Id, [a])) -> [a] -> [a]
forall a. (a -> (Id, [a])) -> [a] -> [a]
getListElems a -> (Id, [a])
splt [a]
ts
(openL :: [Token]
openL, closeL :: [Token]
closeL, comps :: [Id]
comps) = Id -> ([Token], [Token], [Id])
getListBrackets (Id -> ([Token], [Token], [Id])) -> Id -> ([Token], [Token], [Id])
forall a b. (a -> b) -> a -> b
$
case GlobalAnnos -> Id -> LiteralType
getLiteralType GlobalAnnos
ga Id
i of
ListNull b :: Id
b -> Id
b
ListCons b :: Id
b _ -> Id
b
_ -> String -> Id
forall a. HasCallStack => String -> a
error "print_Literal_text"
in Id -> [a] -> Id -> b
mkList ([Token] -> [Id] -> Range -> Id
Id [Token]
openL [] Range
nullRange) [a]
args ([Token] -> [Id] -> Range -> Id
Id [Token]
closeL [Id]
comps Range
nullRange)