65 lines
1.7 KiB
Haskell
65 lines
1.7 KiB
Haskell
|
module Util where
|
||
|
|
||
|
import ParseLib ( (<$>), (<*>), (<*), (*>), (<$), Parser, parse )
|
||
|
import System.IO ( IOMode(ReadMode), openFile, hGetContents )
|
||
|
|
||
|
-- Functions on lists
|
||
|
|
||
|
count :: Eq a => [a] -> a -> Int
|
||
|
count xs find = length (filter (== find) xs)
|
||
|
|
||
|
-- Helper IO functions
|
||
|
|
||
|
getFileContents :: FilePath -> IO String
|
||
|
getFileContents filename = do
|
||
|
handle <- openFile filename ReadMode
|
||
|
hGetContents handle
|
||
|
|
||
|
-- Helper functions for the utrecht parser combinator lib
|
||
|
-- Rename operators
|
||
|
|
||
|
(<$$>) :: (a -> b) -> Parser s a -> Parser s b
|
||
|
(<$$>) = (ParseLib.<$>)
|
||
|
|
||
|
(<$$) :: b -> Parser s a -> Parser s b
|
||
|
(<$$) = (ParseLib.<$)
|
||
|
|
||
|
(<$*>) :: Parser s (b -> a) -> Parser s b -> Parser s a
|
||
|
(<$*>) = (ParseLib.<*>)
|
||
|
|
||
|
(<$*) :: Parser s a -> Parser s b -> Parser s a
|
||
|
(<$*) = (ParseLib.<*)
|
||
|
|
||
|
($*>) :: Parser s a -> Parser s b -> Parser s b
|
||
|
($*>) = (ParseLib.*>)
|
||
|
|
||
|
tryparse :: Parser s a -> [s] -> a
|
||
|
tryparse lexer input = case parse lexer input of
|
||
|
(ls : _) -> fst ls
|
||
|
_ -> error "Parsing failed"
|
||
|
|
||
|
|
||
|
-- A monoid that calculates the difference between two numbers
|
||
|
|
||
|
newtype Difference a = Difference {unwrap :: a} deriving (Show)
|
||
|
|
||
|
instance (Num a) => Semigroup (Difference a) where
|
||
|
(<>) (Difference a) (Difference b) = Difference (abs $ b - a)
|
||
|
|
||
|
instance (Num a) => Monoid (Difference a) where
|
||
|
mempty = Difference 0
|
||
|
|
||
|
|
||
|
-- List's applicative fmap creates a "cartesian" product.
|
||
|
-- This applies the functor pairwise (which is what you usually want?)
|
||
|
|
||
|
newtype Pairwise a = Pairwise {getPairwise :: [a]} deriving (Show)
|
||
|
|
||
|
instance Functor (Pairwise) where
|
||
|
fmap f (Pairwise as) = Pairwise $ fmap f as
|
||
|
|
||
|
instance Applicative (Pairwise) where
|
||
|
pure x = Pairwise (pure x)
|
||
|
|
||
|
(<*>) (Pairwise fs) (Pairwise xs) =
|
||
|
Pairwise (zipWith ($) fs xs)
|