module Main where

-- import Documentation.Haddock

import Types

sample :: [Decl]
sample =
  [ Decl "Sample" "S" (TypeDecl KStar [ Constructor "S" [TNamed "Int"] ])
  , Decl "Sample" "T" (TypeDecl KStar [ Constructor "Leaf" [TNamed "S"]
                                      , Constructor "Node" [TNamed "T", TNamed "T"]
                                      , Constructor "Nil" []
                                      ])
  , Decl "Sample" "flip"
      (ValDecl (TNamed "T" `TArr` TNamed "T"))
  , Decl "Sample" "mkT"
      (ValDecl (TListOf (TNamed "Int") `TArr` TNamed "T"))
  , Decl "Sample" "sumT"
      (ValDecl (TNamed "T" `TArr` TNamed "Int"))
  , Decl "Sample" "zero" (ValDecl (TNamed "S"))
  ]

data Creator
  = CreatorVal Decl
  | CreatorConstr Constructor
    deriving (Eq, Show)

findCreators :: Identifier -> [Decl] -> [Creator]
findCreators name decls =
  [ CreatorVal decl
  | decl@Decl { dKind = ValDecl t } <- decls
  , produces name t
  ] ++
  [ CreatorConstr c
  | Decl { dName = n
         , dKind = TypeDecl _ cs
         } <- decls
  , n == name
  , c <- cs
  ]

produces :: Identifier -> Type -> Bool
produces n' (TNamed n) = n == n'
produces n' (TArr _ r) = produces n' r
produces n' (TApp t xs) =
  produces n' t || any (produces n') xs
produces n' (TPair xs) = any (produces n') xs
produces _ _ = False

main :: IO ()
main = do
  print (findCreators "S" sample)
  putStrLn ""
  print (findCreators "T" sample)