packages feed

air (empty) → 2011.6.11

raw patch · 15 files changed

+656/−0 lines, 15 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, containers, data-default, directory, dlist, filepath, monoid-owns, mtl, parallel, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2011, Jinjing Wang++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 Jinjing Wang 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,3 @@+import Distribution.Simple+main = defaultMain+
+ air.cabal view
@@ -0,0 +1,43 @@+Name:                 air+Version:              2011.6.11+Build-type:           Simple+Synopsis:             air+Description:          An alternative Haskell Prelude library.+License:              BSD3+Author:               Jinjing Wang+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Development+license-file:         LICENSE+homepage:             https://github.com/nfjinjing/air+data-files:           readme.md, changelog.md, known-issues.md++library+  ghc-options: -Wall++      +  build-depends:  +                  base >= 4 && < 5+                , containers+                , array+                , parallel+                , bytestring >= 0.9+                , directory+                , filepath+                , template-haskell+                , monoid-owns+                , data-default+                , dlist+                , mtl+  hs-source-dirs: src/+  exposed-modules:  +                    Air+                  , Air.Light+                  , Air.Env+                  , Air.Here.TH+                  , Air.TH+                  , Air.Control.Monad.ListBuilder+                  , Air.Control.Monad.ObjectBuilder+                  , Air.Data.Record.SimpleLabel+                  , Air.Data.Record.SimpleLabel.TH
+ changelog.md view
+ known-issues.md view
+ readme.md view
@@ -0,0 +1,2 @@+An alternative Haskell Prelude library.+
+ src/Air.hs view
@@ -0,0 +1,7 @@+module Air (+    module Air.Env+  , module Air.TH+) where++import Air.Env hiding (mod)+import Air.TH
+ src/Air/Control/Monad/ListBuilder.hs view
@@ -0,0 +1,22 @@+module Air.Control.Monad.ListBuilder where+++import Control.Monad.Writer+import Data.DList (DList, toList, singleton, fromList)++type ListBuilder a b = Writer (DList a) b++one :: a -> ListBuilder a ()+one = tell . singleton++many :: [a] -> ListBuilder a ()+many = tell . fromList++execListBuilder :: ListBuilder a b -> [a]+execListBuilder = toList . execWriter++list :: ListBuilder a b -> [a]+list = execListBuilder++runListBuilder :: ListBuilder a b -> (b, [a])+runListBuilder x = let (b, a) = runWriter x in (b, toList a)
+ src/Air/Control/Monad/ObjectBuilder.hs view
@@ -0,0 +1,14 @@+module Air.Control.Monad.ObjectBuilder where+++import Control.Monad.State++import Data.Default++type ObjectBuilder a = State a ()++execObjectBuilder :: s -> ObjectBuilder s -> s+execObjectBuilder s m = execState m s++object :: (Default s) => ObjectBuilder s -> s+object = execObjectBuilder def
+ src/Air/Data/Record/SimpleLabel.hs view
@@ -0,0 +1,91 @@+-- a fork of Sebastiaan Visser's BSD3 fclabels+  +{-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-}++module Air.Data.Record.SimpleLabel+  (+  -- * Getter, setter and modifier types.+    Getter+  , Setter+  , Modifier++  -- * Label type.+  , Point+  , (:->) (Label)+  , label+  , get, set, mod+  , getM, setM, modM+  , (=:)++  -- * Derive labels using Template Haskell.+  , module Air.Data.Record.SimpleLabel.TH+  )+where++import Prelude hiding ((.), id, mod)+import Control.Applicative+import Control.Category+import Control.Monad.State hiding (get)+import Air.Data.Record.SimpleLabel.TH+++type Getter   s x   = s -> x+type Setter   s x   = x -> s -> s+type Modifier s x = (x -> x) -> s -> s++data Point s x = Point+  { _get :: Getter s x+  , _set :: Setter s x+  }++_mod :: Point s x -> (x -> x) -> s -> s+_mod l f a = _set l (f (_get l a)) a++newtype (s :-> x) = Label { unLabel :: Point s x }+++-- Create a label out of a getter and setter.++label :: Getter s x -> Setter s x -> s :-> x+label g s = Label (Point g s)++-- | Get the getter function from a label.++get :: (s :-> x) -> s -> x+get = _get . unLabel++-- | Get the setter function from a label.++set :: (s :-> x) -> x -> s -> s+set = _set . unLabel++-- | Get the modifier function from a label.++mod :: (s :-> x) -> (x -> x) -> s -> s+mod = _mod . unLabel++instance Category (:->) where+  id = Label (Point id const)+  (Label a) . (Label b) = Label (Point (_get a . _get b) (_mod b . _set a))++-- | Get a value out of state pointed to by the specified label.++getM :: MonadState s m => s :-> b -> m b+getM = gets . get++-- | Set a value somewhere in state pointed to by the specified label.++setM :: MonadState s m => s :-> b -> b -> m ()+setM l = modify . set l++-- | Alias for `setM' that reads like an assignment.++infixr 7 =:+(=:) :: MonadState s m => s :-> b -> b -> m ()+(=:) = setM++-- | Modify a value with a function somewhere in state pointed to by the+-- specified label.++modM :: MonadState s m => s :-> b -> (b -> b) -> m ()+modM l = modify . mod l
+ src/Air/Data/Record/SimpleLabel/TH.hs view
@@ -0,0 +1,33 @@+module Air.Data.Record.SimpleLabel.TH (mkLabels, mkLabel) where++import Control.Monad+import Data.Char+import Language.Haskell.TH.Syntax++-- | Derive labels for all the record selector in a datatype.+mkLabels :: [Name] -> Q [Dec]+mkLabels = liftM concat . mapM mkLabel++mkLabel :: Name -> Q [Dec]+mkLabel n = do+    i <- reify n+    let -- only process data and newtype declarations+        cs' = case i of+                TyConI (DataD _ _ _ cs _)   -> cs+                TyConI (NewtypeD _ _ _ c _) -> [c]+                _ -> []+        -- we're only interested in labels of record constructors+        ls' = [ l | RecC _ ls <- cs', l <- ls ]+    return (map mkLabel1 ls')++mkLabel1 :: VarStrictType -> Dec+mkLabel1 (name, _, _) =+    -- Generate a name for the label:+    -- in this fork: label names are "__" + accesser name, e.g. if data Square = Square {length :: Double}, then label is __length+    let n = mkName $ "__" ++ nameBase name+    in FunD n [Clause [] (NormalB (+           AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter+                (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter+                      (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))]))+                                   )) []]+
+ src/Air/Env.hs view
@@ -0,0 +1,14 @@+module Air.Env (+    module Air.Light+  , module Prelude+  , module Data.Monoid.Owns+  , module Air.Control.Monad.ListBuilder+  , module Air.Control.Monad.ObjectBuilder+  +) where++import Air.Light+import Prelude hiding ((.), (>), (<), (^), (/), (-), (+), drop, length)+import Data.Monoid.Owns ((+))+import Air.Control.Monad.ListBuilder+import Air.Control.Monad.ObjectBuilder
+ src/Air/Here/TH.hs view
@@ -0,0 +1,11 @@+-- {-# LANGUAGE CPP #-}++module Air.Here.TH where++import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax +import Language.Haskell.TH.Lib +++here :: QuasiQuoter +here = QuasiQuoter (litE . stringL) (litP . stringL) 
+ src/Air/Light.hs view
@@ -0,0 +1,377 @@+module Air.Light where+++import Control.Arrow ((&&&), (>>>), (<<<))+import Control.Category (Category)+import Data.Char+import Data.Foldable (elem, foldl, foldl', toList, Foldable)+import Data.Function (on)+import Debug.Trace+import Prelude hiding ((.), (^), (>), (<), (/), (-), elem, foldl, foldl1, length, drop)+import qualified Prelude as P+import System.FilePath ((</>))+import qualified Data.Array as A+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+import Data.List ( genericDrop, genericLength )++import qualified Control.Monad as Monad++import Control.Concurrent+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+++-- base DSL+{-# INLINE (.) #-}+(.) :: a -> (a -> b) -> b+a . f = f a+infixl 9 .++(>) :: (Category cat) => cat a b -> cat b c -> cat a c+(>) = (>>>)+infixl 8 >++(<) :: (Category cat) => cat b c -> cat a b -> cat a c+(<) = (<<<)+infixr 8 <++(^) :: (Functor f) => f a -> (a -> b) -> f b+(^) = flip fmap+infixl 8 ^++(/) :: FilePath -> FilePath -> FilePath+(/) = (</>)+infixl 5 /++{-# INLINE (-) #-}+(-) :: (a -> b) -> a -> b+f - x =  f x+infixr 0 -++(<->) :: (Num a) => a -> a -> a+(<->) = (P.-)+infix 6 <->+++-- List+join :: [a] -> [[a]] -> [a]+join = L.intercalate++join' :: [[a]] -> [a]+join' = concat++first, second, third, forth, fifth :: (Show a) => [a] -> a+sixth, seventh, eighth, ninth, tenth :: (Show a) => [a] -> a+first   = head+second  = at 1+third   = at 2+forth   = at 3+fifth   = at 4+sixth   = at 5+seventh = at 6+eighth  = at 7+ninth   = at 8+tenth   = at 10++-- Set requires Ord instance, so use nub when+-- xs is not comparable+unique :: (Ord a) => [a] -> [a]+unique = to_set > to_list++is_unique :: (Ord a) => [a] -> Bool+is_unique xs = xs.unique.length == xs.length++same :: (Ord a) => [a] -> Bool+same = unique > length > is 1++times :: b -> Int -> [b]+times = flip replicate++upto :: (Enum a) => a -> a -> [a]+upto = flip enumFromTo++downto :: (Num t, Enum t) => t -> t -> [t]+downto m n = [n, n <-> 1.. m]++remove_at :: Int -> [a] -> [a]+remove_at n xs = xs.take n ++ xs.drop (n+1)++insert_at, replace_at :: Int -> 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 l r = take r > drop l++cherry_pick :: [Int] -> [a] -> [a]+cherry_pick ids xs  = ids.map(xs !!)++reduce, reduce' :: (a -> a -> a) -> [a] -> a+reduce = L.foldl1+reduce' = L.foldl1'++inject, inject' :: (Foldable t) => a -> (a -> b -> a) -> t b -> a+inject  = flip foldl+inject' = flip foldl'++none_of :: (a -> Bool) -> [a] -> Bool+none_of f = any f > not++select, reject :: (a -> Bool) -> [a] -> [a]+select   = filter+reject f = filter (f > not)++inner_map :: (a -> b) -> [[a]] -> [[b]]+inner_map f = map (map f)++inner_reduce :: (a -> a -> a) -> [[a]] -> [a]+inner_reduce f = map (reduce f)++inner_inject :: (Foldable t) => a -> (a -> b -> a) -> [t b] -> [a]+inner_inject x f = map (inject x f)++label_by :: (a -> c) -> [a] -> [(c, a)]+label_by f = map (f &&& id)++labeling :: (a -> c') -> [a] -> [(a, c')]+labeling f = map(id &&& f)++in_group_of :: Int -> [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 n xs = xs.in_group_of(size) where+  l = xs.length+  size = if l P.< n then 1 else l `div` n++apply, send_to :: a -> (a -> b) -> b+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++has :: (Foldable t, Eq b) => b -> t b -> Bool+has = flip belongs_to++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]+rjust n x xs +  | n P.< xs.length = xs+  | otherwise     = ( n.times x ++ xs ).reverse.take n.reverse++ljust n x xs+  | n P.< xs.length = xs+  | 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++-- Fold+to_list :: (Foldable t) => t a -> [a]+to_list = toList++-- Set+to_set :: (Ord a) => [a] -> S.Set a+to_set = S.fromList++-- Map+to_h :: (Ord k) => [(k, a)] -> M.Map k a+to_h xs = xs.M.fromList++-- Array+to_a :: [a] -> A.Array Int a+to_a xs      = A.listArray (0, xs.length <-> 1) xs++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+compare_by = on compare++eq, is, is_not, isn't, aren't :: (Eq a) => a -> a -> Bool+eq         = flip (==)+is         = eq+is_not a b = not (is a b)+isn't      = is_not+aren't     = is_not++-- Tuple+swap :: (a, b) -> (b, a)+swap (x,y) = (y,x)++tuple2 :: (Show a) => [a] -> (a, a)+tuple2 = first &&& last++tuple3 :: (Show a) => [a] -> (a, a, a)+tuple3 xs = (xs.first, xs.second, xs.third)++list2 :: (a, a) -> [a]+list2 (x,y) = [x,y]++list3 :: (a, a, a) -> [a]+list3 (x,y,z) = [x,y,z]++filter_fst :: (a -> Bool) -> [(a, b)] -> [(a, b)]+filter_fst f = filter(fst > f)++filter_snd :: (b -> Bool) -> [(a, b)] -> [(a, b)]+filter_snd f = filter(snd > f)++only_fst :: [(a, b)] -> [a]+only_fst = map fst++only_snd :: [(a, b)] -> [b]+only_snd = map snd++map_fst :: (a -> b) -> [(a, c)] -> [(b, c)]+map_fst f = map(\(a,b) -> (f a, b))++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++splat3 :: (a -> b -> c -> d) -> (a, b, c) -> d+splat3 f (a,b,c) = f a b c++twin :: a -> (a, a)+twin x = (x,x)++-- Integer+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+lower = map toLower+upper = map toUpper++starts_with, ends_with :: String -> String -> Bool+starts_with = L.isPrefixOf+ends_with   = L.isSuffixOf++capitalize :: String -> String+capitalize [] = []+capitalize (x:xs) = [x].upper ++ xs.lower++to_s :: (Show a) => a -> String+to_s = show+++-- Debug+trace' :: (Show a) => a -> a+trace' x = trace (x.show) x++++-- New from Lab+at :: (Show a) => Int -> [a] -> a+at i xs = if i P.< xs.length+  then xs !! i+  else error - show xs ++ " at " ++ show i ++ " failed"++void :: (Monad m) => m a -> m ()+void x = x >>= const () > return++don't :: (Monad m) => m a -> m ()+don't = const - return ()++length :: (Num i) => [a] -> i+length = genericLength++drop :: (Integral i) => i -> [a] -> [a]+drop = genericDrop++to_f :: (Real a, Fractional b) => a -> b+to_f = realToFrac ++sleep :: (RealFrac a) => a -> IO ()+sleep x = threadDelay - round - (x * 1000000)++first_or :: a -> [a] -> a+first_or x xs = case xs of+  [] -> x+  (y:_) -> y++puts :: String -> IO ()+puts = putStrLn+++exit_success :: IO ()+exit_success = exitWith ExitSuccess++fork :: IO a -> IO ()+fork io = void - forkIO - void io++insert_unique :: (Eq a) => a -> [a] -> [a]+insert_unique x xs = x : xs.reject (is x)++squeeze :: (Monad m) => m (m a) -> m a+squeeze = Monad.join++end :: (Monad m) => m ()+end = return ()
+ src/Air/TH.hs view
@@ -0,0 +1,8 @@+module Air.TH (+    module Air.Data.Record.SimpleLabel+  , module Air.Here.TH+) where++import Air.Data.Record.SimpleLabel+import Air.Here.TH+