{- Author: Markus Schnell, 2002 -}

-- This module may be used freely. Direct comments to haskell@markusschnell.com

module SaveFStruct	-- Feature Structure
  (FStruct
  ,Argument
  ,mkArg	-- :: String -> Argument
  ,VALUE	
  ,Value(Val)
  ,(=:)		-- :: (VALUE a) => Argument -> a -> Feature
  ,(!)		-- :: FStruct -> FStruct -> Maybe FStruct (unification)
  )
where

{-
    What should the interface of a feature structure look like?
    Has anybody comments?
    How can I avoid (3::Int) for Integers?
-}

{-
    A feature structure is a data type with a collection of attributes, which
    have values. These values can be atomic or can b e feature structures
    themselves.
    To have more control and safety one has to specify which values are possible
    for some feature. This can be done with a class system.
-}

import List
import Monad





{- ====== Values ====== -}

{- ZunŠchst muss ich das Problem lšsen, dass Int und String ohne explizite Angabe 
   in den Typ Value umgewandelt werden -}
   
newtype Value = Val String deriving Eq

class VALUE a where
  toValue         ::  a  -> Value
  toValueFromList :: [a] -> Value
  toValueFromList xs = Val ("[" ++ (concat . intersperse ", ") [x | (Val x) <- map toValue xs] ++ "]")
  
instance (VALUE a) => VALUE [a] where
  toValue xs = toValueFromList xs
  
instance VALUE Value where
  toValue a = a
  
instance VALUE Int where
  toValue a = Val (showint a)
    where showint :: Int -> String
          showint = show

instance VALUE Char where
  toValue a = Val (show a)
  toValueFromList str = Val (show str)
  

instance Show Value where
  showsPrec _ (Val s) = showString s






{- ====== Feature Structures ====== -}

type FStruct    = [Feature]
data Feature    = (:=) { arg :: Argument, val :: Value }
newtype Argument = Arg String deriving Eq

(=:) :: (VALUE a) => Argument -> a -> Feature
arg =: val = arg := (toValue val)

instance VALUE Feature where
  toValue f = Val (show f)
  
mkArg :: String -> Argument
mkArg = Arg . id
 
instance Show Feature where
  showsPrec _ (Arg arg := Val s) = showString (arg ++ " =: " ++ s)
  
  




{- ====== Unification ====== -}

{- Unification can fail -> Maybe -}

(!) :: FStruct -> FStruct -> Maybe FStruct
(!)  = foldM (flip merge)

-- put feature into structure
merge :: Feature -> FStruct -> Maybe FStruct
merge feat fs =
  if null sameArg
    then Just (feat:fs)
    else if val feat == val (head sameArg)
           then Just fs
           else Nothing		-- unification failed
  where
    sameArg = filter (\x -> arg x == arg feat) fs