{-# LANGUAGE TemplateHaskell, CPP #-}
module Data.Express.Name.Derive
( deriveName
, deriveNameCascading
, deriveNameIfNeeded
)
where
import qualified Data.Express.Name as N
import Control.Monad
import Data.Char
import Data.List
import Data.Express.Utils.TH
deriveName :: Name -> DecsQ
deriveName = deriveWhenNeededOrWarn ''N.Name reallyDeriveName
deriveNameIfNeeded :: Name -> DecsQ
deriveNameIfNeeded = deriveWhenNeeded ''N.Name reallyDeriveName
deriveNameCascading :: Name -> DecsQ
deriveNameCascading = deriveWhenNeeded ''N.Name reallyDeriveNameCascading
reallyDeriveName :: Name -> DecsQ
reallyDeriveName t = do
(nt,vs) <- normalizeType t
[d| instance N.Name $(return nt) where
name _ = $(stringE vname) |]
where
showJustName = reverse . takeWhile (/= '.') . reverse . show
vname = map toLower . take 1 $ showJustName t
reallyDeriveNameCascading :: Name -> DecsQ
reallyDeriveNameCascading = reallyDeriveCascading ''N.Name reallyDeriveName