packages feed

bit-array (empty) → 0.1.0

raw patch · 7 files changed

+481/−0 lines, 7 filesdep +basedep +directorydep +doctestbuild-type:Customsetup-changed

Dependencies added: base, directory, doctest, filepath, loch-th, numeric-qq, placeholders

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2014, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,50 @@+import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "import Prelude"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+
+ bit-array.cabal view
@@ -0,0 +1,80 @@+name:+  bit-array+version:+  0.1.0+synopsis:+  A bit array (aka bitset, bitmap, bit vector) API for numeric types+description:+  The library extends the numeric types with an array-like interface +  over individual set bits.+  It also provides an API for conversion to and +  from the binary notation.+category:+  Data Structures, Bit Vectors, Pretty Printer+homepage:+  https://github.com/nikita-volkov/bit-array +bug-reports:+  https://github.com/nikita-volkov/bit-array/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2014, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Custom+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/bit-array.git+++library+  hs-source-dirs:+    library+  other-modules:+    BitArray.Prelude+    BitArray.Parser+  exposed-modules:+    BitArray+  build-depends:+    -- debugging:+    loch-th == 0.2.*,+    placeholders == 0.1.*,+    -- general:+    numeric-qq >= 0.1.2 && < 0.2,+    base >= 4.5 && < 4.8+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+++test-suite doctests+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    executables+  main-is:+    Doctests.hs+  ghc-options:+    -threaded+  build-depends:+    doctest == 0.9.*,+    directory == 1.2.*,+    filepath == 1.3.*,+    base >= 4.5 && < 5+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators+  default-language:+    Haskell2010+
+ executables/Doctests.hs view
@@ -0,0 +1,69 @@+-- The code is mostly ripped from+-- https://github.com/ekmett/lens/blob/d1d97469f0e93c1d3535308954a060e8a04e37aa/tests/doctests.hsc+import Prelude+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest+import Build_doctests (deps)++main :: IO ()+main = do+  sources <- getSources+  doctest $ dfltParams ++ map ("-package="++) deps ++ sources+  where+    dfltParams = +      [+        "-isrc",+        "-idist/build/autogen",+        "-optP-include",+        "-optPdist/build/autogen/cabal_macros.h",+        "-XArrows",+        "-XBangPatterns",+        "-XConstraintKinds",+        "-XDataKinds",+        "-XDefaultSignatures",+        "-XDeriveDataTypeable",+        "-XDeriveFunctor",+        "-XDeriveGeneric",+        "-XEmptyDataDecls",+        "-XFlexibleContexts",+        "-XFlexibleInstances",+        "-XFunctionalDependencies",+        "-XGADTs",+        "-XGeneralizedNewtypeDeriving",+        "-XImpredicativeTypes",+        "-XLambdaCase",+        "-XLiberalTypeSynonyms",+        "-XMultiParamTypeClasses",+        "-XMultiWayIf",+        "-XNoImplicitPrelude",+        "-XNoMonomorphismRestriction",+        "-XOverloadedStrings",+        "-XPatternGuards",+        "-XParallelListComp",+        "-XQuasiQuotes",+        "-XRankNTypes",+        "-XRecordWildCards",+        "-XScopedTypeVariables",+        "-XStandaloneDeriving",+        "-XTemplateHaskell",+        "-XTupleSections",+        "-XTypeFamilies",+        "-XTypeOperators",+        "-hide-all-packages"+      ]++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "library"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ library/BitArray.hs view
@@ -0,0 +1,167 @@+module BitArray where++import BitArray.Prelude hiding (map, toList, traverse_, foldr)+import qualified BitArray.Parser as Parser+import qualified Text.ParserCombinators.ReadP as ReadP+import qualified Data.Foldable as Foldable+import qualified NumericQQ+++-- |+-- A @newtype@ wrapper which provides an array-like interface to a type, +-- which has instances of 'Bits' and 'Num'.+-- +-- You can construct bit arrays by wrapping numeric values:+-- +-- >>> BitArray (7 :: Int8)+-- [qq|00000111|]+-- +-- or directly from numeric literals:+-- +-- >>> 7 :: BitArray Int8+-- [qq|00000111|]+-- +-- or using a binary notation quasi-quoter, +-- assuming you have the @QuasiQuotes@ pragma turned on:+-- +-- >>> [qq|0111|] :: BitArray Int8+-- [qq|00000111|]+-- +-- @BitArray@ derives the 'Bits' instance from the base type,+-- so it supports all the standard bitwise operations as well.+-- +-- Note that this library does not support the 'Integer' type,+-- since 'Integer' has no implementation of the 'bitSize' function,+-- which this library heavily relies on.+-- You will get a runtime exception if you use it with 'Integer'.+newtype BitArray a = BitArray a+  deriving (Bounded, Enum, Eq, Integral, Data, Num, Ord, Real, Ix, Generic, +            Typeable, Bits)++-- | +-- Produces a literal of zeros and ones.+-- +-- >>> show (BitArray (5 :: Int8))+-- "[qq|00000101|]"+instance (Bits a) => Show (BitArray a) where+  show = wrap . toString+    where+      wrap = ("[qq|" ++) . (++ "|]")++-- | +-- Parses a literal of zeros and ones.+-- +-- >>> read "[qq|1110|]" :: BitArray Int8+-- [qq|00001110|]+-- +-- >>> unwrap (read "[qq|1110|]") :: Int+-- 14+instance (Bits a, Num a) => Read (BitArray a) where+  readsPrec = const $ ReadP.readP_to_S $ parser+    where+      parser = +        BitArray <$> ReadP.string "[qq|" *> Parser.bits <* ReadP.string "|]"++instance (Bits a, Num a) => IsString (BitArray a) where+  fromString = +    fromMaybe (error "Unparsable bit array string") . parseString++-- * Constructors and converters+-------------------------++-- |+-- A binary number quasi-quoter. +-- Produces a numeric literal at compile time.+-- Can be used to construct both bit arrays and integral numbers.+-- +-- >>> [qq|011|] :: Int+-- 3+-- +-- >>> [qq|011|] :: BitArray Int8+-- [qq|00000011|]+qq = NumericQQ.bin++-- | Unwrap the underlying value of a bit array.+unwrap :: BitArray a -> a+unwrap (BitArray a) = a++-- ** Strings+-------------------------++-- |+-- Convert into a binary notation string.+-- +-- >>> toString (BitArray (5 :: Int8))+-- "00000101"+toString :: (Bits a) => BitArray a -> String+toString = fmap (\case True -> '1'; False -> '0') . reverse . toBoolList++-- |+-- Parse a binary notation string.+-- +-- >>> parseString "123" :: Maybe (BitArray Int8)+-- Nothing+-- +-- >>> parseString "101" :: Maybe (BitArray Int8)+-- Just [qq|00000101|]+parseString :: (Bits a, Num a) => String -> Maybe (BitArray a)+parseString = fmap fst . listToMaybe . ReadP.readP_to_S Parser.bits++-- ** Lists+-------------------------++-- | +-- Convert into a list of set bits.+-- +-- The list is ordered from least significant to most significant bit.+{-# INLINABLE toList #-}+toList :: (Bits a, Num a) => BitArray a -> [a]+toList (BitArray w) = +  processIndexes [0 .. (pred . bitSize) w]+  where+    processIndexes = filter (\w' -> w .&. w' /= 0) . fmap bit++-- | Construct from a list of set bits.+{-# INLINABLE fromList #-}+fromList :: (Bits a, Num a) => [a] -> BitArray a+fromList = BitArray . inline Foldable.foldr (.|.) 0++-- | +-- Convert into a list of boolean values,+-- which represent the \"set\" flags of each bit.+-- +-- The list is ordered from least significant to most significant bit.+{-# INLINABLE toBoolList #-}+toBoolList :: (Bits a) => BitArray a -> [Bool]+toBoolList (BitArray w) = testBit w <$> [0 .. (pred . bitSize) w]++-- | +-- Construct from a list of boolean flags for the "set" status of each bit.+-- +-- The list must be ordered from least significant to most significant bit.+{-# INLINABLE fromBoolList #-}+fromBoolList :: (Bits a, Num a) => [Bool] -> BitArray a+fromBoolList = inline fromList . fmap (bit . fst) . filter snd . zip [0..]++-- * Utils+-------------------------++-- | Map over the set bits.+{-# INLINABLE map #-}+map :: (Bits a, Num a, Bits b, Num b) => (a -> b) -> BitArray a -> BitArray b+map f = inline fromList . fmap f . inline toList++-- | Perform a right-associative fold over the set bits.+{-# INLINABLE foldr #-}+foldr :: (Bits a, Num a) => (a -> b -> b) -> b -> BitArray a -> b+foldr step init = inline Foldable.foldr step init . inline toList++-- | Traverse thru set bits.+{-# INLINABLE mapM_ #-}+mapM_ :: (Bits a, Num a, Monad m) => (a -> m b) -> BitArray a -> m ()+mapM_ f = inline Foldable.mapM_ f . inline toList++-- | Traverse thru set bits.+{-# INLINABLE traverse_ #-}+traverse_ :: (Bits a, Num a, Applicative f) => (a -> f b) -> BitArray a -> f ()+traverse_ f = inline Foldable.traverse_ f . inline toList
+ library/BitArray/Parser.hs view
@@ -0,0 +1,23 @@+module BitArray.Parser where++import BitArray.Prelude+import Text.ParserCombinators.ReadP+import Data.Char+++digits :: ReadP [Char]+digits = munch isDigit++bitIndexes :: ReadP [Int]+bitIndexes = do+  digitsChars <- digits+  sequence $ do+    (index, char) <- zip [0..] (reverse digitsChars)+    case char of+      '0' -> empty+      '1' -> return (return index)+      _   -> return empty++bits :: (Bits a, Num a) => ReadP a+bits = foldr (.|.) 0 . map bit <$> bitIndexes+
+ library/BitArray/Prelude.hs view
@@ -0,0 +1,70 @@+module BitArray.Prelude+( +  module Exports,+  bug,+  bottom,+  bool,+)+where++-- base+-------------------------+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (left, right)+import Control.Category as Exports+import Data.Monoid as Exports+import Data.Foldable as Exports+import Data.Traversable as Exports hiding (for)+import Data.Maybe as Exports+import Data.Either as Exports+import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Tuple as Exports+import Data.Function as Exports hiding ((.), id)+import Data.Ord as Exports (Down(..))+import Data.String as Exports+import Data.Int as Exports+import Data.Word as Exports+import Data.Ratio as Exports+import Data.Bits as Exports+import Data.Fixed as Exports+import Data.Ix as Exports+import Data.Data as Exports+import Data.Bool as Exports hiding (bool)+import Text.Read as Exports (readMaybe, readEither, Read(..))+import Control.Exception as Exports hiding (tryJust, try, assert)+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import System.Exit as Exports+import System.IO.Unsafe as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import Unsafe.Coerce as Exports+import GHC.Conc as Exports+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import GHC.Exts as Exports (lazy, inline)+import Data.IORef as Exports+import Data.STRef as Exports+import Control.Monad.ST as Exports+import Debug.Trace as Exports hiding (traceM)++-- placeholders+-------------------------+import Development.Placeholders as Exports++-- custom+-------------------------+import qualified Debug.Trace.LocationTH++bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]+  where+    msg = "A \"bit-array\" package bug: " :: String++bottom = [e| $bug "Bottom evaluated" |]++bool :: a -> a -> Bool -> a+bool f _ False = f+bool _ t True  = t