casui-0.3: Casui/Utils.hs

{-# LANGUAGE EmptyDataDecls, PatternGuards #-}

module Casui.Utils
    ( unreachable
    , justRight
    , ifJust
    , insertAt
    , divPoint
    , maxSize
    , convertInt
    , fst3
    , snd3
    , first3
    , second3
    , maybeNth
    , third3
    , thrd
    , maybeHead
    , dropSame
    , splitChar
    , TagError
    , errorData
    , errorMessage
    , err
    ) where

import Control.Monad.Error

unreachable :: a
unreachable = error "unreachable"

justRight :: Either a b -> Maybe b
justRight (Left _) = Nothing
justRight (Right a) = Just a

ifJust :: (Monad m) => Maybe a -> (a -> m ()) -> m ()
ifJust a f = maybe (return ()) f a

insertAt :: a -> Int -> [a] -> [a]
insertAt a _ [] = [a]
insertAt a 0 l = a:l
insertAt a n (x:l) = x : insertAt a (n-1) l

type Point = (Int, Int)

divPoint :: Point -> Int -> Point
divPoint (a,b) x = (div a x, div b x)

maxSize :: Point -> Point -> Point
maxSize (a,b) (c,d) = (max a c, max b d)

instance (Num a, Num b) => Num (a, b) where
    (a,b) + (c,d) = (a+c, b+d)
    (a,b) - (c,d) = (a-c, b-d)
    (a,b) * (c,d) = (a*c, b*d)
    abs (a,b) = (abs a, abs b)
    signum (a,b) = (signum a, signum b)
    fromInteger a = (fromInteger a,0)

convertInt :: (Integral a, Integral b) => a -> b
convertInt = fromInteger . toInteger

fst3 (a,_,_) = a

first3 f (a,b,c) = (f a,b,c)

second3 f (a,b,c) = (a,f b,c)

third3 f (a,b,c) = (a,b,f c)

maybeNth [] _ = Nothing
maybeNth (x:_) 0 = Just x
maybeNth (_:xs) n = maybeNth xs (n-1)

snd3 (_,a,_) = a

thrd (_, _, a) = a
maybeHead :: [a] -> Maybe a
maybeHead (x:_) = Just x
maybeHead _ = Nothing

dropSame :: Eq a => [a] -> [a] -> ([a], [a])
dropSame (a:as) (b:bs) | a == b = dropSame as bs
dropSame as bs = (,) as bs

splitChar :: Char -> String -> [String]
splitChar c l | (a,(_:b)) <- break (==c) l = a : splitChar c b
              | otherwise                  = [l]


data TagError a = TagError {
  errorMessage :: String, 
  errorData :: Maybe a
  }

instance Error (TagError a) where
  noMsg = TagError "" Nothing
  strMsg e = TagError e Nothing

err :: String -> a -> TagError a
err e d = TagError e $ Just d