Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated about an hour ago

total matches: more than 1000

aeson-1.4.6.0
13 matches
tests/PropUtils.hs
    result :: Result (I.JSONPath, String)
    result = parse (const parser) ()

    jsonPath = map (I.Key . T.pack) path

-- | Perform a structural comparison of the results of two encoding
-- methods. Compares decoded values to account for HashMap-driven
-- variation in JSON object key ordering.
sameAs :: (a -> Value) -> (a -> Encoding) -> a -> Property

            
tests/SerializationFormatSpec.hs
tests :: [TestTree]
tests =
  [
    testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples
  , testGroup "From JSON representation" $ fmap assertJsonExample jsonDecodingExamples
  , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples

  ]

jsonExamples :: [Example]
jsonExamples =

            
tests/SerializationFormatSpec.hs
        (M.fromList [("ab",1),("cd",3)] :: M.Map String Int)
  , ndExample "Map [I Char] Int"
        [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]
        (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)

  , example "nan :: Double" "null"  (Approx $ 0/0 :: Approx Double)

  , example "Ordering LT" "\"LT\"" LT
  , example "Ordering EQ" "\"EQ\"" EQ

            
tests/Types.hs
zeroDay = fromGregorian 0 0 0

instance Arbitrary BCEDay where
    arbitrary = fmap (BCEDay . ModifiedJulianDay . (+ toModifiedJulianDay zeroDay)) arbitrary

instance ToJSON BCEDay where
    toJSON (BCEDay d)     = toJSON d
    toEncoding (BCEDay d) = toEncoding d


            
tests/Types.hs
    toEncoding (BCEDay d) = toEncoding d

instance FromJSON BCEDay where
    parseJSON = fmap BCEDay . parseJSON

-- | Scale the size of Arbitrary with ''
newtype LogScaled a = LogScaled { getLogScaled :: a }
  deriving (Eq, Ord, Show)


            
tests/Types.hs

instance Arbitrary a => Arbitrary (LogScaled a) where
    arbitrary = LogScaled <$> scale (\x -> intLog2 $ x + 1) arbitrary
    shrink = fmap LogScaled . shrink . getLogScaled

instance ToJSON a => ToJSON (LogScaled a) where
    toJSON (LogScaled d)     = toJSON d
    toEncoding (LogScaled d) = toEncoding d


            
tests/Types.hs
    toEncoding (LogScaled d) = toEncoding d

instance FromJSON a => FromJSON (LogScaled a) where
    parseJSON = fmap LogScaled . parseJSON

instance (ToJSONKey a) => ToJSONKey (LogScaled a) where
    toJSONKey = contramapToJSONKeyFunction getLogScaled toJSONKey
    toJSONKeyList = contramapToJSONKeyFunction (fmap getLogScaled) toJSONKeyList

instance (FromJSONKey a) => FromJSONKey (LogScaled a) where
    fromJSONKey = fmap LogScaled fromJSONKey
    fromJSONKeyList = coerceFromJSONKeyFunction (fromJSONKeyList :: FromJSONKeyFunction [a])

            
tests/UnitTests.hs
  , testGroup "formatError" [
      testCase "example 1" formatErrorExample
    ]
  , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
  , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
  , testGroup "Object construction" $ fmap (testCase "-") objectConstruction
  , testGroup "Issue #351" $ fmap (testCase "-") issue351
  , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
  , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions
  , testCase "PR #455" pr455
  , testCase "Unescape string (PR #477)" unescapeString
  , testCase "Show Options" showOptions
  , testGroup "SingleMaybeField" singleMaybeField
  , testCase "withEmbeddedJSON" withEmbeddedJSONTest

            
tests/UnitTests.hs

camelFrom :: Char -> String -> String
camelFrom c s = let (p:ps) = split c s
                in concat $ p : map capitalize ps
  where
    split c' s' = map L.unpack $ L.split c' $ L.pack s'
    capitalize t = toUpper (head t) : tail t


