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

Agda-2.6.0.1
20 matches
src/full/Agda/Interaction/Highlighting/LaTeX.hs
-- with spaces.

replaceSpaces :: Text -> Text
replaceSpaces = T.map (\c -> if isSpaceNotNewline c then ' ' else c)


-- | If the `Token` consists of spaces, the internal column counter is advanced
--   by the length of the token. Otherwise, `moveColumnForToken` is a no-op.
moveColumnForToken :: Token -> LaTeX ()

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
-- * Output generation from a stream of labelled tokens.

processLayers :: [(LayerRole, Tokens)] -> LaTeX ()
processLayers = mapM_ $ \(layerRole,toks) -> do
  case layerRole of
    L.Markup  -> processMarkup  toks
    L.Comment -> processComment toks
    L.Code    -> processCode    toks


            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
processMarkup, processComment, processCode :: Tokens -> LaTeX ()

-- | Deals with markup, which is output verbatim.
processMarkup = mapM_ $ \t -> do
  moveColumnForToken t
  output (Text (text t))

-- | Deals with literate text, which is output verbatim
processComment = mapM_ $ \t -> do

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
  output (Text (text t))

-- | Deals with literate text, which is output verbatim
processComment = mapM_ $ \t -> do
  unless ("%" == T.take 1 (T.stripStart (text t))) $ do
    moveColumnForToken t
  output (Text (text t))

