{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
module Test.IOTasks.ValueMap (
  ValueMap,
  emptyValueMap, insertValue,
  Test.IOTasks.ValueMap.lookup,
  sortedEntries,
  varnameTypeRep, varnameVarList,
  Value(..),
  wrapValue, unwrapValue,
  readValue, showValue,
  ValueEntry(..),
  withValueEntry,
  unwrapValueEntry,
  lookupInteger, lookupBool, lookupString,
  ) where

import Data.List as List (sortOn, lookup)
import Data.Maybe (mapMaybe)
import Data.Map (Map)
import qualified Data.Map as Map

import Type.Reflection

import Test.IOTasks.Var (SomeVar(..), someVarname, Varname, Embedded (Embedded), Var (..), someVar, varTypeRep, SomeConsistentVars, someConsistentVars)
import Text.Read (readMaybe)
import Type.Match (fallbackCase', inCaseOf, inCaseOfApp, matchTypeOf)
import Data.Bifunctor (first)

data ValueMap = ValueMap { ValueMap -> Map SomeVar ValueEntry
valueMap :: Map SomeVar ValueEntry, ValueMap -> Int
size :: Int } deriving (ValueMap -> ValueMap -> Bool
(ValueMap -> ValueMap -> Bool)
-> (ValueMap -> ValueMap -> Bool) -> Eq ValueMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueMap -> ValueMap -> Bool
== :: ValueMap -> ValueMap -> Bool
$c/= :: ValueMap -> ValueMap -> Bool
/= :: ValueMap -> ValueMap -> Bool
Eq,Int -> ValueMap -> ShowS
[ValueMap] -> ShowS
ValueMap -> String
(Int -> ValueMap -> ShowS)
-> (ValueMap -> String) -> ([ValueMap] -> ShowS) -> Show ValueMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueMap -> ShowS
showsPrec :: Int -> ValueMap -> ShowS
$cshow :: ValueMap -> String
show :: ValueMap -> String
$cshowList :: [ValueMap] -> ShowS
showList :: [ValueMap] -> ShowS
Show)

data ValueEntry = NoEntry | IntegerEntry [(Integer,Int)] | BoolEntry [(Bool,Int)] | StringEntry [(String,Int)] deriving (ValueEntry -> ValueEntry -> Bool
(ValueEntry -> ValueEntry -> Bool)
-> (ValueEntry -> ValueEntry -> Bool) -> Eq ValueEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueEntry -> ValueEntry -> Bool
== :: ValueEntry -> ValueEntry -> Bool
$c/= :: ValueEntry -> ValueEntry -> Bool
/= :: ValueEntry -> ValueEntry -> Bool
Eq,Int -> ValueEntry -> ShowS
[ValueEntry] -> ShowS
ValueEntry -> String
(Int -> ValueEntry -> ShowS)
-> (ValueEntry -> String)
-> ([ValueEntry] -> ShowS)
-> Show ValueEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueEntry -> ShowS
showsPrec :: Int -> ValueEntry -> ShowS
$cshow :: ValueEntry -> String
show :: ValueEntry -> String
$cshowList :: [ValueEntry] -> ShowS
showList :: [ValueEntry] -> ShowS
Show)

emptyValueMap :: [SomeVar] -> ValueMap
emptyValueMap :: [SomeVar] -> ValueMap
emptyValueMap [SomeVar]
xs = Map SomeVar ValueEntry -> Int -> ValueMap
ValueMap ([(SomeVar, ValueEntry)] -> Map SomeVar ValueEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((,ValueEntry
NoEntry) (SomeVar -> (SomeVar, ValueEntry))
-> [SomeVar] -> [(SomeVar, ValueEntry)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeVar]
xs)) Int
0

lookup :: SomeVar -> ValueMap -> Maybe ValueEntry
lookup :: SomeVar -> ValueMap -> Maybe ValueEntry
lookup SomeVar
k = SomeVar -> Map SomeVar ValueEntry -> Maybe ValueEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SomeVar
k (Map SomeVar ValueEntry -> Maybe ValueEntry)
-> (ValueMap -> Map SomeVar ValueEntry)
-> ValueMap
-> Maybe ValueEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueMap -> Map SomeVar ValueEntry
valueMap

-- if there is a unique type for all Varnames in the list and it is the same for all names return the TypeRep of that type
varnameTypeRep :: [Varname] -> ValueMap -> Maybe SomeTypeRep
varnameTypeRep :: [String] -> ValueMap -> Maybe SomeTypeRep
varnameTypeRep [String]
xs ValueMap
m = [Maybe SomeTypeRep] -> Maybe SomeTypeRep
forall a. Eq a => [Maybe a] -> Maybe a
uniqueResult ([Maybe SomeTypeRep] -> Maybe SomeTypeRep)
-> [Maybe SomeTypeRep] -> Maybe SomeTypeRep
forall a b. (a -> b) -> a -> b
$ (String -> Maybe SomeTypeRep) -> [String] -> [Maybe SomeTypeRep]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [(String, SomeTypeRep)] -> Maybe SomeTypeRep
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`List.lookup` (SomeVar -> (String, SomeTypeRep))
-> [SomeVar] -> [(String, SomeTypeRep)]
forall a b. (a -> b) -> [a] -> [b]
map SomeVar -> (String, SomeTypeRep)
varInfo (Map SomeVar ValueEntry -> [SomeVar]
forall k a. Map k a -> [k]
Map.keys (Map SomeVar ValueEntry -> [SomeVar])
-> Map SomeVar ValueEntry -> [SomeVar]
forall a b. (a -> b) -> a -> b
$ ValueMap -> Map SomeVar ValueEntry
valueMap ValueMap
m)) [String]
xs
  where
    varInfo :: SomeVar -> (Varname, SomeTypeRep)
    varInfo :: SomeVar -> (String, SomeTypeRep)
varInfo (SomeVar (IntVar String
x)) = (String
x,TypeRep Integer -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Integer -> SomeTypeRep) -> TypeRep Integer -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Integer)
    varInfo (SomeVar (BoolVar String
x)) = (String
x,TypeRep Bool -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Bool -> SomeTypeRep) -> TypeRep Bool -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Bool)
    varInfo (SomeVar (StringVar String
x)) = (String
x, TypeRep String -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep String -> SomeTypeRep) -> TypeRep String -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @String)
    varInfo (SomeVar (EmbeddedVar TypeRep a1
ty String
x)) = (String
x, TypeRep (Embedded a1) -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep (Embedded a1) -> SomeTypeRep)
-> TypeRep (Embedded a1) -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep Embedded -> TypeRep a1 -> TypeRep (Embedded a1)
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
App (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @Embedded) TypeRep a1
ty)

