Little handy QuasiQuoters

November 24, 2024 &english @code #haskell

List of very handy QuasiQuoters in Haskell, that makes routine programming tasks easier.

Data.Time.Clock.Duration.QQ

Some Haskell libraries in Haskell tend to accept time durations as Ints (timeout from base wants microseconds, but timeout from wai-extra prefers seconds). That can be very error-prawn and annoying to work with. Set of QuasiQuoters from Data.Time.Clock.Duration.QQ package solves this problem in vert elegant way:

  • Need to express 5 seconds worth of time, but in microseconds? [µs|5s|] (very cute usage of unicode, I must say).
  • How long is 42 minutes in seconds? Trivial: [s|42m|].
  • Want to hardcode a day as NominalDiffTime, but without doing 24*60*60 or -- 24 hours comment? Easy: [t|1day|].

Many different time durations are supported:

data Time
  = Picosec  Rational
  | Nanosec  Rational
  | Microsec Rational
  | Millisec Rational -- ^ Denoted by @ms@, @msec@, @msecs@, @millisecond@, or @milliseconds@
  | Second   Rational -- ^ Denoted by @s@, @sec@, @secs@, @second@, or @seconds@
  | Minute   Rational -- ^ Denoted by @m@, @min@, @mins@, @minute@, or @minutes@
  | Hour     Rational -- ^ Denoted by @h@, @hr@, @hrs@, @hour@, or @hours@
  | Day      Rational -- ^ Denoted by @d@, @day@, or @days@
  | Week     Rational -- ^ Denoted by @w@, @week@, or @weeks@
  | Year     Rational -- ^ Denoted by @y@, @yr@, @yrs@, @year@, or @years@

Data.Time.QQ

This QuasiQuoter is very handy when you need to put some human readable date in code, which expects UTCTime.

  • Just a date, with time zeroed-out: [utcIso8601|2048-12-01|].
  • With particular time (including milliseconds): [utcIso8601ms|2099-01-01T10:15:13.42324|].

Text.URI.QQ and Network.URI.Static

Ever need to create a value of URI type (from Text.URI or from Network.URI)? Not very hard task to do, but type signatures assume parsing might fail:

parseURI :: String -> Maybe URI
mkURI :: MonadThrow m => Text -> m URI