-- | Deals with code blocks. Every token, except spaces, is pretty

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
processCode toks' = do
  output $ Text nl
  enterCode
  mapM_ go toks'
  ptOpenWhenColumnZero =<< gets column
  output $ Text $ ptClose <+> nl
  leaveCode

  where

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
            -- to its aspect (if any) and other aspects (e.g. error, unsolved meta)
            foldr (\c t -> cmdPrefix <+> T.pack c <+> cmdArg t)
                  (escape tok)
                  $ map fromOtherAspect (toList $ otherAspects $ info tok') ++
                    concatMap fromAspect (toList $ aspect $ info tok')

    -- Non-whitespace tokens at the start of a line trigger an
    -- alignment column.
    ptOpenWhenColumnZero col =

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
-- properly
stringLiteral :: Token -> Tokens
stringLiteral t | aspect (info t) == Just String =
  map (\ x -> t { text = x })
          $ concatMap leadingSpaces
          $ List.intersperse "\n"
          $ T.lines (text t)
  where
  leadingSpaces :: Text -> [Text]

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
  inAbsPath <- liftM filePath (Find.findFile mod)

  liftIO $ do
    latex <- E.encodeUtf8 `fmap`
               toLaTeX (O.optCountClusters $ O.optPragmaOptions options)
                       (mkAbsolute inAbsPath) (iSource i) hi
    createDirectoryIfMissing True $ dir </> takeDirectory outPath
    BS.writeFile (dir </> outPath) latex


            
src/full/Agda/Interaction/Highlighting/LaTeX.hs

groupByFst :: forall a b. Eq a => [(a,b)] -> [(a,[b])]
groupByFst =
    map (\xs -> case xs of                     -- Float the grouping to the top level
          []           -> __IMPOSSIBLE__
          (tag, _): _ -> (tag, map snd xs))

  . List.groupBy ((==) `on` fst)  -- Group together characters in the same
                                  -- role.

-- | Transforms the source code into LaTeX.

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs

  = processTokens cc

  . map (\(role, tokens) -> (role,) $
      -- This bit fixes issue 954
      (if L.isCode role then
        -- Remove trailing whitespace from the
        -- final line; the function spaces
        -- expects trailing whitespace to be

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
          (withLast $
            withTokenText $ \suf ->
              fromMaybe suf $
                fmap (T.dropWhileEnd isSpaceNotNewline) $
                  T.stripSuffix "\n" suf)
        .
        (withLast $ withTokenText $ T.dropWhileEnd isSpaceNotNewline)
        .
        (withFirst $

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
        -- do nothing
        id) tokens)

  . map (second (
      -- Split tokens at newlines
      concatMap stringLiteral

      -- Head the list (the grouped chars contain the same meta info) and
      -- collect the characters into a string.

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs

      -- Head the list (the grouped chars contain the same meta info) and
      -- collect the characters into a string.
    . map (\(mi, cs) ->
                          Token { text = T.pack cs
                                , info = fromMaybe mempty mi
                                })
      -- Characters which share the same meta info are the same token, so
      -- group them together.

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
  . groupByFst

  -- Look up the meta info at each position in the highlighting info.
  . map (\(pos, (role, char)) -> (role, (IntMap.lookup pos infoMap, char)))

  -- Add position in file to each character.
  . zip [1..]

  -- Map each character to its role

            
src/full/Agda/Interaction/Highlighting/LaTeX.hs
  -> IO L.Text
processTokens cc ts = do
  ((), s, os) <- runLaTeX (processLayers ts) () (emptyState cc)
  return $ L.fromChunks $ map (render s) os
  where
    render _ (Text s)        = s
    render s (MaybeColumn c)
      | Just i <- columnKind c,
        not (Set.member i (usedColumns s)) = agdaSpace

            
src/full/Agda/Utils/Parser/MemoisedCPS.hs
    p input i $ \j x -> unP (f x) input j k

instance Functor (Parser k r tok) where
  fmap f (P p) = P $ \input i k ->
    p input i $ \i -> k i . f

instance Applicative (Parser k r tok) where
  pure x        = P $ \_ i k -> k i x
  P p1 <*> P p2 = P $ \input i k ->

            
src/full/Agda/Utils/Parser/MemoisedCPS.hs
    let alter j zero f m =
          IntMap.alter (Just . f . fromMaybe zero) j m

        lookupTable   = fmap (\m -> Map.lookup key =<<
                                    IntMap.lookup i m) get
        insertTable v = modify' $ alter i Map.empty (Map.insert key v)

    v <- lookupTable
    case v of

            
src/full/Agda/Utils/Parser/MemoisedCPS.hs
        unP p input i $ \j r -> do
          ~(Just (Value rs ks)) <- lookupTable
          insertTable (Value (alter j [] (r :) rs) ks)
          concat <$> mapM (\k -> k j r) ks  -- See note [Reverse ks?].
      Just (Value rs ks) -> do
        insertTable (Value rs (k : ks))
        concat . concat <$>
          mapM (\(i, rs) -> mapM (k i) rs) (IntMap.toList rs)

-- [Reverse ks?]
--
-- If ks were reversed, then the code would be productive for some
-- infinitely ambiguous grammars, including S ∷= S | ε. However, in

            
src/full/Agda/Utils/Parser/MemoisedCPS.hs
          <$> docs p)

instance Functor (ParserWithGrammar k r tok) where
  fmap f p = pg (fmap f (parser p)) (docs p)

instance Applicative (ParserWithGrammar k r tok) where
  pure x    = pg (pure x) (return ("ε", atomP))
  p1 <*> p2 =
    pg (parser p1 <*> parser p2)

            
src/full/Agda/Utils/Parser/MemoisedCPS.hs
      $+$
    nest 2 (foldr1 ($+$) $
      "where" :
      map (\(k, d) -> fst (prettyKey k) <+> "∷=" <+>
                        maybe __IMPOSSIBLE__ fst d)
          (Map.toList ds))
    where
    ((d, _), ds) = runState (docs p) Map.empty

            
CurryDB-0.1.1.0
1 matches
Database/Redis/Commands.hs
  case (x, toInt sstart, toInt sstop) of
    (VList ss, Just start, Just stop) -> do
      return
        $ MultiBulkReply $ Just $ map Just $ toList
        $ Seq.take (stop - start) $ Seq.drop start ss
    _ ->
      return typeErr

sadd :: S.ByteString -> [S.ByteString] -> RedisCommand

            
Earley-0.13.0.1
3 matches
examples/Mixfix.hs
  deriving Show

identTable :: [[(Holey String, Associativity)]]
identTable = (map . map) (first holey)
  [ [("_->_",          RightAssoc)]
  , [("_,_",           NonAssoc)]
  , [("if_then_else_", RightAssoc)]
  , [("_|-_:_",        NonAssoc)]
  , [("_+_",           LeftAssoc)]

            
examples/Mixfix.hs
  expr      <- mixfixExpression table normalApp (App . V)
  return expr
  where
    table = map (map $ first $ map $ fmap namedToken) identTable
    mixfixParts = HS.fromList [s | xs <- identTable , (ys, _) <- xs
                                 , Just s <- ys]
               `mappend` HS.fromList ["(", ")"]

pretty :: Expr -> String
pretty (V ps) = concatMap (fromMaybe "_") ps
pretty (App e es) = "(" ++ pretty e ++ " " ++ unwords (map pretty es) ++ ")"

tokenize :: String -> [String]
tokenize ""        = []
tokenize (' ':xs)  = tokenize xs
tokenize ('\n':xs) = tokenize xs

            
examples/Mixfix.hs
main :: IO ()
main = do
  x:_ <- getArgs
  print $ first (map pretty) $ fullParses (parser grammar) $ tokenize x

            
EtaMOO-0.3.0.0
6 matches
src/MOO/Database.hs

getProtected :: (Id -> MOO (Maybe Value)) -> [Id] -> MOO (Id -> Bool)
getProtected getOption ids = do
  maybes <- forM ids $ fmap (fmap truthOf) . getOption . ("protect_" <>)
  let protectedSet = HS.fromList [ id | (id, Just True) <- zip ids maybes ]
  return (`HS.member` protectedSet)

loadServerOptions :: MOO ()
loadServerOptions = do

            
src/MOO/Unparser.hs
  env { indentation = ("  " <>) <$> indentation env }

tellStatements :: [Statement] -> Unparser ()
tellStatements = mapM_ tellStatement

tellStatement :: Statement -> Unparser ()
tellStatement stmt = case stmt of
  Expression _ expr -> indent >> tellExpr expr >> tell ";\n"


            
src/MOO/Unparser.hs
  If _ cond (Then thens) elseIfs (Else elses) -> do
    indent >> tell "if (" >> tellExpr cond >> tell ")\n"
    moreIndented $ tellStatements thens
    mapM_ tellElseIf elseIfs
    unless (null elses) $ do
      indent >> tell "else\n"
      moreIndented $ tellStatements elses
    indent >> tell "endif\n"


            
src/MOO/Unparser.hs
  TryExcept body excepts -> do
    indent >> tell "try\n"
    moreIndented $ tellStatements body
    mapM_ tellExcept excepts
    indent >> tell "endtry\n"

    where tellExcept (Except _ var codes handler) = do
            indent >> tell "except" >> maybeTellVar var >> tell " ("
            case codes of

            
src/MOO/Unparser.hs
        numeric _     = False

        negateParen :: Expr -> Unparser Builder
        negateParen = fmap ("-" <>) . paren

unparseArgs :: [Argument] -> Unparser Builder
unparseArgs = fmap (mconcat . intersperse ", ") . mapM unparseArg
  where unparseArg (ArgNormal expr) =              unparseExpr expr
        unparseArg (ArgSplice expr) = ("@" <>) <$> unparseExpr expr

unparseScatter :: [ScatterItem] -> Unparser Builder
unparseScatter = fmap (mconcat . intersperse ", ") . mapM unparseScat

            
src/MOO/Unparser.hs
        unparseArg (ArgSplice expr) = ("@" <>) <$> unparseExpr expr

unparseScatter :: [ScatterItem] -> Unparser Builder
unparseScatter = fmap (mconcat . intersperse ", ") . mapM unparseScat
  where unparseScat (ScatRequired var)         = return $        fromId var
        unparseScat (ScatRest     var)         = return $ "@" <> fromId var
        unparseScat (ScatOptional var Nothing) = return $ "?" <> fromId var
        unparseScat (ScatOptional var (Just expr)) = do
          expr' <- unparseExpr expr