{-# LANGUAGE DeriveDataTypeable #-}
module Data.Name (Name, toName, unName, nameMay) where

import Control.Applicative ((<$>), (<*>))
import Data.Char (isAscii, isAlpha, isAlphaNum)
import Data.Data (Data)
import Data.Maybe (fromMaybe, fromJust, isJust)
import Data.String (IsString (..))
import Data.Typeable (Typeable)
import Text.Read (lexP, readPrec_to_S, Lexeme(Ident), parens, pfail)
import Test.QuickCheck

-- $setup
-- >>> :set -XScopedTypeVariables

-- | prop> \ (x :: Name) -> (read . show) x == x
-- >>> read "foo" :: Name
-- foo
-- >>> read "(((bar)))" :: Name
-- bar
-- >>> read "Just baz" :: Maybe Name
-- Just baz
newtype Name = Name String deriving (Eq, Ord, Data, Typeable)

unName :: Name -> String
unName (Name a) = a

condHead, condTail :: Char -> Bool
condHead = (&&) <$> isAscii <*> isAlpha
condTail = (&&) <$> isAscii <*> ((||) <$> isAlphaNum <*> (`elem` "_\'"))

-- | >>> nameMay "foo"
-- Just foo
-- >>> nameMay "42"
-- Nothing
-- >>> nameMay ""
-- Nothing
nameMay :: String -> Maybe Name
nameMay [] = Nothing
nameMay s@(x:xs)
    | condHead x && all condTail xs = Just $ Name s
    | otherwise = Nothing

-- | unsafe
-- prop> \ name -> (toName . show) name == name
toName :: String -> Name
toName = fromMaybe (error "toName: wrong name") . nameMay

instance Show Name where show = unName

instance Read Name where
    readsPrec = readPrec_to_S (f =<< parens lexP) where
        f (Ident x) = return $ Name x
        f _ = pfail

instance   Arbitrary Name where   arbitrary = fromJust <$> ((nameMay <$> arbitrary) `suchThat` isJust)
instance CoArbitrary Name where coarbitrary (Name a) = coarbitrary a

instance IsString Name where fromString = toName