data Wibble = Wibble {
    wibbleString :: String

            
tests/UnitTests.hs
newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
newtype T3 = T3 (Maybe Int) deriving (Eq, Show)

instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")

dotColonMark :: [Assertion]
dotColonMark = [
    assertEqual ".:  not-present" Nothing               (decode ex1 :: Maybe T1)
  , assertEqual ".:  42"          (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)

            
tests/UnitTests.hs
newtype MyText' = MyText' Text

instance FromJSONKey MyText' where
    fromJSONKey = fmap MyText' fromJSONKey
    fromJSONKeyList = error "not used"

fromJSONKeyAssertions :: [Assertion]
fromJSONKeyAssertions =
    [ assertIsCoerce  "Text"            (fromJSONKey :: FromJSONKeyFunction Text)

            
tests/UnitTests.hs
jsonTestSuite = do
  let suitePath = "tests/JSONTestSuite"
  let suites = ["test_parsing", "test_transform"]
  testPaths <- fmap (sort . concat) . forM suites $ \suite -> do
    let dir = suitePath </> suite
    entries <- getDirectoryContents dir
    let ok name = takeExtension name == ".json" &&
                  not (name `HashSet.member` blacklist)
    return . map (dir </>) . filter ok $ entries

            
tests/UnitTests.hs
    entries <- getDirectoryContents dir
    let ok name = takeExtension name == ".json" &&
                  not (name `HashSet.member` blacklist)
    return . map (dir </>) . filter ok $ entries
  return $ testGroup "JSONTestSuite" $ map jsonTestSuiteTest testPaths

-- The set expected-to-be-failing JSONTestSuite tests.
-- Not all of these failures are genuine bugs.
-- Of those that are bugs, not all are worth fixing.


            
aig-0.2.6
16 matches
src/Data/AIG/Interface.hs
import Control.Applicative
import Control.Monad
import Data.IORef
import Prelude.Compat hiding (not, and, or, mapM)
import Test.QuickCheck (Gen, Arbitrary(..), generate, oneof, sized, choose)

-- | Concrete datatype representing the ways
--   an AIG can be constructed.
data LitView a

            
src/Data/AIG/Interface.hs
  writeAigerWithLatches :: FilePath -> Network l g -> Int -> IO ()

  -- | Write network out to DIMACS CNF file.
  -- Returns vector mapping combinational inputs to CNF Variable
  -- numbers.
  writeCNF :: g s -> l s -> FilePath -> IO [Int]
  -- TODO: add default implementation in terms of 'abstractEvalAIG'.

  -- | Check if literal is satisfiable in network.

            
src/Data/AIG/Interface.hs
        -> IO [a]
foldAIGs n view ls = do
   eval <- abstractEvaluateAIG n view
   mapM eval ls


-- | Build an AIG literal by unfolding a constructor function
unfoldAIG :: IsAIG l g
          => g s

            
src/Data/AIG/Interface.hs
unfoldAIG n unfold = f
 where f = unfold >=> g
       g (And x y)    = and' (f x) (f y)
       g (NotAnd x y) = fmap not $ and' (f x) (f y)
       g (Input i)    = getInput n i
       g (NotInput i) = fmap not $ getInput n i
       g TrueLit      = return $ trueLit n
       g FalseLit     = return $ falseLit n
       and' mx my = do
          x <- mx
          y <- my

            
src/Data/AIG/Interface.hs
          => g s
          -> (a -> IO (LitView a))
          -> [a] -> IO [l s]
unfoldAIGs n unfold = mapM (unfoldAIG n unfold)

-- | Extract a tree representation of the given literal
toLitTree :: IsAIG l g => g s -> l s -> IO LitTree
toLitTree g = foldAIG g (return . LitTree)


            
src/Data/AIG/Interface.hs

-- | Generate an arbitrary `LitTree`
genLitTree :: Gen LitTree
genLitTree = fmap LitTree $ genLitView genLitTree

-- | Given a LitTree, calculate the maximum input number in the tree.
--   Returns 0 if no inputs are referenced.
getMaxInput :: LitTree -> Int
getMaxInput (LitTree x) =

            
src/Data/AIG/Interface.hs
-- | Given a list of LitTree, construct a corresponding AIG network
buildNetwork :: IsAIG l g => Proxy l g -> [LitTree] -> IO (Network l g)
buildNetwork proxy litForrest = do
   let maxInput = foldr max 0 $ map getMaxInput litForrest
   (SomeGraph g) <- newGraph proxy
   forM_ [0..maxInput] (\_ -> newInput g)
   ls <- fromLitForest g litForrest
   return (Network g ls)


            
src/Data/AIG/Interface.hs
     eval' (NotInput i) = Prelude.not (eval' (Input i))

  -- | Examine the outermost structure of a literal to see how it was constructed
  litView _ (BasicLit (LitTree x)) = return (fmap BasicLit x)

  -- | Build an evaluation function over an AIG using the provided view function
  abstractEvaluateAIG _g f = return (\(BasicLit x) -> h x)
   where h (LitTree x) = f =<< traverse h x

            
src/Data/AIG/Operations.hs
import Control.Applicative hiding (empty)
import Control.Exception (assert)
import qualified Control.Monad
import Control.Monad.State hiding (zipWithM, replicateM, mapM, sequence)
import Data.Bits ((.|.), setBit, shiftL, testBit)
#if MIN_VERSION_base(4,8,0)
import qualified Data.Bits as Bits
#endif


            
src/Data/AIG/Operations.hs

import Prelude()
import Prelude.Compat
  hiding (and, concat, length, not, or, replicate, splitAt, tail, (++), take, drop, zipWith, mapM)
import qualified Prelude.Compat as Prelude

import Data.AIG.Interface

-- | A BitVector consists of a sequence of symbolic bits and can be used

            
src/Data/AIG/Operations.hs
-- | Display a bitvector as a string of bits with most significant bits first.
--   Concrete literals are displayed as '0' or '1', whereas symbolic literals are displayed as 'x'.
bvShow :: IsAIG l g => g s -> BV (l s) -> String
bvShow g v = map f $ bvToList v
 where f x | x === trueLit g  = '1'
           | x === falseLit g = '0'
           | otherwise = 'x'

-- | Generate a bitvector from an integer value, using 2's complement representation.

            
src/Data/AIG/Operations.hs
{-# INLINE lNot #-}
-- | Lazy negation of a circuit.
lNot :: IsAIG l g => g s -> IO (l s) -> IO (l s)
lNot g = fmap (lNot' g)

{-# INLINE lNot' #-}
lNot' :: IsAIG l g => g s -> l s -> l s
lNot' g x | x === trueLit g = falseLit g
          | x === falseLit g = trueLit g

            
src/Data/AIG/Operations.hs
              MV.write m (n-i-1) (lNot' g aEqC)
              adderStepM ac (i+1)
  adderStepM (falseLit g) 0
  fmap BV $ V.freeze m

--addConst g x c = add g x (bvFromInteger g (length x) c)

-- | Add a constant value to a bitvector
subConst :: IsAIG l g => g s -> BV (l s) -> Integer -> IO (BV (l s))

            
src/Data/AIG/Operations.hs
        next :: [l s] -> IO [l s]
        next [] = return []
        next (b : bs) = do
          m' <- Prelude.mapM (and g b) m
          let bs' = bs Prelude.++ [falseLit g]
          Control.Monad.zipWithM (xor g) m' bs'

        go :: Int -> [l s] -> [l s] -> IO [l s]
        go i p acc

            
src/Data/AIG/Operations.hs
        go i p acc
          | i >= length x = return acc
          | otherwise = do
              px <- Prelude.mapM (and g (x ! i)) p
              acc' <- Control.Monad.zipWithM (xor g) px acc
              p' <- next p
              go (i+1) p' acc'



            
src/Data/AIG/Operations.hs
    usemask mask = do
      (qs, rs) <- pdivmod_helper g (bvToList x) mask
      let z = falseLit g
      let qs' = Prelude.map (const z) rs Prelude.++ qs
      let rs' = Prelude.replicate (length y - 1 - Prelude.length rs) z Prelude.++ rs
      let q = BV $ V.fromList qs'
      let r = BV $ V.fromList rs'
      return (q, r)


            
algebraic-graphs-0.4
1 matches
src/Algebra/Graph/AdjacencyIntMap/Internal.hs
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : unstable
--
-- This module exposes the implementation of adjacency maps. The API is unstable
-- and unsafe, and is exposed only for documentation. You should use the
-- non-internal module "Algebra.Graph.AdjacencyIntMap" instead.
-----------------------------------------------------------------------------
module Algebra.Graph.AdjacencyIntMap.Internal (
    -- * Adjacency map implementation