Main.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes       #-}
module Main (main) where

import           Control.Monad
import           Control.Monad.Except
import           Data.Bifunctor
import           Data.Constraint
import           Data.List
import           GHC.Generics
import           Text.Printf

class MyShow a where myShow :: a -> String
instance MyShow Int where myShow = (++ " :: Int") . show
instance MyShow Char where myShow = (++ " :: Char") . show
instance (MyShow a, MyShow b) => MyShow (a,b) where
  myShow (a,b) = printf "(%s,%s) :: Tuple" (myShow a) (myShow b)
instance MyShow a => MyShow [a] where
  myShow xs = join (intersperse ", " $ myShow <$> xs) ++ " :: List"


-- | The computations that use Err to throw do not need MyShow for the
-- actual computation but they do for error reporting. With this
-- technique we are able to run the computation for `e` that do not
-- support MyShow as long as we don't try to use the error.
data Err e = Err (MyShow e => String)
instance MyShow e => Show (Err e) where
  show (Err msg) = "Err " ++ msg

myShow' :: Dict (MyShow a) -> a -> String
myShow' d = withDict d myShow
throwErr :: MonadError (Err e) m => (MyShow e => String) -> m a
throwErr err = throwError $ Err err
runErrS :: MyShow e => Either (Err e) a -> Either String a
runErrS = first $ \(Err e) -> e
runErrM :: Either (Err e) a -> Maybe a
runErrM = either (const Nothing) Just

clamp :: Int -> [a] -> Either (Err a) [a]
clamp i x = case span ((< i) . fst) $ zip [0..] x of
  (_,[])   -> return x
  (_,rest) -> throwErr $ myShow rest


-- What about generics?
data ErrG msg = Err msg | UnknownError deriving Generic


main :: IO ()
main = putStrLn "not to be run"