Aelve Codesearch

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

total matches: more than 1000

DAV-1.3.3
2 matches
Network/Protocol/HTTP/DAV.hs
    ctx <- get
    let hdrs = catMaybes
               [ Just (mk "User-Agent", ctx ^. userAgent)
               , fmap ((,) (mk "Depth") . BC8.pack . show) (ctx ^. depth)
               ] ++ addlhdrs
        req = (ctx ^. baseRequest) { method = meth, requestHeaders = hdrs, requestBody = rbody }
        authreq = if B.null (ctx ^. basicusername) && B.null (ctx ^. basicpassword)
            then req
            else applyBasicAuth (ctx ^. basicusername) (ctx ^. basicpassword) req

            
Network/Protocol/HTTP/DAV.hs
props2patch :: XML.Document -> BL.ByteString
props2patch = XML.renderLBS XML.def . patch . props . fromDocument
   where
       props cursor = map node (cursor $/ element "{DAV:}response" &/ element "{DAV:}propstat" &/ element "{DAV:}prop" &/ checkName (not . flip elem blacklist))
       patch prop = XML.Document (XML.Prologue [] Nothing []) (root prop) []
       root [] = propertyupdate []
       root prop = propertyupdate
           [ XML.NodeElement $ XML.Element "D:set" Map.empty
             [ XML.NodeElement $ XML.Element "D:prop" Map.empty prop ]

            
EtaMOO-0.3.0.0
4 matches
src/MOO/Types.hs
import Data.IntSet (IntSet)
import Data.List (intersperse)
import Data.Map (Map)
import Data.Monoid (Monoid, (<>), mappend, mconcat)
import Data.String (IsString)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Text.Lazy.Builder (Builder)
import Data.Time (UTCTime)

            
src/MOO/Types.hs
-- rules as the @toliteral()@ built-in function.
toBuilder' :: Value -> Builder
toBuilder' (Lst x) = TLB.singleton '{' <> mconcat
                     (intersperse ", " $ map toBuilder' $ Lst.toList x) <>
                     TLB.singleton '}'
toBuilder' (Str x) = quote <> Str.foldr escape quote x
  where quote, backslash :: Builder
        quote     = TLB.singleton '"'
        backslash = TLB.singleton '\\'

            
src/MOO/Types.hs
        backslash = TLB.singleton '\\'

        escape :: Char -> Builder -> Builder
        escape '"'  = mappend backslash . mappend quote
        escape '\\' = mappend backslash . mappend backslash
        escape c    = mappend (TLB.singleton c)

toBuilder' (Err x) = TLB.fromString (show x)
toBuilder' v       = toBuilder v

-- | Return a 'Text' representation of the given MOO value, using the same

            
src/MOO/Types.hs
fromList :: [Value] -> Value
fromList = Lst . Lst.fromList

-- | Turn a Haskell list into a MOO list, using a function to map Haskell
-- values to MOO values.
fromListBy :: (a -> Value) -> [a] -> Value
fromListBy f = fromList . map f

-- | Turn a list of strings into a MOO list.
stringList :: [StrT] -> Value
stringList = fromListBy Str


            
HTTP-4000.3.14
4 matches
test/Httpd.hs
         {
          reqMethod = Shed.reqMethod request,
          reqURI = Shed.reqURI request,
          reqHeaders = map (id *** chomp) $ Shed.reqHeaders request,
          reqBody = Shed.reqBody request
         }

#if !MIN_VERSION_bytestring(0,10,0)
instance NFData B.ByteString where

            
test/Httpd.hs
     responseToWarp (Response status hdrs body) =
         Warp.responseLBS
                 (Warp.Status status B.empty)
                 (map headerToWarp hdrs)
                 (BLC.pack body)
     headerToWarp (name, value) = (CI.mk (BC.pack name), BC.pack value)
     headerFromWarp (name, value) =
         (BC.unpack (CI.original name), BC.unpack value)
     requestFromWarp request = do

            
test/Httpd.hs
         (BC.unpack (CI.original name), BC.unpack value)
     requestFromWarp request = do
#if MIN_VERSION_wai(3,0,1)
         body <- fmap BLC.unpack $ Warp.strictRequestBody request
#else
         body <- fmap BLC.unpack $ Warp.lazyRequestBody request
         body `deepseq` return ()
#endif
         return $
                Request
                {

            
test/Httpd.hs
                 reqURI = fromJust . parseRelativeReference .
                          BC.unpack . Warp.rawPathInfo $
                          request,
                 reqHeaders = map headerFromWarp (Warp.requestHeaders request),
                 reqBody = body
                }
#endif

            
MFlow-0.4.6.0
20 matches
src/MFlow/Forms.hs
                   then unsafeCoerce v else show v
  return $ FormElm (finput n "radio" str
          ( isValidated mn  && v== fromValidated mn) (Just  "this.form.submit()"))
          (fmap Radio $ valToMaybe mn)


-- | Implement a radio button
-- the parameter is the name of the radio group
setRadio :: (FormInput view,  MonadIO m,

            
src/MFlow/Forms.hs
                   then unsafeCoerce v else show v
  return $ FormElm (finput n "radio" str
          ( isValidated mn  && v== fromValidated mn) Nothing)
          (fmap Radio $ valToMaybe mn)

-- | encloses a set of Radio boxes. Return the option selected
getRadio
  :: (Monad m, Functor m, FormInput view) =>
     [String -> View view m (Radio a)] -> View view m a

            
src/MFlow/Forms.hs
     [String -> View view m (Radio a)] -> View view m a
getRadio rs=  do
        id <- genNewId
        Radio r <- firstOf $ map (\r -> r id)  rs
        return r

data CheckBoxes = CheckBoxes [String]

instance Monoid CheckBoxes where

            
src/MFlow/Forms.hs
data CheckBoxes = CheckBoxes [String]

instance Monoid CheckBoxes where
  mappend (CheckBoxes xs) (CheckBoxes ys)= CheckBoxes $ xs ++ ys
  mempty= CheckBoxes []

--instance (Monad m, Functor m) => Monoid (View v m CheckBoxes) where
--  mappend x y=  mappend <$> x <*> y
--  mempty= return (CheckBoxes [])


-- | Display a text box and return the value entered if it is readable( Otherwise, fail the validation)
setCheckBox :: (FormInput view,  MonadIO m) =>

            
src/MFlow/Forms.hs
  st <- get
  put st{needForm= HasElems}
  let env = mfEnv st
      strs= map snd $ filter ((==) n . fst) env
      mn= if null strs then Nothing else Just $ head strs
      val = inSync st
  let ret= case val of                    -- !> show val of
        True  -> Just $ CheckBoxes  strs  -- !> show strs
        False -> Nothing

            
src/MFlow/Forms.hs
  st <- get
  put st{needForm= HasElems}
  let env = mfEnv st
      strs= map snd $ filter ((==) n . fst) env
      mn= if null strs then Nothing else Just $ head strs

  val <- gets inSync
  let ret= case val of
        True ->  Just $ CheckBoxes  strs

            
src/MFlow/Forms.hs
    let env = mfEnv st
    put st{needForm= HasElems}
    r <- getParam1 tolook env
    setSessionData $ fmap MFOption $ valToMaybe r
    FormElm form mr <- (runView opts)

    return $ FormElm (fselect tolook  form)  $ valToMaybe r



            
src/MFlow/Forms.hs
newtype MFOption a= MFOption a deriving Typeable

instance (FormInput view,Monad m, Functor m) => Monoid (View view m (MFOption a)) where
  mappend =  (<|>)
  mempty = Control.Applicative.empty

-- | Set the option for getSelect. Options are concatenated with `<|>`
setOption
  :: (Monad m, Show a, Eq a, Typeable a, FormInput view) =>

            
src/MFlow/Forms.hs
userValidate :: (FormInput view,MonadIO m) => (UserStr,PasswdStr) -> m (Maybe view)
userValidate (u,p) = liftIO $  do
   Auth _ val <- getAuthMethod
   val u p >>= return .  fmap  fromStr



-- | for compatibility with the same procedure in 'MFLow.Forms.Test.askt'.
-- This is the non testing version

            
src/MFlow/Forms.hs
      st   <- get

      let name = --mfPrefix st ++
                (map toLower $ if typeOf x== typeOf(undefined :: String)
                                   then unsafeCoerce x
                                   else show x)
          lpath = mfPath st
          newPath= mfPagePath st  ++ [name]


            
src/MFlow/Forms.hs
      st   <- get

      let name = -- mfPrefix st
                (map toLower $ if typeOf x== typeOf(undefined :: String)
                                   then unsafeCoerce x
                                   else show x)

          lpath = mfPath st
          newPath= mfPagePath st ++ [name]

            
src/MFlow/Forms.hs

--instance (Widget a b m view, Monoid view) => Widget [a] b m view where
--  widget xs = View $ do
--      forms <- mapM(\x -> (runView  $  widget x )) xs
--      let vs  = concatMap (\(FormElm v _) -> v) forms
--          res = filter isJust $ map (\(FormElm _ r) -> r) forms
--          res1= if null res then Nothing else head res
--      return $ FormElm [mconcat vs] res1

-- | Concat a list of widgets of the same type, return a the first validated result
firstOf :: (FormInput view, Monad m, Functor m)=> [View view m a]  -> View view m a

            
src/MFlow/Forms.hs
firstOf :: (FormInput view, Monad m, Functor m)=> [View view m a]  -> View view m a
firstOf xs= foldl' (<|>) noWidget xs
--  View $ do
--      forms <- mapM runView  xs
--      let vs  = concatMap (\(FormElm v _) ->  [mconcat v]) forms
--          res = filter isJust $ map (\(FormElm _ r) -> r) forms
--          res1= if null res then Nothing else head res
--      return $ FormElm  vs res1

-- | from a list of widgets, it return the validated ones.
manyOf :: (FormInput view, MonadIO m, Functor m)=> [View view m a]  -> View view m [a]

            
src/MFlow/Forms.hs
-- | from a list of widgets, it return the validated ones.
manyOf :: (FormInput view, MonadIO m, Functor m)=> [View view m a]  -> View view m [a]
manyOf xs= whidden () *> (View $ do
      forms <- mapM runView  xs
      let vs  = mconcat $ map (\(FormElm v _) ->   v) forms
          res1= catMaybes $ map (\(FormElm _ r) -> r) forms
      nval <- gets mfSomeNotValidates
      return . FormElm vs $ if nval then Nothing else Just res1)

-- | like manyOf, but does not validate if one or more of the widgets does not validate
allOf xs= manyOf xs `validate` \rs ->

            
src/MFlow/Forms.hs
           -> [View view m r']
           -> View view m (Maybe r,Maybe r')
(|*>) x xs= View $ do
  fs <-  mapM runView  xs
  FormElm fx rx   <- runView  x
  let (fxs, rxss) = unzip $ map (\(FormElm v r) -> (v,r)) fs
      rs= filter isJust rxss
      rxs= if null rs then Nothing else  head rs
  return $ FormElm (fx <> mconcat (intersperse  fx fxs) <> fx)
         $ case (rx,rxs) of
            (Nothing, Nothing) -> Nothing

            
src/MFlow/Forms.hs
--     View v m a -> View v1 m b -> View ByteString m (Maybe a, Maybe b)
--(.<+>.) x y = normalize x <+> normalize y
--
---- | > (.|*>.) x y = normalize x |*> map normalize y
--(.|*>.)
--  :: (Functor m, MonadIO m, FormInput v, FormInput v1) =>
--     View v m r
--     -> [View v1 m r'] -> View ByteString m (Maybe r, Maybe r')
--(.|*>.) x y = normalize x |*> map normalize y

            
src/MFlow/Forms.hs
--  :: (Functor m, MonadIO m, FormInput v, FormInput v1) =>
--     View v m r
--     -> [View v1 m r'] -> View ByteString m (Maybe r, Maybe r')
--(.|*>.) x y = normalize x |*> map normalize y
--
---- | > (.|+|.) x y = normalize x |+| normalize y
--(.|+|.)
--  :: (Functor m, MonadIO m, FormInput v, FormInput v1) =>
--     View v m r -> View v1 m r' -> View ByteString m (Maybe r, Maybe r')

            
src/MFlow/Hack.hs
    case lookup statCookieName cookies of
        Nothing -> return ()
        Just (statCookieName,  str , "/", _) -> modifyMVar_ tvresources $
                          \mmap -> case mmap of
                              Just map ->  return $ Just $ M.insert (keyResource req)  str map
                              Nothing   -> return $ Just $ M.fromList [((keyResource req),  str) ]

getStateCookie req= do
    mr<- readMVar tvresources
    case mr of

            
src/MFlow/Hack.hs
    mr<- readMVar tvresources
    case mr of
     Nothing  ->  return Nothing
     Just map -> case  M.lookup (keyResource req) map  of
      Nothing -> return Nothing
      Just str -> do
        swapMVar tvresources Nothing
        return $  Just  (statCookieName,  str , "/")


            
src/MFlow/Hack.hs
{-
persistInCookies= setPersist  PersistStat{readStat=readResource, writeStat=writeResource, deleteStat=deleteResource}
    where
    writeResource stat= modifyMVar_ tvresources $  \mmap ->
                                      case mmap of
                                            Just map-> return $ Just $ M.insert (keyResource stat) (serialize stat) map
                                            Nothing -> return $ Just $ M.fromList [((keyResource stat),   (serialize stat)) ]
    readResource stat= do
           mstr <- withMVar tvresources $ \mmap ->
                                case mmap of
                                   Just map -> return $ M.lookup (keyResource stat) map
                                   Nothing -> return  Nothing
           case mstr of
             Nothing -> return Nothing
             Just str -> return $ deserialize str