{-
    BNF Converter: Abstract syntax Generator
    Copyright (C) 2004  Author:  Markus Forberg

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module BNFC.Backend.Haskell.CFtoAbstract (cf2Abstract) where

import BNFC.CF
import BNFC.Utils((+++),(++++),prParenth)
import Data.List(intersperse,intercalate)

-- to produce a Haskell module
cf2Abstract :: Bool -> Bool -> String -> CF -> String
cf2Abstract byteStrings ghcExtensions name cf = unlines $
  (if ghcExtensions then "{-# LANGUAGE DeriveDataTypeable #-}" else "") :
  (if ghcExtensions then "{-# LANGUAGE DeriveGeneric #-}" else "") :
  ("module "++name +++ "where\n") :
  "-- Haskell module generated by the BNF converter\n" :
  (if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "") :
  (if ghcExtensions then "import Data.Data (Data,Typeable)" else "") :
  (if ghcExtensions then "import GHC.Generics (Generic)" else "") :
  (map (prSpecialData byteStrings cf derivingClasses) (specialCats cf) ++ map (prData derivingClasses) (cf2data cf))
  where
    derivingClasses = prParenth . intercalate "," $ concat
        [ ["Eq","Ord","Show","Read"]
        , (if ghcExtensions then ["Data","Typeable","Generic"] else [])
        ]

prData :: String -> Data -> String
prData derivingClasses (cat,rules) =
  "data" +++ show cat +++ "=\n   " ++
  concat (intersperse "\n | " (map prRule rules)) ++++
  "  deriving" +++ derivingClasses ++ "\n"
 where
   prRule (fun,cats) = unwords (fun:map show cats)

prSpecialData :: Bool -> CF -> String -> Cat -> String
prSpecialData byteStrings cf derivingClasses cat =
  unwords [ "newtype", show cat, "=", show cat, contentSpec byteStrings cf cat
          , "deriving", derivingClasses ]

contentSpec :: Bool -> CF -> Cat -> String
contentSpec byteStrings cf cat = if isPositionCat cf cat then "((Int,Int),"++stringType++")" else stringType
  where
    stringType
      | byteStrings = "BS.ByteString"
      | otherwise   = "String"