Hopefully, you can rely on QuasiQuoters: [uri|https://www.google.com/|] and get you URI checked at compile time.

Path.Posix

Working with system paths requires some attention and love. I prefer to use stronger-typed path package. It allows to distinguish between absolute and relative paths, making code a but less error-prawn.

Set of QuasiQuoters allows to embed absolute and relative file system paths with ease:

  • Files:
    • Relative: [relfile|tests/Golden/trigger.schema|].
    • Absolute: [absfile|/home/maksar/foo.txt|].
  • Directories:
    • Relative: [reldir|maksar|].
    • Absolute: [absdir|/home/maksar|].

Text.Regex.Quote

Regular expression QuasiQuoter, I think it is self-explanatory: [r|run-([0-9a-f]{32})-sha-[0-9a-f]{40}|]. However, there is a little twist, here is the quote from documentation:

You can choose Regex type by changing imports.

For example, the exp variable in the below example has the type of Text.Regex.Posix.Regex:

import Text.Regex.Posix (Regex)
exp = [r|hoge|]

and, the exp variable in below example has the type of Text.Regex.PCRE.Regex:

import Text.Regex.PCRE (Regex)
exp = [r|hoge|]

Data.String.Interpolate

That one is a Swiss army knife for string interpolation: [i|run-#{run}-sha-#{sha}|].

Just compare it with alternatives:

  • Fmt (which I prefer to use for a log messages because of show brackets and combinators):
    • Regular way "run-" +| run |+ "-sha-" +| sha |+ "".
    • Format way format "run-{}-sha-{}" run sha.
  • Semigroup way "run-" <> run <> "-sha-" <> sha.

It also has some flavours:

  • __i An interpolator that handles indentation.
  • iii An interpolator that strips excess whitespace.

Data.Aeson.QQ

Unlike Data.Aeson.QQ.Simple, this one allows interpolation of values. Very handy, no need to create custom type with ToJSON instance or use verbose json combinators from Data.Aeson.

[aesonQQ|{
  experiment_ids: #{[experimentId]},
  filter: #{filterText},
  run_view_type: "ACTIVE_ONLY",
  max_results: 1,
  order_by: ["attributes.end_time DESC"]
}|])

Data.Aeson.Schema

If you love jq like I do, you going to like this one.

Technically, function is called get original aeson-schemas library, but I did seme renames for great good.

type FromSchema = Data.Aeson.Schema.Object
jq = Data.Aeson.Schema.get

It allows to define your types as a json:

type GitlabUserSchema = [schema|
  {
    id: Integer,
    username: Text,
    name: Text,
    web_url: Text
  }
|]

type GitlabUser = FromSchema GitlabUserSchema

type GitlabJobSchema = [schema|
  {
    id: Integer,
    status: GitlabStatus,
    name: Text,
    ref: Text,
    created_at: GitlabTime,
    started_at: Maybe GitlabTime,
    finished_at: Maybe GitlabTime,
    erased_at: Maybe GitlabTime,
    user: GitlabUser,
    commit: GitlabCommit,
    pipeline: Value,
    web_url: GitlabWebURL,
    project: Value
  }
|]

type GitlabJob = FromSchema GitlabJobSchema

And then extracts little bits and pieces out of it without lenses from Data.Aeson.Lens in a type-safe way. Isn’t using Data.Aeson.Lens also type-safe you ask? Yeah, but with Data.Aeson.Schema you have compile-type checks!

Here is a real world example, that demonstrates the use of different QuasiQuoters and how it allows too make code more condensed and easier to reason about:

monitorJob :: AppM m => GitlabProjectId -> GitlabStatus -> Integer -> m ()
monitorJob (GitlabProjectId projectId) targetStatus jobId = do
  GitlabAccessToken accessToken <- fetchAccessToken
  result <- timeout [µs|30min|] $ untilJust $ do
    result <- liftIO (request @GitlabJob $ getWith (defaults & auth ?~ oauth2Bearer (encodeUtf8 accessToken)) [i|#{render gitlabHost}/api/v4/projects/#{projectId}/jobs/#{jobId}|])
    view #runtime >>= liftIO . \case
      CI -> putStr "\n"
      Local -> clearLine >> setCursorColumn 0
    case [jq|result.status|] of
      "canceled" -> reportFailure result
      "failed" -> reportFailure result
      status | status == targetStatus -> pure $ Just result
      _ -> do
        log D $ "Job "+|[jq|result.id|]|+" status is still "+|[jq|result.status|]|+"."
        liftIO $ do
          putStr "Waiting"
          replicateM_ 10 $ putChar '.' >> threadDelay [µs|1s|]
          pure Nothing

search :: AppM m => ExperimentName -> Maybe (Either GitTagName GitCommit) -> m (Maybe MlflowRun)
search experimentName git = do
  experiment <- getExperiment experimentName
  let
    experimentId = [jq|experiment.experiment_id|]
    baseConditions = ["tags.`mlflow.model-version` LIKE '%run-%-sha-%'", "attributes.status = 'FINISHED'"]
    filterCondition = case git of
      Nothing -> mempty
      Just (Left (GitTagName gitTag)) -> [i|attributes.run_name = '#{gitTag}'|]
      Just (Right (GitCommit gitCommit)) -> [i|tags.`mlflow.source.git.commit` = '#{gitCommit}'|]
    filterText = intercalate " AND " $ baseConditions <> [filterCondition]
  results <- liftIO $ request @MlflowGetRuns (postWith defaults [i|#{render mlflowHost}/ajax-api/2.0/mlflow/runs/search|]
    [aesonQQ|{
      experiment_ids: #{[experimentId]},
      filter: #{filterText},
      run_view_type: "ACTIVE_ONLY",
      max_results: 1,
      order_by: ["attributes.end_time DESC"]
    }|])
  pure $ head <$> (nonEmpty =<< [jq|results.runs?[]|])