open-union (empty) → 0.1.0

raw patch · 5 files changed

+226/−0 lines, 5 filesdep +basedep +open-unionsetup-changed

Dependencies added: base, open-union

Files

• Data/OpenUnion.hs +17/−0
• Data/OpenUnion/Internal.hs +89/−0
• Setup.hs +2/−0
• example.hs +19/−0
• open-union.cabal +99/−0

@@ -0,0 +1,17 @@+-- | Flexible, type-safe open unions.+module Data.OpenUnion+    ( Union+    , (:<)+<<<<<<< Updated upstream+=======+    , liftUnion+>>>>>>> Stashed changes+    , (:\)+    , (@>)+    , liftUnion+    , reUnion+    , restrict+    , typesExhausted+    ) where++import Data.OpenUnion.Internal

@@ -0,0 +1,89 @@+-- | Exposed internals for Data.OpenUnion+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.OpenUnion.Internal+    ( Union (..)+    , (:<)+    , (:\)+    , (@>)+    , liftUnion+    , reUnion+    , restrict+    , typesExhausted+    ) where++import Data.Dynamic++-- | The @Union@ type - the phantom parameter @s@ is a list of types+-- denoting what this @Union@ might contain.+-- The value contained is one of those types.+newtype Union (s :: [*]) = Union Dynamic++-- general note: try to keep from re-constructing Unions if an existing one+-- can just be type-coerced.++<<<<<<< Updated upstream+=======+-- | Typeclass for lifting values to @Union@s.+class Typeable a => LiftToUnion (s :: [*]) a where+  liftUnion :: a -> Union s+  liftUnion = Union . toDyn+  {-# INLINE liftUnion #-}++instance Typeable a => LiftToUnion (a ': s) a+instance LiftToUnion s a => LiftToUnion (a' ': s) a++>>>>>>> Stashed changes+-- | Remove a type from anywhere in the list.+type family s :\ a where+    '[] :\ a = '[]+    (a ': s) :\ a = s :\ a+    (a' ': s) :\ a = a' ': (s :\ a)++-- | There exists a @s :< s'@ instance if every type in the list @s@+<<<<<<< Updated upstream+-- can be lifted to @s'@.+class (:<) (s :: [*]) (s' :: [*])+instance '[] :< s+instance (s :< s', Typeable a) => (a ': s) :< (a ': s')+instance (s :< s', '[a] :< s', Typeable a) => (a ': s) :< s'+=======+-- has a @`LiftToUnion` s'@ instance.+class (:<) (s :: [*]) (s' :: [*])+instance '[] :< s+instance (s :< s', LiftToUnion s' a) => (a ': s) :< s'+>>>>>>> Stashed changes++-- | `restrict` in right-fixable style.+(@>) :: Typeable a => (a -> b) -> (Union (s :\ a) -> b) -> Union s -> b+r @> l = either l r . restrict+infixr 2 @>+{-# INLINE (@>) #-}++liftUnion :: (Typeable a, '[a] :< s) => a -> Union s+liftUnion = Union . toDyn+{-# INLINE liftUnion #-}++-- | Narrow down a @Union@.+restrict :: Typeable a => Union s -> Either (Union (s :\ a)) a+restrict (Union d) = maybe (Left $ Union d) Right $ fromDynamic d+{-# INLINE restrict #-}++-- | Generalize a @Union@.+reUnion :: (s :< s') => Union s -> Union s'+reUnion (Union d) = Union d+{-# INLINE reUnion #-}++-- | Use this in places where all the @Union@ed options have been exhausted.+typesExhausted :: Union '[] -> a+typesExhausted = error "Union types exhausted - empty Union"+{-# INLINE typesExhausted #-}

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,19 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Data.OpenUnion++type MyUnion = Union '[Char, Int, [()]]++showMyUnion :: MyUnion -> String+showMyUnion+    =  (\(c :: Char) -> "char: " ++ show c)+    @> (\(i :: Int) -> "int: " ++ show i)+    @> (\(l :: [()]) -> "list length: " ++ show (length l))+    @> (\(s :: String) -> "string: " ++ s) -- MyUnion doesn't contain String. That's fine.+    @> typesExhausted++main :: IO ()+main = do+    putStrLn $ showMyUnion $ liftUnion (4 :: Int)+    putStrLn $ showMyUnion $ liftUnion 'a'+    putStrLn $ showMyUnion $ liftUnion [(), ()]

@@ -0,0 +1,99 @@+name:               open-union+version:            0.1.0+synopsis:           Extensible, type-safe unions.+category:           Data+license:            MIT+author:             Ben Foppa+homepage:           https://github.com/RobotGymnast/open-union+maintainer:         benjamin.foppa@gmail.com+build-type:         Simple+cabal-version:      >= 1.9.2+description:+    Extensible, type-safe unions. This package is very new and likely to change.+    .+    Basic usage example:+    .+    > {-# LANGUAGE TypeOperators #-}+    > {-# LANGUAGE ScopedTypeVariables #-}+    > import Data.OpenUnion+    .+    > type MyUnion = Union '[Char, Int, [()]]+    .+    > showMyUnion :: MyUnion -> String+    > showMyUnion+    >     =  (\(c :: Char) -> "char: " ++ show c)+    >     @> (\(i :: Int) -> "int: " ++ show i)+    >     @> (\(l :: [()]) -> "list length: " ++ show (length l))+    >     @> (\(s :: String) -> "string: " ++ s)+    >     @> typesExhausted+    .+    > main :: IO ()+    > main = do+    >     putStrLn $ showMyUnion $ liftUnion (4 :: Int)+    >     putStrLn $ showMyUnion $ liftUnion 'a'+    >     putStrLn $ showMyUnion $ liftUnion [(), ()]+    .+    which prints:+    .+    > int: 4+    > char: 'a'+    > list length: 2+    .+    Casting to an unrelated type does not cause errors;+    In the above example,`showMyUnion` contains a `String` case despite `MyUnion` not containing+    `String` - superfluous cases are ignored, for the time being.+    .+    `typesExhausted` is NOT a catchall. It is a null case, and using it as a catchall+    (or forgetting to provide a certain case, for instance) will result in an error like:+    .+    > example.hs:12:8:+    >     Couldn't match type ‘Int : ('[] :\ [Char])’ with ‘'[]’+    >     Expected type: Union ('[Int] :\ String) -> String+    >       Actual type: Union '[] -> String+    >     In the second argument of ‘(@>)’, namely ‘typesExhausted’+    >     In the second argument of ‘(@>)’, namely+    >       ‘(\ (s :: String) -> "string: " ++ s) @> typesExhausted’+    .+    The left-hand parts of the `':` (think type-level `(:)`) are the cases that still need to be satisfied.+    .+    Trying to lift an incorrect type to a `Union` will cause an error resembling:+    .+    > example.hs:20:30:+    >     No instance for (Data.OpenUnion.Internal.LiftToUnion '[] [Char])+    >       arising from a use of ‘liftUnion’+    >     In the second argument of ‘($)’, namely ‘liftUnion "asdf"’+    >     In the second argument of ‘($)’, namely+    >       ‘showMyUnion $ liftUnion "asdf"’+    >     In a stmt of a 'do' block:+    >       putStrLn $ showMyUnion $ liftUnion "asdf"+    .+    The original use case for this library was code like this (snipped from some record/playback logic):+    > type TrackStates = '[Stopped, Recording, Playing]+    >+    > startRecording+    >   :: Union (TrackStates :\ Recording)+    >   -> ([Note], Union '[Recording])+    .+    The `(:\)` type-level operator is for removal from a set, i.e.+    `startRecording` can be applied to a track in any state except the+    `Recording` state.++library+    hs-source-dirs:   .+    ghc-options:      -Wall+    exposed-modules:+                  Data.OpenUnion+                  Data.OpenUnion.Internal++    build-depends : base == 4.*++executable example+    hs-source-dirs:   .+    main-is: example.hs+    ghc-options: -Wall -fllvm -O2+    build-depends : base == 4.*+                  , open-union++source-repository head+  type: git+  location: https://github.com/RobotGymnast/open-union.git