Solonarv

{-# LANGUAGE TemplateHaskell #-}
import Control.Lens.TH
import Control.Lens.Prism

whenP :: Applicative m => APrism s t a b -> s -> (a -> m ()) -> m ()
whenP p s act = case matching p s of
  Left _ -> pure ()
  Right a -> act a

whenP' :: Applicative m => APrism s t a b -> a -> m () -> m ()

Solonarv

-- op :: a -> a -> a
-- `op` associative

-- We wish to prove that 'liftA2 op' is associative.

-- x, y, z :: a
-- f such that Applicative f
-- fx, fy, fz :: f a

(op x . op y) z

Solonarv

module DAlGa where

import Data.Foldable

import qualified Data.Set as S
import qualified Data.Map.Strict as M

-- Note: this is identical to algebraic-graphs' Graph type,
-- but has different semantics in that 'Connect' is not commutative.
data DAG v = Empty | Vertex v | Connect (DAG v) (DAG v) | Overlay (DAG v) (DAG v)

Solonarv

module DAG where

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

data DAG a = DAG { dagValues :: IntMap a, dagEdges :: IntMap IntSet }

type NodeIndex = Int

Solonarv

module Main where

import System.Environment (getArgs)
import Control.Applicative
import Data.Maybe
import Text.Read

main :: IO ()
main = do
    program <- parse . unwords <$> getArgs

Solonarv

-- | Run an action, discarding any changes it makes to the state
locally :: MonadState s m => m a -> m a
locally act = get >>= \old -> act >> put old

-- Example:
foo = do
  results <- locally $ do
    modify ([args] :)
    traverse statementBuilder exprs
  use results

Solonarv

{-# LANGUAGE DerivingStrategies #-}
import Data.HashMap.Strict -- package unordered-containers
import Data.Hashable -- package hashable

import Data.Int
import GHC.Generic

-- Attempting to model factorio's circuit system

data Channel = Wooden_Chest | Iron_Chest | Steel_Chest | Storage_Tank

Solonarv

module SKI where

data SKI = S | K | I | A SKI SKI
  deriving (Eq, Show)

reduce :: SKI -> SKI
reduce (A (A (A S x) y) z) = reduce (A (A x z) (A y z))
reduce (A (A K x) y) = reduce y
reduce (A I x) = reduce x
reduce a@(A f x) = let f' = reduce f in if f==f' then a else reduce (A f' x)

Solonarv

module Machine.Turing where

data Stream a = a :| Stream a

data Tape a = Tape (Stream a) a (Stream a)

data Move = GoLeft | Stay | GoRight

applyMove :: Move -> Tape a -> Tape a
applyMove GoLeft (Tape (l :| ls) x rs) = Tape ls l (x :| rs)

Solonarv

{-# LANGUAGE DerivingStrategies, LambdaCase #-}

module Bijection (type Bijection, swap) where

import Data.Semigroup
import Data.Monoid

newtype Bijection a = Bijection { appBijection :: a -> a }
  deriving (Semigroup, Monoid) via (Endo a)