{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
{- |
Module      :  $Header$
Description :  Instance of class Logic for the Haskell logic
Copyright   :  (c) Christian Maeder, Sonja Groening, Uni Bremen 2002-2004
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable(Logic)

Here is the place where the classes 'Category', 'Syntax',
   'StaticAnalysis', 'Sentences', and 'Logic' are instantiated for
   Haskell.

   Some method implementations for 'StaticAnalysis' and 'Sentences'
   are still missing.
-}

module Haskell.Logic_Haskell
    ( Haskell (..)
    , HaskellMorphism
    , SYMB_ITEMS
    , SYMB_MAP_ITEMS
    , Haskell_Sublogics
    , Symbol
    , RawSymbol
    ) where

import Common.AS_Annotation
import Common.DefaultMorphism
import Common.Doc as Doc
import Common.DocUtils
import Common.Id

import Data.Monoid

import Haskell.TiPropATC ()
import Haskell.HatParser
import Haskell.HatAna

import Logic.Logic

{- a dummy datatype for the LogicGraph and for identifying the right
instances -}

data Haskell = Haskell deriving Show

instance Language Haskell where
 description _ = unlines
  [ "Haskell - a purely functional programming language"
  , "featuring static typing, higher-order functions, polymorphism,"
  , "type classes and monadic effects."
  , "See http://www.haskell.org. This version is based on Programatica,"
  , "see http://www.cse.ogi.edu/PacSoft/projects/programatica/" ]

type HaskellMorphism = DefaultMorphism Sign

-- abstract syntax, parsing (and printing)

type SYMB_ITEMS = ()
type SYMB_MAP_ITEMS = ()

instance Monoid HsDecls where
    mempty = HsDecls []
    mappend (HsDecls l1) (HsDecls l2) = HsDecls $ l1 ++ l2

instance Syntax Haskell HsDecls Symbol
                SYMB_ITEMS SYMB_MAP_ITEMS
      where
         parse_basic_spec Haskell = Just $ const hatParser
         parse_symb_items Haskell = Nothing
         parse_symb_map_items Haskell = Nothing

type Haskell_Sublogics = ()

type Symbol = ()
type RawSymbol = ()

instance GetRange (TiDecl PNT)

instance Sentences Haskell (TiDecl PNT) Sign HaskellMorphism Symbol where
    map_sen Haskell _m = return
    print_named Haskell sen =
        pretty (sentence sen) Doc.<>
        case senAttr sen of
          [] -> empty
          lab -> space Doc.<> text "{-" <+> text lab <+> text "-}"

instance StaticAnalysis Haskell HsDecls
               (TiDecl PNT)
               SYMB_ITEMS SYMB_MAP_ITEMS
               Sign
               HaskellMorphism
               Symbol RawSymbol where
    basic_analysis Haskell = Just hatAna
    empty_signature Haskell = emptySign
    signature_union Haskell s = return . addSign s
    final_union Haskell = signature_union Haskell
    is_subsig Haskell = isSubSign
    subsig_inclusion Haskell = defaultInclusion

instance Logic Haskell Haskell_Sublogics
               HsDecls (TiDecl PNT) SYMB_ITEMS SYMB_MAP_ITEMS
               Sign
               HaskellMorphism
               Symbol RawSymbol ()