uniqueResult :: Eq a => [Maybe a] -> Maybe a
uniqueResult :: forall a. Eq a => [Maybe a] -> Maybe a
uniqueResult [] = Maybe a
forall a. Maybe a
Nothing
uniqueResult [Maybe a
x] = Maybe a
x
uniqueResult (Maybe a
Nothing:[Maybe a]
_) = Maybe a
forall a. Maybe a
Nothing
uniqueResult (Just a
x:[Maybe a]
xs) = (\a
y -> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then a -> Maybe a
forall a. a -> Maybe a
Just a
y else Maybe a
forall a. Maybe a
Nothing) (a -> Maybe a) -> Maybe a -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Maybe a] -> Maybe a
forall a. Eq a => [Maybe a] -> Maybe a
uniqueResult [Maybe a]
xs

varnameVarList :: [Varname] -> ValueMap -> Maybe SomeConsistentVars
varnameVarList :: [String] -> ValueMap -> Maybe SomeConsistentVars
varnameVarList [String]
xs = [SomeVar] -> Maybe SomeConsistentVars
someConsistentVars ([SomeVar] -> Maybe SomeConsistentVars)
-> (ValueMap -> [SomeVar]) -> ValueMap -> Maybe SomeConsistentVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeVar -> Bool) -> [SomeVar] -> [SomeVar]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xs) (String -> Bool) -> (SomeVar -> String) -> SomeVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeVar -> String
someVarname) ([SomeVar] -> [SomeVar])
-> (ValueMap -> [SomeVar]) -> ValueMap -> [SomeVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SomeVar ValueEntry -> [SomeVar]
forall k a. Map k a -> [k]
Map.keys (Map SomeVar ValueEntry -> [SomeVar])
-> (ValueMap -> Map SomeVar ValueEntry) -> ValueMap -> [SomeVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueMap -> Map SomeVar ValueEntry
valueMap

combinedEntries :: Typeable a => [Var a] -> ValueMap -> ValueEntry
combinedEntries :: forall a. Typeable a => [Var a] -> ValueMap -> ValueEntry
combinedEntries [Var a]
x ValueMap
m = (ValueEntry -> ValueEntry -> ValueEntry)
-> ValueEntry -> [ValueEntry] -> ValueEntry
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ValueEntry -> ValueEntry -> ValueEntry
combineEntries ValueEntry
NoEntry ([ValueEntry] -> ValueEntry) -> [ValueEntry] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ (Var a -> Maybe ValueEntry) -> [Var a] -> [ValueEntry]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((SomeVar -> Map SomeVar ValueEntry -> Maybe ValueEntry
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ValueMap -> Map SomeVar ValueEntry
valueMap ValueMap
m) (SomeVar -> Maybe ValueEntry)
-> (Var a -> SomeVar) -> Var a -> Maybe ValueEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var a -> SomeVar
forall a. Typeable a => Var a -> SomeVar
someVar) [Var a]
x
  where
    combineEntries :: ValueEntry -> ValueEntry -> ValueEntry
combineEntries ValueEntry
NoEntry ValueEntry
y = ValueEntry
y
    combineEntries ValueEntry
x ValueEntry
NoEntry = ValueEntry
x
    combineEntries (IntegerEntry [(Integer, Int)]
xs) (IntegerEntry [(Integer, Int)]
ys) = [(Integer, Int)] -> ValueEntry
IntegerEntry ([(Integer, Int)] -> ValueEntry) -> [(Integer, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Integer, Int)]
xs [(Integer, Int)] -> [(Integer, Int)] -> [(Integer, Int)]
forall a. [a] -> [a] -> [a]
++ [(Integer, Int)]
ys
    combineEntries (StringEntry [(String, Int)]
xs) (StringEntry [(String, Int)]
ys) = [(String, Int)] -> ValueEntry
StringEntry ([(String, Int)] -> ValueEntry) -> [(String, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xs [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ [(String, Int)]
ys
    combineEntries ValueEntry
_ ValueEntry
_ = String -> ValueEntry
forall a. HasCallStack => String -> a
error String
"combinedEntries: impossible"

-- TODO: before combining each entry is already sorted, switch to merge sort?
sortedEntries :: Typeable a => [Var a] -> ValueMap -> ValueEntry
sortedEntries :: forall a. Typeable a => [Var a] -> ValueMap -> ValueEntry
sortedEntries [Var a]
x ValueMap
m = ValueEntry -> ValueEntry
sortEntry (ValueEntry -> ValueEntry) -> ValueEntry -> ValueEntry
forall a b. (a -> b) -> a -> b
$ [Var a] -> ValueMap -> ValueEntry
forall a. Typeable a => [Var a] -> ValueMap -> ValueEntry
combinedEntries [Var a]
x ValueMap
m

sortEntry :: ValueEntry -> ValueEntry
sortEntry :: ValueEntry -> ValueEntry
sortEntry ValueEntry
NoEntry = ValueEntry
NoEntry
sortEntry (IntegerEntry [(Integer, Int)]
xs) = [(Integer, Int)] -> ValueEntry
IntegerEntry ([(Integer, Int)] -> ValueEntry) -> [(Integer, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ ((Integer, Int) -> Int) -> [(Integer, Int)] -> [(Integer, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer, Int) -> Int
forall a b. (a, b) -> b
snd [(Integer, Int)]
xs
sortEntry (BoolEntry [(Bool, Int)]
xs) = [(Bool, Int)] -> ValueEntry
BoolEntry ([(Bool, Int)] -> ValueEntry) -> [(Bool, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ ((Bool, Int) -> Int) -> [(Bool, Int)] -> [(Bool, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Bool, Int) -> Int
forall a b. (a, b) -> b
snd [(Bool, Int)]
xs
sortEntry (StringEntry [(String, Int)]
xs) = [(String, Int)] -> ValueEntry
StringEntry ([(String, Int)] -> ValueEntry) -> [(String, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [(String, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
xs

withValueEntry :: ValueEntry -> r -> (forall a. (Typeable a, Show a) => [(a,Int)] -> r) -> r
withValueEntry :: forall r.
ValueEntry
-> r -> (forall a. (Typeable a, Show a) => [(a, Int)] -> r) -> r
withValueEntry ValueEntry
NoEntry r
c forall a. (Typeable a, Show a) => [(a, Int)] -> r
_ = r
c
withValueEntry (IntegerEntry [(Integer, Int)]
xs) r
_ forall a. (Typeable a, Show a) => [(a, Int)] -> r
f = [(Integer, Int)] -> r
forall a. (Typeable a, Show a) => [(a, Int)] -> r
f [(Integer, Int)]
xs
withValueEntry (BoolEntry [(Bool, Int)]
xs) r
_ forall a. (Typeable a, Show a) => [(a, Int)] -> r
f = [(Bool, Int)] -> r
forall a. (Typeable a, Show a) => [(a, Int)] -> r
f [(Bool, Int)]
xs
withValueEntry (StringEntry [(String, Int)]
xs) r
_ forall a. (Typeable a, Show a) => [(a, Int)] -> r
f = [(String, Int)] -> r
forall a. (Typeable a, Show a) => [(a, Int)] -> r
f [(String, Int)]
xs

unwrapValueEntry :: Var a -> ValueEntry -> [(a,Int)]
unwrapValueEntry :: forall a. Var a -> ValueEntry -> [(a, Int)]
unwrapValueEntry Var a
_ ValueEntry
NoEntry = []

unwrapValueEntry IntVar{} (IntegerEntry [(Integer, Int)]
xs) = [(a, Int)]
[(Integer, Int)]
xs
unwrapValueEntry BoolVar{} (IntegerEntry [(Integer, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"unwrapValue: incompatible type - Integer (or I) and Bool"
unwrapValueEntry StringVar{} (IntegerEntry [(Integer, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"unwrapValue: incompatible type - Integer (or I) and String"
unwrapValueEntry EmbeddedVar{} (IntegerEntry [(Integer, Int)]
xs) = ((Integer, Int) -> (a, Int)) -> [(Integer, Int)] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> a) -> (Integer, Int) -> (a, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Integer -> a
Integer -> Embedded a1
forall a. (Show a, Embeddable a) => Integer -> Embedded a
Embedded) [(Integer, Int)]
xs

unwrapValueEntry IntVar{} (BoolEntry [(Bool, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"unwrapValue: incompatible type - Bool and Integer (or I)"
unwrapValueEntry BoolVar{} (BoolEntry [(Bool, Int)]
xs) = [(a, Int)]
[(Bool, Int)]
xs
unwrapValueEntry StringVar{} (BoolEntry [(Bool, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"unwrapValue: incompatible type - Bool and String"
unwrapValueEntry (EmbeddedVar TypeRep a1
ty String
_) (BoolEntry [(Bool, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error (String -> [(a, Int)]) -> String -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ String
"unwrapValue: incompatible type - Bool and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep (Embedded a1) -> String
forall a. Show a => a -> String
show (TypeRep Embedded -> TypeRep a1 -> TypeRep (Embedded a1)
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
App (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @Embedded) TypeRep a1
ty)

unwrapValueEntry StringVar{} (StringEntry [(String, Int)]
xs) = [(a, Int)]
[(String, Int)]
xs
unwrapValueEntry IntVar{} (StringEntry [(String, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"unwrapValue: incompatible type - String and Integer (or I)"
unwrapValueEntry BoolVar{} (StringEntry [(String, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error String
"unwrapValue: incompatible type - String and Bool"
unwrapValueEntry (EmbeddedVar TypeRep a1
ty String
_) (StringEntry [(String, Int)]
_) = String -> [(a, Int)]
forall a. HasCallStack => String -> a
error (String -> [(a, Int)]) -> String -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ String
"unwrapValue: incompatible type - String and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep (Embedded a1) -> String
forall a. Show a => a -> String
show (TypeRep Embedded -> TypeRep a1 -> TypeRep (Embedded a1)
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
App (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @Embedded) TypeRep a1
ty)

data Value = IntegerValue Integer | BoolValue Bool | StringValue String deriving Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show

showValue :: Value -> String
showValue :: Value -> String
showValue (IntegerValue Integer
i) = Integer -> String
forall a. Show a => a -> String
show Integer
i
showValue (BoolValue Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
showValue (StringValue String
s) = String
s

wrapValue :: Typeable a => a -> Value
wrapValue :: forall a. Typeable a => a -> Value
wrapValue = a -> Value
forall a. Typeable a => a -> Value
wrapValue' where
  wrapValue' :: forall a. Typeable a => a -> Value
  wrapValue' :: forall a. Typeable a => a -> Value
wrapValue' a
x =
    a -> [Case a Value] -> Value
forall a r. Typeable a => a -> [Case a r] -> r
matchTypeOf a
x
      [ forall {k} a (x :: k) r. Typeable a => (a -> r) -> Case x r
forall a x r. Typeable a => (a -> r) -> Case x r
inCaseOf @Integer Integer -> Value
IntegerValue
      , forall {k} a (x :: k) r. Typeable a => (a -> r) -> Case x r
forall a x r. Typeable a => (a -> r) -> Case x r
inCaseOf @Bool Bool -> Value
BoolValue
      , forall {k} a (x :: k) r. Typeable a => (a -> r) -> Case x r
forall a x r. Typeable a => (a -> r) -> Case x r
inCaseOf @String String -> Value
StringValue
      , forall {k1} {k2} (f :: k1 -> *) (x :: k2) r.
Typeable f =>
(forall (a :: k1). (f a :~~: x) -> f a -> r) -> Case x r
forall (f :: * -> *) x r.
Typeable f =>
(forall a. (f a :~~: x) -> f a -> r) -> Case x r
inCaseOfApp @Embedded ((forall a. (Embedded a :~~: a) -> Embedded a -> Value)
 -> Case a Value)
-> (forall a. (Embedded a :~~: a) -> Embedded a -> Value)
-> Case a Value
forall a b. (a -> b) -> a -> b
$ \Embedded a :~~: a
HRefl (Embedded Integer
i) -> Integer -> Value
IntegerValue Integer
i
      , Value -> Case a Value
forall {k} r (x :: k). r -> Case x r
fallbackCase' (Value -> Case a Value) -> Value -> Case a Value
forall a b. (a -> b) -> a -> b
$ String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"wrapValue: unsupported type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
      ]

unwrapValue :: Var a -> Value -> a
unwrapValue :: forall a. Var a -> Value -> a
unwrapValue IntVar{} (IntegerValue Integer
i) = a
Integer
i
unwrapValue BoolVar{} (BoolValue Bool
b) = a
Bool
b
unwrapValue StringVar{} (StringValue String
x) = a
String
x
unwrapValue EmbeddedVar{} (IntegerValue Integer
i) = Integer -> Embedded a1
forall a. (Show a, Embeddable a) => Integer -> Embedded a
Embedded Integer
i
unwrapValue Var a
x IntegerValue{} = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"unwrapValue: incompatible type - Integer and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (Var a -> TypeRep a
forall a. Var a -> TypeRep a
varTypeRep Var a
x)
unwrapValue Var a
x BoolValue{} = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"unwrapValue: incompatible type - Bool and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (Var a -> TypeRep a
forall a. Var a -> TypeRep a
varTypeRep Var a
x)
unwrapValue Var a
x StringValue{} = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"unwrapValue: incompatible type - String and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (Var a -> TypeRep a
forall a. Var a -> TypeRep a
varTypeRep Var a
x)

readValue :: Var a -> String -> a
readValue :: forall a. Var a -> String -> a
readValue = Var a -> String -> a
forall a. Var a -> String -> a
readValue' where
  readValue' :: Var a -> String -> a
  readValue' :: forall a. Var a -> String -> a
readValue' IntVar{} String
x = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
x of
    Just a
i -> a
i
    Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - Integer"
  readValue' BoolVar{} String
x = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
x of
    Just a
i -> a
i
    Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - Bool"
  readValue' StringVar{} String
x = a
String
x
  readValue' (EmbeddedVar (TypeRep a1
ty :: TypeRep a) String
_) String
x =
    case forall a. Read a => String -> Maybe a
readMaybe @(Embedded a) String
x of
      Just Embedded a1
v -> a
Embedded a1
v
      Maybe (Embedded a1)
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - Embedded " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a1 -> String
forall a. Show a => a -> String
show TypeRep a1
ty

insertValue :: Value -> SomeVar -> ValueMap -> ValueMap
insertValue :: Value -> SomeVar -> ValueMap -> ValueMap
insertValue Value
v SomeVar
k (ValueMap Map SomeVar ValueEntry
m Int
sz)
  | Value
v Value -> SomeVar -> Bool
`hasType` SomeVar
k = Map SomeVar ValueEntry -> Int -> ValueMap
ValueMap ((Maybe ValueEntry -> Maybe ValueEntry)
-> SomeVar -> Map SomeVar ValueEntry -> Map SomeVar ValueEntry
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Value -> Maybe ValueEntry -> Maybe ValueEntry
f Value
v) SomeVar
k Map SomeVar ValueEntry
m) Int
i
  | Bool
otherwise = String -> ValueMap
forall a. HasCallStack => String -> a
error (String -> ValueMap) -> String -> ValueMap
forall a b. (a -> b) -> a -> b
$ String
"insertValue: type mismatch for variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeVar -> String
someVarname SomeVar
k
  where
    i :: Int
i = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    f :: Value -> Maybe ValueEntry -> Maybe ValueEntry
f (IntegerValue Integer
x) Maybe ValueEntry
Nothing = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Integer, Int)] -> ValueEntry
IntegerEntry [(Integer
x,Int
i)]
    f (IntegerValue Integer
x) (Just ValueEntry
NoEntry) = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Integer, Int)] -> ValueEntry
IntegerEntry [(Integer
x,Int
i)]
    f (IntegerValue Integer
x) (Just (IntegerEntry [(Integer, Int)]
xs)) = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Integer, Int)] -> ValueEntry
IntegerEntry ([(Integer, Int)] -> ValueEntry) -> [(Integer, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ (Integer
x,Int
i)(Integer, Int) -> [(Integer, Int)] -> [(Integer, Int)]
forall a. a -> [a] -> [a]
:[(Integer, Int)]
xs
    f (BoolValue Bool
x) Maybe ValueEntry
Nothing = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Bool, Int)] -> ValueEntry
BoolEntry [(Bool
x,Int
i)]
    f (BoolValue Bool
x) (Just ValueEntry
NoEntry) = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Bool, Int)] -> ValueEntry
BoolEntry [(Bool
x,Int
i)]
    f (BoolValue Bool
x) (Just (BoolEntry [(Bool, Int)]
xs)) = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(Bool, Int)] -> ValueEntry
BoolEntry ([(Bool, Int)] -> ValueEntry) -> [(Bool, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ (Bool
x,Int
i)(Bool, Int) -> [(Bool, Int)] -> [(Bool, Int)]
forall a. a -> [a] -> [a]
:[(Bool, Int)]
xs
    f (StringValue String
x) Maybe ValueEntry
Nothing = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> ValueEntry
StringEntry [(String
x,Int
i)]
    f (StringValue String
x) (Just ValueEntry
NoEntry) = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> ValueEntry
StringEntry [(String
x,Int
i)]
    f (StringValue String
x) (Just (StringEntry [(String, Int)]
xs)) = ValueEntry -> Maybe ValueEntry
forall a. a -> Maybe a
Just (ValueEntry -> Maybe ValueEntry) -> ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> ValueEntry
StringEntry ([(String, Int)] -> ValueEntry) -> [(String, Int)] -> ValueEntry
forall a b. (a -> b) -> a -> b
$ (String
x,Int
i)(String, Int) -> [(String, Int)] -> [(String, Int)]
forall a. a -> [a] -> [a]
:[(String, Int)]
xs
    f Value
_ Maybe ValueEntry
_ = String -> Maybe ValueEntry
forall a. HasCallStack => String -> a
error (String -> Maybe ValueEntry) -> String -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ String
"insertValue: type mismatch for variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeVar -> String
someVarname SomeVar
k

hasType :: Value -> SomeVar -> Bool
hasType :: Value -> SomeVar -> Bool
hasType (IntegerValue Integer
_) (SomeVar IntVar{}) = Bool
True
hasType (IntegerValue Integer
_) (SomeVar EmbeddedVar{}) = Bool
True
hasType IntegerValue{} SomeVar
_ = Bool
False
hasType (BoolValue Bool
_) (SomeVar BoolVar{}) = Bool
True
hasType BoolValue{} SomeVar
_ = Bool
False
hasType (StringValue String
_) (SomeVar StringVar{}) = Bool
True
hasType StringValue{} SomeVar
_ = Bool
False

lookupInteger :: SomeVar -> ValueMap -> Maybe [(Integer,Int)]
lookupInteger :: SomeVar -> ValueMap -> Maybe [(Integer, Int)]
lookupInteger SomeVar
v ValueMap
m = do
  ValueEntry
r <- SomeVar -> Map SomeVar ValueEntry -> Maybe ValueEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SomeVar
v (Map SomeVar ValueEntry -> Maybe ValueEntry)
-> Map SomeVar ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ ValueMap -> Map SomeVar ValueEntry
valueMap ValueMap
m
  case ValueEntry
r of
    ValueEntry
NoEntry -> [(Integer, Int)] -> Maybe [(Integer, Int)]
forall a. a -> Maybe a
Just []
    IntegerEntry [(Integer, Int)]
xs -> [(Integer, Int)] -> Maybe [(Integer, Int)]
forall a. a -> Maybe a
Just [(Integer, Int)]
xs
    BoolEntry [(Bool, Int)]
_ -> Maybe [(Integer, Int)]
forall a. Maybe a
Nothing
    StringEntry [(String, Int)]
_ -> Maybe [(Integer, Int)]
forall a. Maybe a
Nothing

lookupBool :: SomeVar -> ValueMap -> Maybe [(Bool,Int)]
lookupBool :: SomeVar -> ValueMap -> Maybe [(Bool, Int)]
lookupBool SomeVar
v ValueMap
m = do
  ValueEntry
r <- SomeVar -> Map SomeVar ValueEntry -> Maybe ValueEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SomeVar
v (Map SomeVar ValueEntry -> Maybe ValueEntry)
-> Map SomeVar ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ ValueMap -> Map SomeVar ValueEntry
valueMap ValueMap
m
  case ValueEntry
r of
    ValueEntry
NoEntry -> [(Bool, Int)] -> Maybe [(Bool, Int)]
forall a. a -> Maybe a
Just []
    IntegerEntry [(Integer, Int)]
_ -> Maybe [(Bool, Int)]
forall a. Maybe a
Nothing
    BoolEntry [(Bool, Int)]
xs -> [(Bool, Int)] -> Maybe [(Bool, Int)]
forall a. a -> Maybe a
Just [(Bool, Int)]
xs
    StringEntry [(String, Int)]
_ -> Maybe [(Bool, Int)]
forall a. Maybe a
Nothing

lookupString :: SomeVar -> ValueMap -> Maybe [(String,Int)]
lookupString :: SomeVar -> ValueMap -> Maybe [(String, Int)]
lookupString SomeVar
v ValueMap
m = do
  ValueEntry
r <- SomeVar -> Map SomeVar ValueEntry -> Maybe ValueEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SomeVar
v (Map SomeVar ValueEntry -> Maybe ValueEntry)
-> Map SomeVar ValueEntry -> Maybe ValueEntry
forall a b. (a -> b) -> a -> b
$ ValueMap -> Map SomeVar ValueEntry
valueMap ValueMap
m
  case ValueEntry
r of
    ValueEntry
NoEntry -> [(String, Int)] -> Maybe [(String, Int)]
forall a. a -> Maybe a
Just []
    IntegerEntry [(Integer, Int)]
_ -> Maybe [(String, Int)]
forall a. Maybe a
Nothing
    BoolEntry [(Bool, Int)]
_ -> Maybe [(String, Int)]
forall a. Maybe a
Nothing
    StringEntry [(String, Int)]
xs -> [(String, Int)] -> Maybe [(String, Int)]
forall a. a -> Maybe a
Just [(String, Int)]
xs