air 2011.6.18 → 2011.6.19

raw patch · 9 files changed

+329/−69 lines, 9 filesdep +timedep −data-defaultdep −monoid-ownsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time

Dependencies removed: data-default, monoid-owns

API changes (from Hackage documentation)

Files

• air.cabal +5/−3
• src/Air/Control/Monad/ObjectBuilder.hs +1/−1
• src/Air/Data/Default.hs +84/−0
• src/Air/Data/Monoid.hs +153/−0
• src/Air/Env.hs +7/−4
• src/Air/Light.hs +31/−59
• src/Air/SimpleMath.hs +30/−0
• src/Air/TH/Air.hs +0/−0
• src/Air/TH/Default.hs +18/−2

@@ -1,5 +1,5 @@ Name:                 air-Version:              2011.6.18+Version:              2011.6.19 Build-type:           Simple Synopsis:             air Description:          An alternative Haskell Prelude library.@@ -24,10 +24,9 @@                 , directory                 , filepath                 , template-haskell-                , monoid-owns-                , data-default                 , dlist                 , mtl+                , time    hs-source-dirs: src/ @@ -39,7 +38,10 @@                   , Air.TH.Default                   , Air.TH.Air                   , Air.TH+                  , Air.SimpleMath                   , Air.Control.Monad.ListBuilder                   , Air.Control.Monad.ObjectBuilder                   , Air.Data.Record.SimpleLabel                   , Air.Data.Record.SimpleLabel.TH+                  , Air.Data.Default+                  , Air.Data.Monoid

@@ -3,7 +3,7 @@  import Control.Monad.State -import Data.Default+import Air.Data.Default  type ObjectBuilder a = State a () 

@@ -0,0 +1,84 @@+module Air.Data.Default where++import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as L++-- BEGIN+-- copy from data.default++import Data.Ratio+import qualified Data.Set as S+import qualified Data.Map as M++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64)+import Data.Time (Day(..), TimeOfDay, midnight, UTCTime(..), DiffTime, secondsToDiffTime)+-- | A class for types with a default value.+class Default a where+    -- | The default value for this type.+    def :: a++instance Default () where def = ()++instance Default (S.Set v) where def = S.empty+instance Default (M.Map k v) where def = M.empty++instance Default Int where def = 0+instance Default Integer where def = 0+instance Default Float where def = 0+instance Default Double where def = 0+instance (Integral a) => Default (Ratio a) where def = 0++instance Default (Maybe a) where def = Nothing+instance Default [a] where def = []++instance (Default r) => Default (e -> r) where def _ = def+instance (Default a) => Default (IO a) where def = return def++instance (Default a, Default b) => Default (a, b) where+  def = (def, def)++-- END++++instance Default B.ByteString where+  def = B.empty++instance Default L.ByteString where+  def = L.empty+++instance Default Int8 where def = 0+instance Default Int16 where def = 0+instance Default Int32 where def = 0+instance Default Int64 where def = 0+instance Default Word8 where def = 0+instance Default Word16 where def = 0+instance Default Word32 where def = 0+instance Default Word64 where def = 0++instance Default Bool where def = False+++instance (Default a, Default b, Default c) => Default (a, b, c) where+  def = (def, def, def)+++instance (Default a, Default b, Default c, Default d) => Default (a, b, c, d) where+  def = (def, def, def, def)+  +instance (Default a, Default b, Default c, Default d, Default e) => Default (a, b, c, d, e) where+  def = (def, def, def, def, def)++instance Default Day where+  def = ModifiedJulianDay def++instance Default DiffTime where+  def = secondsToDiffTime def++instance Default UTCTime where+  def = UTCTime def def++instance Default TimeOfDay where+  def = midnight

