This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env python3 | |
"""Image analysis and caption generation using MLX Vision Language Models.""" | |
# Standard library imports | |
import argparse | |
import contextlib | |
import html | |
import logging | |
import platform | |
import re # For ANSI code stripping |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE UnicodeSyntax #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE QuantifiedConstraints #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
module WC where | |
import Control.Applicative -- WrappedMonad |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE TupleSections #-} | |
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} | |
module TNumber where | |
import Text.Pretty.Simple | |
import Control.Monad.State | |
-- https://stackoverflow.com/questions/44784899/how-to-write-function-for-n-ary-tree-traversal-in-haskell?rq=1 | |
data NT a = N a [NT a] deriving (Show, Functor, Foldable, Traversable) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Fox where | |
-- http://blog.sigfpe.com/2007/01/foxs-ubiquitous-free-derivative-pt-2.html | |
-- | |
import Prelude hiding ( (<*>) ) | |
import Data.List | |
data RE a | |
= Symbol a | |
| Star (RE a) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE PatternSynonyms #-} | |
module Alopegmorphism where | |
import Data.Void | |
type Triple = I :*: I :*: I |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE UnicodeSyntax #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE TupleSections #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE DeriveFunctor #-} | |
{-# LANGUAGE DeriveFoldable #-} | |
{-# LANGUAGE DeriveTraversable #-} | |
{-# LANGUAGE PatternSynonyms #-} | |
module Cojoingrids where |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module ListZipper where | |
-- http://blog.emillon.org/posts/2012-10-18-comonadic-life.html | |
import Control.Comonad | |
import GHC.Base | |
data ListZipper a = | |
LZ [a] | |
a | |
[a] |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE LambdaCase #-} | |
-- https://stackoverflow.com/questions/10239630/where-to-find-programming-exercises-for-applicative-functors/10242673 | |
-- https://github.com/pigworker/WhatRTypes4/blob/master/Types4.hs | |
-- | |
module Triple where | |
import Control.Applicative | |
import Data.Char |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Homebrew build logs for macvim on macOS 10.13.4 | |
Build date: 2018-04-21 11:29:56 |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Homebrew build logs for macvim on macOS 10.13.4 | |
Build date: 2018-04-21 11:10:25 |