module Practicum2 where
import ParseLib
import Data.Char

--------------------------------------------------
-- Naam: 
-- Studentnummer:
-- Versie van de opdracht: 
-- Datum:
--------------------------------------------------


data Token = LParen
           | RParen
	   | LBrack
	   | RBrack
	   | Arrow
	   | Comma
	   | Equals
	   | Bar
	   | Data
	   | Const String
	   | Varia String
           | Error
	   deriving (Show, Eq)

terminals :: [(Token, String)]
terminals = 
    [ (LParen, "("   )
    , (RParen, ")"   )
    , (LBrack, "["   )
    , (RBrack, "]"   )
    , (Arrow,  "->"  )
    , (Comma,  ","   )
    , (Equals, "="   )
    , (Bar,    "|"   )
    , (Data,   "data")
    ]

-- test hoofdletter
capital :: Parser Char Char
capital = satisfy isUpper
-- test kleine letter
lower :: Parser Char Char
lower = satisfy isLower
-- test cijfer (in ParseLib gedefinieerd)
--digit  :: Parser Char Char
--digit  =  satisfy isDigit

--------------------------------------------------
------------------ opdracht 1 --------------------
--------------------------------------------------
input                         :: Parser Char Char
input                         =  satisfy isUpper <|> satisfy isLower
lowerIdent, upperIdent        :: Parser Char String
lowerIdent                    =  (:) <$> lower <*> greedy input
upperIdent                    =  (:) <$> capital <*> greedy input


--------------------------------------------------
------------------ opdracht 2 --------------------
--------------------------------------------------
parserToken                   :: Parser Char Token

token1 k xs                     |  k == take n xs = k
                                |  otherwise      = []
  where n = length k


parserToken xs                  |  foldl1 (||) (map (== (token1 n xs)) (map snd terminals)) = [(head [a | (a,b) <- terminals, b == (token1 n xs)], drop 2 xs)]
                                |  foldl1 (||) (map (== (token1 m xs)) (map snd terminals)) = [(head [a | (a,b) <- terminals, b == (token1 m xs)], drop 4 xs)]
                                |  foldl1 (||) ((map (== head xs)) (map head (map snd terminals))) = [(head [a | (a,b) <- terminals, b == [head xs]], tail xs)]
                                |  isUpper (head xs) = let [(a,b)] = upperIdent xs in [(Const a, b)]
                                |  isLower (head xs) = let [(a,b)] = lowerIdent xs in [(Varia a, b)]
  where n = "->" 
        m = "data"

---------------------------------------------
------------------ opdracht 3 --------------------
--------------------------------------------------
--separatorParser              :: Parser Char Token
separatorParser xs           |  let (f == "\n") in token1 f xs = [(Error, drop (length f) xs)]



-- functie solution levert de eerste complete oplossing op van de parser
solution :: Parser a b -> [a] -> b
solution parser xs = fst (head (parser xs))

-- Functie main voor het testen van de lexical scanner
-- Voeg indien nodig een padaanduiding toe aan de naam van het testbestand 
--main :: IO () 
--main = do { xs <- readFile "test.hs"
--          ; putStr (show (solution lexicalScanner xs))
--	  } 

--------------------------------------------------

------------------ opdracht 4 --------------------
--------------------------------------------------

data HaskellType = HT TypeName [TypeVar] Type
  deriving Show

type TypeName  =  String 
type TypeVar   =  String

data Type = Choice [Type]       -- lijst van verschillende typen
          | Constructor String  -- constructornaam (begint met hoofdletter)
	  | App Type Type       -- compositie van twee typen (binaire applicatie)
          | Var String          -- typevariabele (begint met een kleine letter)
          | ConstType String    -- typenaam zoals Int (begint met hoofdletter)
	  | List Type           -- lijsttype
	  | Arr Type Type       -- functietype
	  | Tuple [Type]        -- tupletype
  deriving Show

--------------- hulpfuncties ------------------

isConst :: Token -> Bool
isConst (Const _) = True
isConst _ = False

isVaria :: Token -> Bool
isVaria (Varia _) = True
isVaria _ = False

unConst :: Token -> String
unConst (Const x) = x

unVaria :: Token -> String
unVaria (Varia x) = x

-- maakt van een lijst elementen een type App (binaire applicatie)
makeApp :: [Type] -> Type 
makeApp = \x -> if null x 
                then error "makeApp: type expected" 
                else foldl App (head x) (tail x)

-- maakt van een lijst elementen en een los element een type App (binaire applicatie)
makeAppAlt :: Type -> [Type] -> Type 
makeAppAlt x y = makeApp (x:y)

-- maakt van een lijst elementen een type Arr (arrow, functie)

makeArr :: Type -> [Type] -> Type 
makeArr = \x y -> if null y then x 
                  else foldl Arr x y 

--------------------------------------------------
------------ opdracht 5, 6, 7 --------------------
--------------------------------------------------