Util.hs

-----------------------------------------------------------------------------
--
-- Module      :  Data.String.Util
-- Copyright   :  (c) 2012-16 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Unstable
-- Portability :  Portable
--
-- | Utilities related to 'Data.String.String'.
--
-----------------------------------------------------------------------------


{-# LANGUAGE EmptyDataDecls         #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE UndecidableInstances   #-}


module Data.String.Util (
-- * Classes
  Stringy(..)
-- * Functions
, readExcept
, maybeString
) where


import Control.Monad.Except (MonadError, throwError)
import Data.String (IsString)
import Data.String.ToString (ToString)

import qualified Data.String as S (IsString(..))
import qualified Data.String.ToString as S (ToString(..))


-- | Read a string or return a message that it cannot be parsed.
readExcept :: (ToString s, IsString e, MonadError e m, Read a) => s -> m a
readExcept x =
  let
    x' = S.toString x
  in
    case reads x' of
      [(result, [])] -> return result
      _              -> throwError . S.fromString $ "failed to parse \"" ++ x' ++ "\""


-- | Lift a non-empty string.
maybeString :: (Eq a, IsString a) => a -> Maybe a
maybeString s
  | s == ""   = Nothing
  | otherwise = Just s


-- | Class for stringlike values that can be read and shown.
class (Read a, Show a) => Stringy a where
  -- | Convert to a string.
  toString   :: a      -- ^ The value.
             -> String -- ^ The string.
  -- | Convert from a string.
  fromString :: String -- ^ The string.
             -> a      -- ^ The value.

instance (Predicate a ~ flag, Printable flag a, Read a, Show a) => Stringy a where
  toString   = toString'   (undefined :: flag)
  fromString = fromString' (undefined :: flag)


class Printable flag a where
  toString'   :: Show a => flag -> a -> String
  fromString' :: Read a => flag -> String -> a

instance Printable IsStringy String where
  toString'   _ = id
  fromString' _ = id
  
instance Printable NotStringy a where
  toString'   _ = show
  fromString' _ = read


data IsStringy
data NotStringy


type family Predicate a where
  Predicate String = IsStringy
  Predicate a      = NotStringy