{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- | Handy data types for strict and lazy texts, with conversion
-- functions to/from each.

module Texts.Types where

import qualified Data.Text as T
import qualified Data.Text.Lazy as L

-- | Lazy text.
type LText = L.Text

-- | Strict text.
type SText = T.Text

-- | A class for converting to Text.
class ToText a where
  toText :: a -> SText
  toLazyText :: a -> LText

instance ToText SText where
  toText = id
  toLazyText = L.fromStrict

instance ToText String where
  toText = T.pack
  toLazyText = L.pack

-- | A class for converting from Text.
class FromText a where
  fromText :: SText -> Maybe a
  fromLazyText :: LText -> Maybe a

instance FromText String where
  fromText = Just . T.unpack
  fromLazyText = Just . L.unpack