Aelve Codesearch

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

total matches: more than 1000

Adaptive-0.23
10 matches
Control/Monad/Adaptive/CircularList.hs
         (p,_,n) <- get l
         set l (p,a,n)

val l = (\ (p,a,n) -> a) `fmap` get l

next l = (\ (p,a,n) -> n) `fmap` get l

previous l = (\ (p,a,n) -> p) `fmap` get l

insert l a = do
  (p,b,n) <- get l
  n' <- CL `fmap` newRef (l,a,n)
  set l (p,b,n')
  nl <- next n'
  (_,nb,nn) <- get nl
  set nl (n',nb,nn)
  return n'

            
Control/Monad/Adaptive/OrderedList.hs
deOL (OL f) = f

run l = do
    base <- Record `fmap` circularList (False,0,undefined)
    s <- newRef 0
    mr <- newRef m
    deOL l (mr,s,base)
  where 
    m = 2^16

            
Control/Monad/Adaptive/OrderedList.hs
  (OL m) >>= f = OL $ \e -> m e >>= \a -> deOL (f a) e

instance Ref m r => Functor (OrderedList m r a) where 
  fmap f m = m >>= return . f

instance Ref m r => Ref (OrderedList m r a) r where
  newRef v     = inM (newRef v)
  readRef r    = inM (readRef r)
  writeRef r v = inM (writeRef r v)

            
Control/Monad/Adaptive/OrderedList.hs
record :: Ref m r => Record m r a -> OrderedList m r a (Bool,Integer,a)
record r = inM (val (deR r))

rval r = (\ (d,i,a) -> a) `fmap` record r

next r = Record `fmap` inM (CircularList.next (deR r))

s x = next x

-- label
l :: Ref m r => Record m r a -> OrderedList m r a Integer

            
Control/Monad/Adaptive/OrderedList.hs

-- label
l :: Ref m r => Record m r a -> OrderedList m r a Integer
l r = (\ (d,i,a) -> i) `fmap` record r

-- gap
g e f = (l f - l e) `mod` bigM

deleted r = (\ (d,i,a) -> d) `fmap` record r

            
Control/Monad/Adaptive/OrderedList.hs
-- gap
g e f = (l f - l e) `mod` bigM

deleted r = (\ (d,i,a) -> d) `fmap` record r

lbase :: Ref m r => OrderedList m r a Integer
lbase = base >>= l

gstar :: Ref m r => Record m r a -> Record m r a -> OrderedList m r a Integer

            
Control/Monad/Adaptive/OrderedList.hs
spliceOut r s = next r >>= spl where
  spl r = do 
    unlessM (mop lbase (==) (l r)) $
        whenM ((==LT) `fmap` order r s)
              (do r' <- next r
                  delete r
                  spl r')

increaseBigM :: Ref m r => OrderedList m r a ()

            
Control/Monad/Adaptive.hs
  Ch m >>= f = Ch $ \k -> m $ \a -> deCh (f a) k

instance Ref m r => Functor (Changeable m r) where
  fmap f m = m >>= return . f

instance Ref m r => Ref (Adaptive m r) r where
  newRef v     = inM $ newRef v
  readRef x    = inM $ readRef x
  writeRef x v = inM $ writeRef x v

            
Control/Monad/Adaptive.hs
  Ad m >>= f = Ad $ \e -> m e >>= \a -> deAd (f a) e

instance Ref m r => Functor (Adaptive m r) where
  fmap f m = m >>= return . f

readMod (Mo (r,chg,es)) = do
   start <- inAd stepTime
   cont $ \k -> do
     let reader = do readRef r >>= k

            
spreadsheet.hs
main = run $ do
     inM $ putStr clear
     env <- mapM newCell' [0..9]
     m0 <- CR "?" `fmap` newMod (return 0)
     let loop = do (c,e) <- prompt env
                   let e' = subst m0 env e
                   change c e'
                   propagate
                   loop

            
Adaptive-Blaisorblade-0.23
1 matches
spreadsheet.hs
main = run $ do
     inM $ putStr clear
     env <- mapM newCell' [0..9]
     m0 <- CR "?" `fmap` newMod (return 0)
     let loop = do (c,e) <- prompt env
                   let e' = subst m0 env e
                   change c e'
                   propagate
                   loop

            
Advise-me-0.1
19 matches
app/AdviseMeAdmin.hs
   query = queryString req

   param :: B.ByteString -> Maybe String
   param = fmap (safeString . maybe "" B.unpack) . flip lookup query

   paramFlag :: B.ByteString -> Bool
   paramFlag = maybe False (const True) . flip lookup query

   paramString :: B.ByteString -> String

            
app/AdviseMeAdmin.hs

-- | Extract the inputIDs and input texts from an entry's XML.
inputHTMLs :: XML.XML -> [(InputID, HTMLBuilder)]
inputHTMLs = map (fmap $ XML.tag "pre"
                       . mconcat
                       . (("style" XML..=. "white-space: pre-wrap"):)
                       . map (either XML.string XML.builder)
                       . content
                       )

            
app/DatabaseBuilder.hs
         )
#endif
      <*>
         ( fmap (fmap $ map trim . split ',') . O.optional . O.strOption $
            O.long "filter" <>
            O.help "Put requests in the given order; discard all others (expects comma-seperated list of task IDs)"
         )
      <*>
         ( O.switch $

            
app/DatabaseBuilder.hs
   -- Turn a student record into a model record
   asModel rec = M.fromList $
      ("studentid", rec ! "studentid") :
      (map (fmap SQL.toSql) . evStates . SQL.fromSql $ rec ! "studentmodel")

   modelsTable = SqlTable
      { tableName = "final_models"
      , columns = ("studentid", "TEXT") : map (\x -> (x, "REAL")) nodeNames
      }

            
app/Report.hs

mainPriors :: PriorsArguments -> IO ()
mainPriors args = do
   priors <- fmap (foldr (<>) mempty) . forM (priorsDatabases args) $ \path -> 
      calculatePriors <$> (SQL.connectSqlite3 path >>= allEvidence)
   PP.putDoc $
      pretty "Priors:" <$$>
      pretty priors <$$>
      mempty

            
src/Bayes/NetworkReader.hs

xmlToProbabilities :: Monad m => XML -> m [Probability]
xmlToProbabilities xml =
   mapM (fmap fromRational . readRational) $ words $ getData xml

xmlToInts :: Monad m => XML -> m [Int]
xmlToInts = mapM readM . words . getData

xmlToDoubles :: Monad m => XML -> m [Double]

            
src/Bayes/StudentReport.hs
getTranslations :: String -> IO (M.Map String Translation) 
getTranslations requestedLanguage = do
   xml <- XML.parseXMLFile "networks/labels.xml"
   fmap M.fromList . forM (XML.findChildren "node" xml) $ \nodeXml -> do
      nodeID <- XML.findAttribute "id" nodeXml
      title <- XML.findChild "title" nodeXml >>= getDataLang
      description <- maybe (return Nothing) (return . getDataLang) $ XML.findChild "description" nodeXml
      example <- maybe (return Nothing) (return . getDataLang) $ XML.findChild "example" nodeXml
      return (nodeID, Translation { translationLabel = title, translationDescription = description, translationExample = example })

            
src/Database/Data.hs
latestInsertRowID conn table = do
   stm <- SQL.prepare conn $ "SELECT last_insert_rowid() FROM "++ table ++" LIMIT 1"
   void $ SQL.execute stm []
   fmap (fromSql . head) <$> SQL.fetchRow stm


-- | Test if the given table exists.
tableExists :: Connection -> String -> IO Bool
tableExists conn name = (name `elem`) <$> SQL.getTables conn

            
src/Database/Data.hs

-- | Make a default entry, where all columns are set to null.
defaultEntry :: [SqlTable] -> SqlRecord
defaultEntry = M.fromList . map (fmap $ const SQL.SqlNull) . (>>= columns)


-- ** Querying

-- | Obtain all records from the 'requests' table, optionally combined with the

            
src/Domain/LinearAlgebra/Matrix.hs
type Column a = [a]

instance Functor Matrix where
   fmap f (M rs) = M (map (map f) rs)

instance Foldable Matrix where
   foldMap f (M xss) = foldMap (mconcat . map f) xss

instance Traversable Matrix where

            
src/Domain/LinearAlgebra/Matrix.hs
matrixrowSymbol = newSymbol OM.matrixrowSymbol

instance Simplify a => Simplify (Matrix a) where
   simplifyWith opt = fmap (simplifyWith opt)

-- Check whether the table is rectangular
isRectangular :: [[a]] -> Bool
isRectangular xss =
   case map length xss of

            
src/Domain/LinearAlgebra/Matrix.hs
        error "add: dimensions differ"

scale :: Num a => a -> Matrix a -> Matrix a
scale a = fmap (*a)

multiply :: Num a => Matrix a -> Matrix a -> Matrix a
multiply a b
   | snd (dimensions a) == fst (dimensions b) =
        M $ map (\r -> map (sum . zipWith (*) r) (columns b)) (rows a)

            
src/Domain/Logic/InverseRules.hs
   Just (x, foldr1 op xs)
useHead _ _ = Nothing

useLast op = fmap (\(x, y) -> (y, x)) . useHead (flip op) . reverse

allSame :: Eq a => [a] -> Bool
allSame []     = True
allSame (x:xs) = all (==x) xs


            
src/Domain/Math/CleanUp.hs
cleanUpRelations = noDuplicates . foldMap cleanUpRelation

cleanUpRelation :: Relation Expr -> OrList (Relation Expr)
cleanUpRelation = f . fmap cleanUpBU
 where
   f rel
      | any falsity (universe a ++ universe b) = false
      | a == b    = fromBool (relationType rel `elem` equals)
      | otherwise =

            
src/Domain/Math/CleanUp.hs
   fromMaybe (smart e) $
      canonical rationalView e
    `mplus`
      fmap (transform smart) (canonical specialSqrtOrder e)
      -- Just simplify order of terms with square roots for now
    `mplus` do
      let f xs | length xs > 1 = return (assocPlus rationalView xs)
          f _ = Nothing
      canonicalWithM f sumView e

            
src/Domain/Math/Data/MultivariatePolynomial.hs
  show = show . fromFactors

instance Functor MultivariatePolynomial where
  fmap f (Sum xs) = Sum (f <$> xs)

instance Foldable MultivariatePolynomial where
  foldMap f (Sum xs) = foldMap f xs

instance Traversable MultivariatePolynomial where

            
src/Domain/Math/Equation/BalanceRules.hs
termRef   = makeRef "term"

plusRule :: Functor f => ParamTrans Expr (f Expr)
plusRule = parameter1 termRef $ \a -> Just . fmap (:+: a)

minusRule :: Functor f => ParamTrans Expr (f Expr)
minusRule = parameter1 termRef $ \a -> Just . fmap (:-: a)

timesRule :: Functor f => ParamTrans Expr (f Expr)
timesRule = parameter1 factorRef $ \a -> unlessZero a . fmap (a :*:)

divisionRule :: ParamTrans Expr (Equation Expr)
divisionRule = parameter1 factorRef $ \a -> unlessZero a . fmap (:/: a)

unlessZero :: Expr -> a -> Maybe a
unlessZero e a = do
   r <- matchM rationalView e
   guard (r /= 0)

            
src/Domain/Math/Equation/CoverUpRules.hs
   (guard (coverLHS cfg) >> coverLeft eq0) ++
   (guard (coverRHS cfg) >> coverRight eq0)
 where
   coverRight   = map (fmap flipSides) . coverLeft . flipSides
   coverLeft eq = do
      (e1, e2) <- fm (leftHandSide eq)
      -- guard (predicateCovered  cfg e1)
      new <- fb (rightHandSide eq) e2
      _   <- mapM (guard . predicateCombined cfg) new

            
src/Domain/Math/Equation/CoverUpRules.hs
      -- guard (predicateCovered  cfg e1)
      new <- fb (rightHandSide eq) e2
      _   <- mapM (guard . predicateCombined cfg) new
      return (fmap (constructor eq e1) new)

coverUpBinaryOrRule :: Relational r
                   => String -> (Expr -> [(Expr, Expr)])
                   -> (Expr -> Expr -> [OrList Expr])
                   -> ConfigCoverUp -> Rule (OrList (r Expr))