content: {-# LANGUAGE TypeFamilies, DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}
  module SyntaxDecl where
  import Controller
  import Miso.String as MS hiding (splitAt, length)
  import GHC.Generics(Generic)
  import Data.Aeson (ToJSON,FromJSON)
  import StringRep 
  import Data.Char
  
  data SyntaxDecl = SyntaxDecl [(Int, MisoString, Associativity)]
    deriving (Show, Eq, Generic, ToJSON, FromJSON)
  
  
  instance Control SyntaxDecl where
    data Focus SyntaxDecl = SelectName Int | SelectPrec Int
      deriving (Show, Eq)
    data Action SyntaxDecl = EditName Int | EditPrec Int | SetAssoc Associativity Int | RemoveDecl Int | AddDecl
      deriving (Show, Eq)
  
    editable _ (SelectName i) (SyntaxDecl ls) |  (_,s,_)   <- ls !! i = Just s
    editable _ (SelectPrec i) (SyntaxDecl ls) |  (p, _, _) <- ls !! i = Just (MS.pack $ show p)
    editable _ _ _ = Nothing
  
    leaveFocus _ = pure
  
    handle (SetAssoc a i) (SyntaxDecl ls) =  do
      let (lefts,(p,s,_):rights) = splitAt i ls
      pure (SyntaxDecl (lefts ++ (p, s, a):rights))
    handle (EditPrec i) (SyntaxDecl ls) = do
      let (lefts,(_,s,a):rights) = splitAt i ls
      new <- textInput
      let p = read $ MS.unpack new
      pure (SyntaxDecl (lefts ++ (p,s,a):rights))
    handle (EditName i) (SyntaxDecl ls) = do 
      let (lefts,(p,s,a):rights) = splitAt i ls
      new <- textInput
      case new of 
          "" -> errorMessage "Syntax cannot be empty"
          _ | MS.any Data.Char.isSpace new -> errorMessage "Syntax cannot contain spaces"
          _ | not (MS.any (=='_') new) -> errorMessage "Syntax must contain at least one underscore"
          _ -> pure ()
          --  Check for notation conflicts?
      pure (SyntaxDecl (lefts++ (p,new,a):rights))
    handle (RemoveDecl i) (SyntaxDecl ls) = do 
      let (lefts,_:rights) = splitAt i ls
      pure (SyntaxDecl (lefts++rights))
    handle (AddDecl) (SyntaxDecl ls) = do
      setFocus (SelectName (length ls)) 
      pure (SyntaxDecl (ls ++ [(0,"???",NonAssoc)]))
  
    inserted _ = SelectName 0
  
    definedSyntax (SyntaxDecl ls) = ls
  