@@ -0,0 +1,153 @@+module Air.Data.Monoid where++import Prelude hiding ((+))+import qualified Prelude as Prelude+++import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString as B++import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Sequence as Sequence++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64)++class Monoid a where+        mempty  :: a+        -- ^ Identity of 'mappend'+        mappend :: a -> a -> a+        -- ^ An associative operation+        mconcat :: [a] -> a++        -- ^ Fold a list using the monoid.+        -- For most types, the default definition for 'mconcat' will be+        -- used, but the function is included in the class definition so+        -- that an optimized version can be provided for specific types.++        mconcat = foldr mappend mempty+++(+) :: (Monoid a) => a -> a -> a+(+) = mappend++infixl 6 ++++-- Monoid instances.+++instance Monoid Int where+  mempty = 0+  mappend = (Prelude.+)++instance Monoid Integer where+  mempty = 0+  mappend = (Prelude.+)++instance Monoid Double where+  mempty = 0+  mappend = (Prelude.+)++instance Monoid Float where+  mempty = 0+  mappend = (Prelude.+)+++instance Monoid Int8 where+  mempty = 0+  mappend = (Prelude.+)++instance Monoid Int16 where+  mempty = 0+  mappend = (Prelude.+)+  +instance Monoid Int32 where+  mempty = 0+  mappend = (Prelude.+)+  +instance Monoid Int64 where+  mempty = 0+  mappend = (Prelude.+)+  +  +instance Monoid Word8 where+  mempty = 0+  mappend = (Prelude.+)+  +instance Monoid Word16 where+  mempty = 0+  mappend = (Prelude.+)+  +instance Monoid Word32 where+  mempty = 0+  mappend = (Prelude.+)+  +instance Monoid Word64 where+  mempty = 0+  mappend = (Prelude.+)+++instance Monoid [a] where+        mempty  = []+        mappend = (++)++instance Monoid b => Monoid (a -> b) where+        mempty _ = mempty+        mappend f g x = f x `mappend` g x++instance Monoid () where+        -- Should it be strict?+        mempty        = ()+        _ `mappend` _ = ()+        mconcat _     = ()++instance (Monoid a, Monoid b) => Monoid (a,b) where+        mempty = (mempty, mempty)+        (a1,b1) `mappend` (a2,b2) =+                (a1 `mappend` a2, b1 `mappend` b2)++instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where+        mempty = (mempty, mempty, mempty)+        (a1,b1,c1) `mappend` (a2,b2,c2) =+                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)++instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where+        mempty = (mempty, mempty, mempty, mempty)+        (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =+                (a1 `mappend` a2, b1 `mappend` b2,+                 c1 `mappend` c2, d1 `mappend` d2)++instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>+                Monoid (a,b,c,d,e) where+        mempty = (mempty, mempty, mempty, mempty, mempty)+        (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =+                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,+                 d1 `mappend` d2, e1 `mappend` e2)++instance Monoid (Maybe a) where+  mempty = Nothing+  Nothing `mappend` m = m+  Just m `mappend` _ = Just m++instance Monoid (B.ByteString) where+  mempty = B.empty+  mappend = B.append++instance Monoid (LB.ByteString) where+  mempty = LB.empty+  mappend = LB.append++instance (Ord a) => Monoid (Map.Map a b) where+  mempty = Map.empty+  mappend = Map.union++instance (Ord a) => Monoid (Set.Set a) where+  mempty = Set.empty+  mappend = Set.union++instance Monoid (Sequence.Seq a) where+  mempty = Sequence.empty+  mappend = (Sequence.><)+

@@ -1,14 +1,17 @@-module Air.Env (+module Air.Env+(     module Air.Light   , module Prelude-  , module Data.Monoid.Owns+  , module Air.Data.Monoid   , module Air.Control.Monad.ListBuilder   , module Air.Control.Monad.ObjectBuilder+  , module Air.Data.Default    ) where  import Air.Light-import Prelude hiding ((.), (>), (<), (^), (/), (-), (+), drop, length)-import Data.Monoid.Owns ((+))+import Prelude hiding ((.), (>), (<), (^), (/), (-), (+), length, drop, take, splitAt, replicate, (!!))+import Air.Data.Monoid ((+))+import Air.Data.Default (Default, def) import Air.Control.Monad.ListBuilder import Air.Control.Monad.ObjectBuilder

@@ -7,7 +7,7 @@ import Data.Foldable (elem, foldl, foldl', toList, Foldable) import Data.Function (on) import Debug.Trace-import Prelude hiding ((.), (^), (>), (<), (/), (-), elem, foldl, foldl1, length, drop)+import Prelude hiding ((.), (^), (>), (<), (/), (-), elem, foldl, foldl1, length, drop, take, splitAt, replicate, (!!)) import qualified Prelude as P import System.FilePath ((</>)) import qualified Data.Array as A@@ -17,7 +17,7 @@ import Data.List ( genericDrop, genericLength )  import qualified Control.Monad as Monad-+import Control.Monad.Trans (liftIO, MonadIO) import Control.Concurrent import System.Exit ( exitWith, ExitCode(ExitSuccess) ) @@ -85,7 +85,7 @@ same :: (Ord a) => [a] -> Bool same = unique > length > is 1 -times :: b -> Int -> [b]+times :: (Integral i) => b -> i -> [b] times = flip replicate  upto :: (Enum a) => a -> a -> [a]@@ -94,18 +94,18 @@ downto :: (Num t, Enum t) => t -> t -> [t] downto m n = [n, n <-> 1.. m] -remove_at :: Int -> [a] -> [a]+remove_at :: (Integral i) => i -> [a] -> [a] remove_at n xs = xs.take n ++ xs.drop (n+1) -insert_at, replace_at :: Int -> a -> [a] -> [a]+insert_at, replace_at :: (Integral i) => i -> a -> [a] -> [a] insert_at n x xs  = splitted.fst ++ [x] ++ splitted.snd    where splitted  = xs.splitAt n replace_at n x xs = xs.take n ++ [x] ++ xs.drop (n+1) -slice :: Int -> Int -> [a] -> [a]+slice :: (Integral i) => i -> i -> [a] -> [a] slice l r = take r > drop l -cherry_pick :: [Int] -> [a] -> [a]+cherry_pick :: (Integral i) => [i] -> [a] -> [a] cherry_pick ids xs  = ids.map(xs !!)  reduce, reduce' :: (a -> a -> a) -> [a] -> a@@ -138,11 +138,11 @@ labeling :: (a -> c') -> [a] -> [(a, c')] labeling f = map(id &&& f) -in_group_of :: Int -> [t] -> [[t]]+in_group_of :: (Integral i) => i -> [t] -> [[t]] in_group_of _ [] = [] in_group_of n xs = h : t.in_group_of(n) where (h, t) = xs.splitAt(n) -split_to :: Int -> [a] -> [[a]]+split_to :: (Integral i) => i -> [a] -> [[a]] split_to n xs = xs.in_group_of(size) where   l = xs.length   size = if l P.< n then 1 else l `div` n@@ -151,12 +151,7 @@ apply x f = f x send_to   = apply -let_receive :: (a -> b -> c) -> b -> a -> c-let_receive f = flip f -map_send_to :: a -> [a -> b] -> [b]-map_send_to x = map (send_to(x))- belongs_to :: (Foldable t, Eq a) => t a -> a -> Bool belongs_to = flip elem @@ -166,10 +161,7 @@ indexed :: (Num t, Enum t) => [b] -> [(t, b)] indexed = zip([0..]) -map_with_index :: (Num t, Enum t) => ((t, b) -> b1) -> [b] -> [b1]-map_with_index f = indexed > map f--ljust, rjust :: Int -> a -> [a] -> [a]+ljust, rjust :: (Integral i) => i -> a -> [a] -> [a] rjust n x xs    | n P.< xs.length = xs   | otherwise     = ( n.times x ++ xs ).reverse.take n.reverse@@ -179,40 +171,12 @@   | otherwise     = ( xs ++ n.times x ).take n  -powerslice :: [a] -> [[a]]-powerslice xs = [ xs.slice j (j+i) |-  i <- l.downto 1,-  j <- [0..l <-> i]-  ]-  where l = xs.length --- only works for sorted list--- but could be infinite --- e.g. a `common` b `common` c-common :: (Ord a) => [a] -> [a] -> [a]-common _ []   = []-common [] _   = []-common a@(x:xs) b@(y:ys)-  | x .is y   = y : common xs b-  | x P.< y     = common xs b-  | otherwise = common a ys-- -- faster reverse sort rsort :: (Ord a) => [a] -> [a] rsort xs = xs.L.sortBy(\a b -> b `compare` a) -encode :: (Eq a) => [a] -> [(Int, a)]-encode xs = xs.L.group.map (length &&& head) -decode :: [(Int, a)] -> [a]-decode xs = xs.map(\(l,x) -> l.times x).join'---only_one :: [a] -> Bool-only_one [_]    = True-only_one _      = False- concat_map :: (a -> [b]) -> [a] -> [b] concat_map = concatMap @@ -235,8 +199,6 @@ to_a' :: (A.Ix i) => (i, i) -> [e] -> A.Array i e to_a' i xs = A.listArray i xs -hist :: (Num e, A.Ix i) =>  (i, i) -> [i] -> A.Array i e-hist bnds ns = A.accumArray (+) 0 bnds [(n, 1) | n <- ns, A.inRange bnds n]  -- Ord compare_by :: (Ord b) => (a -> b) -> a -> a -> Ordering@@ -283,12 +245,6 @@ map_snd :: (a -> b) -> [(c, a)] -> [(c, b)] map_snd f = map(\(a,b) -> (a, f b)) -pair :: ((a, b) -> c) -> a -> b -> c-pair f a b = f (a,b) --triple :: ((a, b, c) -> d) -> a -> b -> c -> d-triple f a b c = f (a,b,c)- splat :: (a -> b -> c) -> (a, b) -> c splat f (a,b) = f a b @@ -302,8 +258,6 @@ from_i :: (Integral a, Num b) => a -> b from_i = fromIntegral -explode :: (Show a) => a -> [Int]-explode n = n.show.map digitToInt  -- String lower, upper :: String -> String@@ -329,7 +283,7 @@   -- New from Lab-at :: (Show a) => Int -> [a] -> a+at :: (Show a, Integral i) => i -> [a] -> a at i xs = if i P.< xs.length   then xs !! i   else error - show xs ++ " at " ++ show i ++ " failed"@@ -341,11 +295,26 @@ don't = const - return ()  length :: (Num i) => [a] -> i-length = genericLength+length = L.genericLength  drop :: (Integral i) => i -> [a] -> [a]-drop = genericDrop+drop = L.genericDrop +take :: Integral i => i -> [a] -> [a]+take = L.genericTake++splitAt :: Integral i => i -> [b] -> ([b], [b])+splitAt = L.genericSplitAt++index :: Integral a => [b] -> a -> b+index = L.genericIndex++replicate :: Integral i => i -> a -> [a]+replicate = L.genericReplicate++(!!) :: Integral a => [b] -> a -> b+(!!) = index+ to_f :: (Real a, Fractional b) => a -> b to_f = realToFrac  @@ -375,3 +344,6 @@  end :: (Monad m) => m () end = return ()++io :: (MonadIO m) => IO a -> m a+io = liftIO

@@ -0,0 +1,30 @@+module Air.SimpleMath where+++import Prelude ((+))+import Air.Env hiding ((+))+import qualified Data.Array as A+import qualified Data.List as L+import Control.Arrow ((&&&))+import Data.Char (digitToInt)++powerslice :: [a] -> [[a]]+powerslice xs = [ xs.slice j (j+i) |+  i <- l.downto 1,+  j <- [0..l <-> i]+  ]+  where l = xs.length+++encode :: (Eq a) => [a] -> [(Int, a)]+encode xs = xs.L.group.map (length &&& head)++decode :: [(Int, a)] -> [a]+decode xs = xs.map(\(l,x) -> l.times x).join'++hist :: (Num e, A.Ix i) =>  (i, i) -> [i] -> A.Array i e+hist bnds ns = A.accumArray (+) 0 bnds [(n, 1) | n <- ns, A.inRange bnds n]+++explode :: (Show a) => a -> [Int]+explode n = n.show.map digitToInt

@@ -3,7 +3,7 @@ module Air.TH.Default where  import Language.Haskell.TH-import Data.Default+import Air.Data.Default   -- $(reify ''Dummy >>= show > stringE)@@ -15,7 +15,23 @@ -- runQ [d| instance Default Dummy where def = Dummy {test_field_1 = def, test_field_2 = def} |] -- [InstanceD [] (AppT (ConT Data.Default.Default) (ConT Main.Dummy)) [ValD (VarP def) (NormalB (RecConE Main.Dummy [(Main.test_field_1,VarE def),(Main.test_field_2,VarE def)])) []]] +-- Example: +-- data Dummy = Dummy+--   {+--     test_field_1 :: String+--   , test_field_2 :: Integer+--   }+--   deriving (Show)+-- +-- mkDefault ''Dummy+-- +-- gives:++-- instance Default Dummy where+--     { def = Dummy {test_field_1 = def, test_field_2 = def} }++ mkDefault :: Name -> Q [Dec] mkDefault name = do   info <- reify name@@ -24,7 +40,7 @@       case x of         (DataD _ data_name _ recs _)  -> do           case recs of-            [] -> error $ "no phontom type"+            [] -> error $ "no phantom type"             (RecC record_name fields):_ -> do               let def_name = mkName "def"               let def_fields = map (\(field_name, _, _) -> (field_name, VarE def_name)) fields