Dear All,
This has reminded me that perhaps there is an easier way.
I have a Map, whose elements are indexed by a subset of their structure.
I.e. if we have MyType = MyType I T T O E
Where I T O and E are types defined elsewhere.
The Map the indexes elements of type MyType by a pair, (T, T).
I want to be able to index by a pair, independent of order. I had thought about indexing by a pair of pairs, where the elemtns could be the same but reversed.
However, the alternative might be to index by a pair, but define that pair as a type, and alter its Eq => definition:
MyPair = (T, T)
where (t, t') == (t', t) -- I know this syntax is wrong
I could then use that as the index to the Map.
Does that approach make some sense?
Thanks,
Matt
and exporting only this function. This would make sure all your users only create a valid set of data.mkMyP (a, b) = MyP (a, b) (b, a)Initially, I was making an assumption that you won't be using a data-constructor. After thinking about it a bit, I should note that my code isn't much different from just using a "smart constructor" approach, e.g. hiding a real MyP constructor, and instead providing a function:Imants,You are right. The problem is not in IO here, it's that if you have access to data-constructor, you can do things like:
six :: TypeValInt 6
six = TypeValInt 5_______________________________________________On Tue, Jun 23, 2015 at 5:05 PM, Imants Cekusins <imantc@gmail.com> wrote:On 23 June 2015 at 14:54, Kostiantyn Rybnikov <k-bx@k-bx.com> wrote:
> Hi Matt. I don't know how bad is this, but here's what I came up with.
...
this modified for IO version accepts any input, including that which
should have caused error:
or did I do something wrong?
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
module PairsMatchedKR where
import GHC.TypeLits
data TypeValInt (n::Nat) = TypeValInt Int
deriving (Show)
one :: TypeValInt 1
one = TypeValInt 1
two :: TypeValInt 2
two = TypeValInt 2
data MyP a b = MyP (TypeValInt a, TypeValInt b) (TypeValInt b, TypeValInt a)
deriving (Show)
main :: IO ()
main = do
putStrLn "Hello!"
x1 <- getLine
x2 <- getLine
x3 <- getLine
x4 <- getLine
print (MyP (tvi x1, tvi x2) (tvi x3, tvi x4))
class TypeVal (g :: a -> *)
instance TypeVal TypeValInt
data MyPGen a b = forall g. (TypeVal g, Show (g a), Show (g b))
=> MyPGen (g a, g b) (g b, g a)
deriving instance Show (MyPGen a b)
tvi:: String -> TypeValInt (n::Nat)
tvi = TypeValInt . read
_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners