{-# LANGUAGE TemplateHaskell #-}
module Control.Isomorphism.Partial.Constructors
  ( nil
  , cons
  , listCases
  , left
  , right
  , nothing
  , just
  , readShowIso
  , textStringIso
  , lazyStrictTextIso
  , listMapIso
  ) where

import Prelude hiding ((.), id)
import Control.Category ((.), id)

import Data.Bool (Bool, otherwise)
import Data.Either (Either (Left, Right))
import Data.Eq (Eq ((==)))
import Data.Maybe (Maybe (Just, Nothing))

import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import Safe (readMay)

import Control.Isomorphism.Partial.Iso
import Control.Isomorphism.Partial.TH (defineIsomorphisms)

nil :: Iso () [alpha]
nil = unsafeMakeIso f g where
  f ()  =  Just []
  g []  =  Just ()
  g _   =  Nothing

cons :: Iso (alpha, [alpha]) [alpha]
cons = unsafeMakeIso f g where
  f (x, xs)   =  Just (x : xs)
  g (x : xs)  =  Just (x, xs)
  g _         =  Nothing

listCases :: Iso (Either () (alpha, [alpha])) [alpha]
listCases = unsafeMakeIso f g
  where
    f (Left ())        =  Just []
    f (Right (x, xs))  =  Just (x : xs)
    g []               =  Just (Left ())
    g (x:xs)           =  Just (Right (x, xs))

$(defineIsomorphisms ''Either)
$(defineIsomorphisms ''Maybe)

readShowIso :: (Read a, Show a) => Iso T.Text a
readShowIso = unsafeMakeNamedIsoLR "readShow" (readMay . T.unpack) (Just . T.pack . show)

textStringIso :: Iso T.Text String
textStringIso = unsafeMakeNamedIsoLR "textString" (Just . T.unpack) (Just . T.pack)

lazyStrictTextIso :: Iso TL.Text T.Text
lazyStrictTextIso = unsafeMakeNamedIsoLR "lazyStrictText" lazyToStrict strictToLazy
    where
      lazyToStrict = Just . T.concat . TL.toChunks
      strictToLazy = Just . TL.fromChunks . (:[])

listMapIso :: Ord a => Iso ([(a, b)]) (Map.Map a b)
listMapIso = unsafeMakeNamedIso "listMap" (Just . Map.fromList) (Just . Map.toList)