packages feed

data-variant (empty) → 0.25.2.0

raw patch · 5 files changed

+370/−0 lines, 5 filesdep +basedep +safesetup-changed

Dependencies added: base, safe

Files

+ Data/Variant.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE FlexibleInstances #-}+module Data.Variant+        ( Variant (..)+        , flatten+        , toInteger+        , toDouble+        , toBool+        , toAList+        , (~==)+        , (~/=)+        , lookup+        , elem+        , keyExists+        , merge+        , scopeMerge+        , keys+        , values+        , vmap, vamap+        , wrapf, wrapfs+        , wrapf1, wrapfs1+        , call, callMaybe, callDef+        )+where++import Prelude hiding (toInteger, lookup, elem)+import Data.List hiding (lookup, elem)+import qualified Data.List as List+import Data.Maybe+import Safe+import Text.Printf+import Data.Monoid++data Variant = Null+             | Integer Integer+             | Double Double+             | String String+             | Bool Bool+             | List [Variant]+             | AList [(Variant, Variant)]+             | Function ([Variant] -> Variant)+             deriving (Show, Eq)++instance Show ([Variant] -> Variant)+    where show _ = "<<function>>"++instance Eq ([Variant] -> Variant)+    where (==) a b = False++instance Ord Variant+    where+        compare (String a) b = compare a $ flatten b+        compare a (String b) = compare (flatten a) b+        compare (Double a) b = compare a $ toDouble b+        compare a (Double b) = compare (toDouble a) b+        compare (Integer a) b = compare a $ toInteger b+        compare a (Integer b) = compare (toInteger a) b+        compare (Bool a) b = compare a $ toBool b+        compare a (Bool b) = compare (toBool a) b+        compare Null Null = EQ+        compare Null _ = LT+        compare _ Null = GT+        compare _ _ = EQ++instance Monoid Variant+    where+        mempty = Null+        mappend Null a = a+        mappend a Null = a+        mappend (List xs) (List ys) = List (xs ++ ys)+        mappend (AList xs) (AList ys) = AList (xs ++ ys)+        mappend (List xs) (AList ys) = List (xs ++ map snd ys)+        mappend (AList xs) (List ys) = List (map snd xs ++ ys)+        mappend a b = String (flatten a ++ flatten b)++flatten :: Variant -> String+flatten (String s) = s+flatten (Integer i) = show i+flatten (Double d) = cullFracPart . printf "%f" $ d+flatten (Bool True) = "1"+flatten (Bool False) = ""+flatten Null = ""+flatten (List xs) = concat . intersperse " " . map flatten $ xs+flatten (AList xs) = flatten . List . map snd $ xs+flatten (Function _) = "<<function>>"++cullFracPart :: String -> String+cullFracPart str = reverse $ dropWhile (`List.elem` ['0', '.']) $ reverse str++toMaybeInteger :: Variant -> Maybe Integer+toMaybeInteger (String s) = maybeRead s+toMaybeInteger (Integer i) = Just i+toMaybeInteger (Double d) = Just $ round d+toMaybeInteger (Bool True) = Just 1+toMaybeInteger (Bool False) = Just 0+toMaybeInteger _ = Nothing++toInteger :: Variant -> Integer+toInteger = fromMaybe 0 . toMaybeInteger++toMaybeDouble :: Variant -> Maybe Double+toMaybeDouble (String s) = maybeRead s+toMaybeDouble (Integer i) = Just $ fromIntegral i+toMaybeDouble (Double d) = Just d+toMaybeDouble (Bool True) = Just 1+toMaybeDouble (Bool False) = Just 0+toMaybeDouble _ = Nothing++toDouble :: Variant -> Double+toDouble = fromMaybe 0 . toMaybeDouble++toBool :: Variant -> Bool+toBool (Bool b) = b+toBool (Double d) = d /= 0+toBool a = toInteger a /= 0++toAList :: Variant -> [(Variant, Variant)]+toAList (AList xs) = xs+toAList (List xs) = zip (map Integer [0..]) xs+toAList _ = []++instance Num Variant where+    (+) = varAdd+    (-) = varSub+    (*) = varMul+    abs = varAbs+    signum = varSignum+    fromInteger = Integer++varAdd :: Variant -> Variant -> Variant+varAdd (Double a) b = Double $ a + toDouble b+varAdd a (Double b) = Double $ toDouble a + b+varAdd a b = Integer $ toInteger a + toInteger b++varSub :: Variant -> Variant -> Variant+varSub (Double a) b = Double $ a - toDouble b+varSub a (Double b) = Double $ toDouble a - b+varSub a b = Integer $ toInteger a - toInteger b++varMul :: Variant -> Variant -> Variant+varMul (Double a) b = Double $ a * toDouble b+varMul a (Double b) = Double $ toDouble a * b+varMul a b = Integer $ toInteger a * toInteger b++varAbs :: Variant -> Variant+varAbs (Integer i) = Integer (-i)+varAbs (Double i) = Double (-i)+varAbs b = b++varSignum :: Variant -> Variant+varSignum (Integer i) = Integer $ signum i+varSignum (Double i) = Double $ signum i+varSignum a = Integer 1++maybeRead :: Read a => String -> Maybe a+maybeRead s =+    let xs = reads s+    in if null xs then Nothing else (Just . fst . head) xs++(~==) :: Variant -> Variant -> Bool+(~==) a b = flatten a == flatten b++(~/=) a b = flatten a /= flatten b++lookup :: Variant -> Variant -> Variant+lookup key (List xs) =+    let index = fromIntegral . toInteger $ key+    in atDef Null xs index+lookup key (AList xs) =+    let mayVal = List.lookup key xs+    in fromMaybe Null mayVal+lookup _ _ = Null++keyExists :: Variant -> Variant -> Bool+keyExists key (List xs) =+    let index = fromIntegral . toInteger $ key+    in (index < length xs) && (index >= 0)+keyExists key (AList xs) =+    key `List.elem` map fst xs+keyExists _ _ = False++elem :: Variant -> Variant -> Variant+elem key (List xs) = Bool $ List.elem key xs+elem key (AList xs) = Bool $ List.elem key $ map snd xs+elem _ _ = Bool False++merge :: Variant -> Variant -> Variant+merge a b =+    let al = toAList a+        bl = toAList b+    in AList (al ++ bl)++-- Scope merge: First operand has precedence over second; if first argument is+-- scalar, then it becomes the new scope, otherwise both scopes are merged, the+-- first one taking precedence.+scopeMerge :: Variant -> Variant -> Variant+scopeMerge a@(AList xs) b = merge a b+scopeMerge a@(List xs) b = merge a b+scopeMerge Null b = b+scopeMerge a b = a++keys :: Variant -> [Variant]+keys v = map fst $ toAList v++values :: Variant -> [Variant]+values v = map snd $ toAList v++vmap :: (Variant -> a) -> Variant -> [a]+vmap f v = map f $ values v++vamap :: ((Variant, Variant) -> a) -> Variant -> [a]+vamap f v = map f $ toAList v++wrapfs :: (Variant -> [Variant] -> Variant) -> Variant -> Variant+wrapfs f s = Function $ f s++wrapf :: ([Variant] -> Variant) -> Variant+wrapf = Function++wrapfs1 :: (Variant -> Variant -> Variant) -> Variant -> Variant+wrapfs1 f s = wrapf (\(a:_) -> f s a)++wrapf1 :: (Variant -> Variant) -> Variant+wrapf1 f = wrapf (\(a:_) -> f a)++callMaybe :: Variant -> [Variant] -> Maybe Variant+callMaybe (Function f) args = Just $ f args+callMaybe _ _ = Nothing++callDef :: Variant -> [Variant] -> Variant -> Variant+callDef f args def = fromMaybe def $ callMaybe f args++call :: Variant -> [Variant] -> Variant+call f args = callDef f args Null
+ Data/Variant/ToFrom.hs view
@@ -0,0 +1,78 @@+{-#LANGUAGE FlexibleInstances, UndecidableInstances, IncoherentInstances #-}+module Data.Variant.ToFrom where++import Data.Variant+import Prelude hiding (toInteger)++class ToVariant a where+    toVariant :: a -> Variant++class FromVariant a where+    fromVariant :: Variant -> a++-- Variant itself implements to/from variant+instance ToVariant Variant where+    toVariant = id+instance FromVariant Variant where+    fromVariant = id++-- Various scalar instances++instance ToVariant String where+    toVariant = String+instance FromVariant String where+    fromVariant = flatten++instance ToVariant Bool where+    toVariant = Bool+instance FromVariant Bool where+    fromVariant = toBool++instance ToVariant Double where+    toVariant = Double+instance FromVariant Double where+    fromVariant = toDouble++instance ToVariant Integer where+    toVariant = Integer+instance FromVariant Integer where+    fromVariant = toInteger++instance ToVariant Int where+    toVariant = Integer . fromIntegral+instance FromVariant Int where+    fromVariant = fromIntegral . toInteger++-- Maybes of to/from variant types implement to/from variant+instance ToVariant a => ToVariant (Maybe a) where+    toVariant Nothing = Null+    toVariant (Just a) = toVariant a++instance FromVariant a => FromVariant (Maybe a) where+    fromVariant Null = Nothing+    fromVariant a = Just (fromVariant a)++-- Lists of variants+instance (ToVariant a, ToVariant b) => ToVariant [(a,b)] where+    toVariant xs =+        let (keys, values) = unzip xs+            vkeys = map toVariant keys+            vvalues = map toVariant values+        in AList $ zip vkeys vvalues++instance (FromVariant a, FromVariant b) => FromVariant [(a,b)] where+    fromVariant = map (\(k,v) -> (fromVariant k, fromVariant v)) . toAList++instance ToVariant a => ToVariant [a] where+    toVariant xs = List (map toVariant xs)++instance FromVariant a => FromVariant [a] where+    fromVariant = map fromVariant . values++-- Functions, up to 3 arguments+instance (FromVariant a, ToVariant b) => ToVariant (a -> b) where+    toVariant f = Function (\(x:_) -> toVariant (f $ fromVariant x))+instance (FromVariant a, FromVariant b, ToVariant c) => ToVariant (a -> b -> c) where+    toVariant f = Function (\(x:y:_) -> toVariant (f (fromVariant x) (fromVariant y)))+instance (FromVariant a, FromVariant b, FromVariant c, ToVariant d) => ToVariant (a -> b -> c -> d) where+    toVariant f = Function (\(x:y:z:_) -> toVariant (f (fromVariant x) (fromVariant y) (fromVariant z)))
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Tobias Dammers++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tobias Dammers nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data-variant.cabal view
@@ -0,0 +1,27 @@+name:                data-variant+version:             0.25.2.0+synopsis:            A variant data type, useful for modeling dynamically-typed programming languages+description:         Implements a 'variant' data type that can hold the+                     usual suspects: scalars (integers, floats, strings),+                     lists, association lists, booleans, null, and first-class+                     functions.+homepage:            https://bitbucket.org/tdammers/data-variant+license:             BSD3+license-file:        LICENSE+author:              Tobias Dammers+maintainer:          tdammers@gmail.com+-- copyright:           +category:            Data+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Data.Variant+                 ,     Data.Variant.ToFrom+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.5 && <4.6+               ,       safe >= 0.3.0 && < 1.0+  -- hs-source-dirs:      +  default-language:    Haskell2010