{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Werror=incomplete-patterns #-}
module Fcf.Data.Reflect where
import qualified GHC.TypeLits as TL
import GHC.TypeLits (Nat, Symbol, KnownNat, KnownSymbol)
import Data.Proxy
import qualified Data.Map.Strict as MS
import qualified Data.IntMap.Strict as IMS
import qualified Data.Set as S
#if __GLASGOW_HASKELL__ >= 902
import qualified Data.Text as Txt
#endif
import qualified Data.Tree as T
import qualified Fcf.Data.MapC as MC
import qualified Fcf.Data.NatMap as NM
import qualified Fcf.Data.Set as FS
#if __GLASGOW_HASKELL__ >= 902
import qualified Fcf.Data.NewText as FTxt
#endif
import qualified Fcf.Data.Tree as FT
class KnownNats (ns :: [Nat]) where
natVals :: Proxy ns -> [Int]
instance KnownNats '[] where
natVals :: Proxy '[] -> [Int]
natVals Proxy '[]
_ = []
instance (TL.KnownNat n, KnownNats ns) => KnownNats (n : ns) where
natVals :: Proxy (n : ns) -> [Int]
natVals Proxy (n : ns)
_ = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Proxy ns -> [Int]
forall (ns :: [Nat]). KnownNats ns => Proxy ns -> [Int]
natVals (forall {t :: [Nat]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ns)
class KnownVal typeval val where
fromType :: Proxy typeval -> val
instance KnownNat n => KnownVal (n :: Nat) Integer where
fromType :: Proxy n -> Integer
fromType Proxy n
_ = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)
instance KnownNat n => KnownVal (n :: Nat) Int where
fromType :: Proxy n -> Int
fromType Proxy n
_ = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)
instance KnownSymbol s => KnownVal (s :: Symbol) String where
fromType :: Proxy s -> String
fromType Proxy s
_ = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @s)
instance KnownVal ('[] :: [Nat]) [Integer] where
fromType :: Proxy '[] -> [Integer]
fromType Proxy '[]
_ = []
instance (KnownNat n, KnownVal ns [Integer]) => KnownVal (n : ns :: [Nat]) [Integer] where
fromType :: Proxy (n : ns) -> [Integer]
fromType Proxy (n : ns)
_ = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n) Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Proxy ns -> [Integer]
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType (forall {t :: [Nat]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ns)
instance KnownVal ('[] :: [Nat]) [Int] where
fromType :: Proxy '[] -> [Int]
fromType Proxy '[]
_ = []
instance (KnownNat n, KnownVal ns [Int]) => KnownVal (n : ns :: [Nat]) [Int] where
fromType :: Proxy (n : ns) -> [Int]
fromType Proxy (n : ns)
_ = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Proxy ns -> [Int]
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType (forall {t :: [Nat]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ns)
instance KnownVal ('[] :: [Symbol]) [String] where
fromType :: Proxy '[] -> [String]
fromType Proxy '[]
_ = []
instance (KnownSymbol sym, KnownVal syms [String])
=> KnownVal (sym : syms :: [Symbol]) [String]
where
fromType :: Proxy (sym : syms) -> [String]
fromType Proxy (sym : syms)
_ = Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @sym) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Proxy syms -> [String]
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType (forall {t :: [Symbol]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @syms)
instance KnownVal ('[] :: [(Nat,Nat)]) [(Int,Int)] where
fromType :: Proxy '[] -> [(Int, Int)]
fromType Proxy '[]
_ = []
instance (KnownNat n, KnownNat m, KnownVal nms [(Int,Int)])
=> KnownVal ( '(n,m) : nms :: [(Nat,Nat)]) [(Int,Int)]
where
fromType :: Proxy ('(n, m) : nms) -> [(Int, Int)]
fromType Proxy ('(n, m) : nms)
_ =
(Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)), Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy m -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @m)))
(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: Proxy nms -> [(Int, Int)]
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType (forall {t :: [(Nat, Nat)]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @nms)
instance KnownVal ('[] :: [(Nat,Symbol)]) [(Int,String)] where
fromType :: Proxy '[] -> [(Int, String)]
fromType Proxy '[]
_ = []
instance (KnownNat n, KnownSymbol m, KnownVal nms [(Int,String)])
=> KnownVal ( '(n,m) : nms :: [(Nat,Symbol)]) [(Int,String)]
where
fromType :: Proxy ('(n, m) : nms) -> [(Int, String)]
fromType Proxy ('(n, m) : nms)
_ =
(Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
TL.natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n)), Proxy m -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @m))
(Int, String) -> [(Int, String)] -> [(Int, String)]
forall a. a -> [a] -> [a]
: Proxy nms -> [(Int, String)]
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType (forall {t :: [(Nat, Symbol)]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @nms)
instance KnownVal '[] [T.Tree Int] where fromType :: Proxy '[] -> [Tree Int]
fromType Proxy '[]
_ = []
instance (KnownVal t (T.Tree Int), KnownVal trees [T.Tree Int])
=> KnownVal (t : trees) [T.Tree Int]
where
fromType :: Proxy (t : trees) -> [Tree Int]
fromType Proxy (t : trees)
_ = forall (typeval :: a) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @t Proxy t
forall {k} (t :: k). Proxy t
Proxy Tree Int -> [Tree Int] -> [Tree Int]
forall a. a -> [a] -> [a]
: forall (typeval :: [a]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @trees Proxy trees
forall {k} (t :: k). Proxy t
Proxy
instance (KnownNat n, KnownVal trees [T.Tree Int])
=> KnownVal ('FT.Node (n :: Nat) trees) (T.Tree Int)
where
fromType :: Proxy ('Node n trees) -> Tree Int
fromType Proxy ('Node n trees)
_ = Int -> [Tree Int] -> Tree Int
forall a. a -> [Tree a] -> Tree a
T.Node (forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
forall (typeval :: Nat) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @n Proxy n
forall {k} (t :: k). Proxy t
Proxy) (forall (typeval :: [Tree Nat]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @trees Proxy trees
forall {k} (t :: k). Proxy t
Proxy)
instance KnownVal '[] [T.Tree Integer] where fromType :: Proxy '[] -> [Tree Integer]
fromType Proxy '[]
_ = []
instance (KnownVal t (T.Tree Integer), KnownVal trees [T.Tree Integer])
=> KnownVal (t : trees) [T.Tree Integer]
where
fromType :: Proxy (t : trees) -> [Tree Integer]
fromType Proxy (t : trees)
_ = forall (typeval :: a) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @t Proxy t
forall {k} (t :: k). Proxy t
Proxy Tree Integer -> [Tree Integer] -> [Tree Integer]
forall a. a -> [a] -> [a]
: forall (typeval :: [a]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @trees Proxy trees
forall {k} (t :: k). Proxy t
Proxy
instance (KnownNat n, KnownVal trees [T.Tree Integer])
=> KnownVal ('FT.Node (n :: Nat) trees) (T.Tree Integer)
where
fromType :: Proxy ('Node n trees) -> Tree Integer
fromType Proxy ('Node n trees)
_ = Integer -> [Tree Integer] -> Tree Integer
forall a. a -> [Tree a] -> Tree a
T.Node (forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
forall (typeval :: Nat) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @n Proxy n
forall {k} (t :: k). Proxy t
Proxy) (forall (typeval :: [Tree Nat]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @trees Proxy trees
forall {k} (t :: k). Proxy t
Proxy)
instance KnownVal '[] [T.Tree String] where fromType :: Proxy '[] -> [Tree String]
fromType Proxy '[]
_ = []
instance (KnownVal t (T.Tree String), KnownVal trees [T.Tree String])
=> KnownVal (t : trees) [T.Tree String]
where
fromType :: Proxy (t : trees) -> [Tree String]
fromType Proxy (t : trees)
_ = forall (typeval :: a) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @t Proxy t
forall {k} (t :: k). Proxy t
Proxy Tree String -> [Tree String] -> [Tree String]
forall a. a -> [a] -> [a]
: forall (typeval :: [a]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @trees Proxy trees
forall {k} (t :: k). Proxy t
Proxy
instance (KnownSymbol n, KnownVal trees [T.Tree String])
=> KnownVal ('FT.Node (n :: Symbol) trees) (T.Tree String)
where
fromType :: Proxy ('Node n trees) -> Tree String
fromType Proxy ('Node n trees)
_ = String -> [Tree String] -> Tree String
forall a. a -> [Tree a] -> Tree a
T.Node (forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
forall (typeval :: Symbol) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @n Proxy n
forall {k} (t :: k). Proxy t
Proxy) (forall (typeval :: [Tree Symbol]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @trees Proxy trees
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Nat,Nat)]) [(Int,Int)])
=> KnownVal ('NM.NatMap pairs) (IMS.IntMap Int)
where
fromType :: Proxy ('NatMap pairs) -> IntMap Int
fromType Proxy ('NatMap pairs)
_ = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IMS.fromList (forall (typeval :: [(Nat, Nat)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Nat,Integer)]) [(Int,Integer)])
=> KnownVal ('NM.NatMap pairs) (IMS.IntMap Integer)
where
fromType :: Proxy ('NatMap pairs) -> IntMap Integer
fromType Proxy ('NatMap pairs)
_ = [(Int, Integer)] -> IntMap Integer
forall a. [(Int, a)] -> IntMap a
IMS.fromList (forall (typeval :: [(Nat, Integer)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Nat,Symbol)]) [(Int,String)])
=> KnownVal ('NM.NatMap pairs) (IMS.IntMap String)
where
fromType :: Proxy ('NatMap pairs) -> IntMap String
fromType Proxy ('NatMap pairs)
_ = [(Int, String)] -> IntMap String
forall a. [(Int, a)] -> IntMap a
IMS.fromList (forall (typeval :: [(Nat, Symbol)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Nat,Nat)]) [(Int,Int)])
=> KnownVal ('MC.MapC pairs) (MS.Map Int Int)
where
fromType :: Proxy ('MapC pairs) -> Map Int Int
fromType Proxy ('MapC pairs)
_ = [(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList (forall (typeval :: [(Nat, Nat)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Nat,Integer)]) [(Int,Integer)])
=> KnownVal ('MC.MapC pairs) (MS.Map Int Integer)
where
fromType :: Proxy ('MapC pairs) -> Map Int Integer
fromType Proxy ('MapC pairs)
_ = [(Int, Integer)] -> Map Int Integer
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList (forall (typeval :: [(Nat, Integer)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Nat,Symbol)]) [(Int,String)])
=> KnownVal ('MC.MapC pairs) (MS.Map Int String)
where
fromType :: Proxy ('MapC pairs) -> Map Int String
fromType Proxy ('MapC pairs)
_ = [(Int, String)] -> Map Int String
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList (forall (typeval :: [(Nat, Symbol)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Symbol,Nat)]) [(String,Int)])
=> KnownVal ('MC.MapC pairs) (MS.Map String Int)
where
fromType :: Proxy ('MapC pairs) -> Map String Int
fromType Proxy ('MapC pairs)
_ = [(String, Int)] -> Map String Int
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList (forall (typeval :: [(Symbol, Nat)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Symbol,Integer)]) [(String,Integer)])
=> KnownVal ('MC.MapC pairs) (MS.Map String Integer)
where
fromType :: Proxy ('MapC pairs) -> Map String Integer
fromType Proxy ('MapC pairs)
_ = [(String, Integer)] -> Map String Integer
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList (forall (typeval :: [(Symbol, Integer)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (pairs :: [(Symbol,Symbol)]) [(String,String)])
=> KnownVal ('MC.MapC pairs) (MS.Map String String)
where
fromType :: Proxy ('MapC pairs) -> Map String String
fromType Proxy ('MapC pairs)
_ = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList (forall (typeval :: [(Symbol, Symbol)]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @pairs Proxy pairs
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (mems :: [Nat]) [Int]) => KnownVal ('FS.Set mems) (S.Set Int)
where
fromType :: Proxy ('Set mems) -> Set Int
fromType Proxy ('Set mems)
_ = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList (forall (typeval :: [Nat]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @mems Proxy mems
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (mems :: [Nat]) [Integer]) => KnownVal ('FS.Set mems) (S.Set Integer)
where
fromType :: Proxy ('Set mems) -> Set Integer
fromType Proxy ('Set mems)
_ = [Integer] -> Set Integer
forall a. Ord a => [a] -> Set a
S.fromList (forall (typeval :: [Nat]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @mems Proxy mems
forall {k} (t :: k). Proxy t
Proxy)
instance (KnownVal (mems :: [Symbol]) [String]) => KnownVal ('FS.Set mems) (S.Set String)
where
fromType :: Proxy ('Set mems) -> Set String
fromType Proxy ('Set mems)
_ = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList (forall (typeval :: [Symbol]) val.
KnownVal typeval val =>
Proxy typeval -> val
forall {k} (typeval :: k) val.
KnownVal typeval val =>
Proxy typeval -> val
fromType @mems Proxy mems
forall {k} (t :: k). Proxy t
Proxy)
#if __GLASGOW_HASKELL__ >= 902
instance KnownSymbol sym => KnownVal ('FTxt.Text sym) Txt.Text
where
fromType _ = Txt.pack $ fromType @sym Proxy
#else
#endif