content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  module Text.Greek.NewTestament.SBL where
  
  import Prelude (($), (.), Eq((==)), Show, otherwise, (||), Bool(..))
  import Control.Applicative ((<$>), (<*>))
  import Control.Lens ((&), (^?), (^..), (^.), (%~), (.~), Traversal', makeLenses)
  import Control.Lens.Tuple (_1)
  import Control.Monad (return)
  import Control.Monad.State.Lazy (State, evalState, state, runState)
  import Data.Char (isPunctuation, isSpace)
  import Data.Either (Either(Left, Right))
  import Data.Foldable (all, concat)
  import Data.Functor (fmap)
  import Data.Maybe (Maybe(Just, Nothing))
  import Data.Text (Text, unpack)
  import Data.Traversable (sequence)
  import Text.Greek.Corpus.Bible (Bible(Bible), Book(Book), Segment(..), Milestone(Start,End), Paragraph(..), Chapter(..), Verse(..))
  import Text.XML (elementName, Node (NodeElement, NodeContent), Name (Name), Document, Element)
  import Text.XML.Lens ((./), attr, el, root, text, attributeIs, nodes)
  
  data SBLError =
      ChapterWithinVerse MilestoneState Element
    | ContentOutsideOfMilestone MilestoneState Node
    | MismatchedEndChapter MilestoneState Element
    | MismatchedEndVerse MilestoneState Element
    | MissingBookOsisID
    | MissingBookTitle
    | MissingOsisIDWork
    | MissingOsisTitle
    | NestedChapter MilestoneState Element
    | NestedParagraph MilestoneState Element
    | NestedVerse MilestoneState Element
    | UnexpectedContentInVerse MilestoneState Node
    | UnexpectedElement MilestoneState Element
    | UnexpectedNode MilestoneState Node
    | UnmatchedEndChapter MilestoneState Element
    | UnmatchedEndVerse MilestoneState Element
    | VerseOutsideChapter MilestoneState Element
    | WordOutsideMilestone MilestoneState Element
    deriving (Eq, Show)
  
  osisNamespace :: Text
  osisNamespace = "http://www.bibletechnologies.net/2003/OSIS/namespace"
  
  osisName :: Text -> Name
  osisName n = Name n (Just osisNamespace) Nothing
  
  elo :: Text -> Traversal' Element Element
  elo n = el (osisName n)
  
  osisText :: Traversal' Document Element
  osisText = root . elo "osis" ./ elo "osisText"
  
  whenNothing :: a -> Maybe b -> Either a b
  whenNothing _ (Just b) = Right b
  whenNothing a Nothing = Left a
  
  data MilestoneState = MilestoneState
    { _paragraphState :: Maybe Paragraph
    , _chapterState :: Maybe Chapter
    , _verseState :: Maybe Verse
    }
    deriving (Eq, Show)
  makeLenses ''MilestoneState
  
  emptyMilestoneState :: MilestoneState
  emptyMilestoneState = MilestoneState Nothing Nothing Nothing
  
  makeSegment :: Node -> State MilestoneState (Either SBLError [Segment])
  makeSegment (NodeElement e)
    | eName "p" = state $ \s ->
      case s ^. paragraphState of
        Nothing ->
          ( concat <$> sequence
            [ Right [SegmentParagraph $ Start Paragraph]
            , es
            , Right [SegmentParagraph $ End Paragraph]
            ]
          , s' & paragraphState .~ Nothing
          )
          where (es, s') = runMakeSegments e (s & paragraphState .~ Just Paragraph)
        Just _ -> (Left $ NestedParagraph s e, s)
  
    | eName "title" = return $ Right [SectionTitle $ e ^. text]
  
    | eName "chapter"
    , Just sid <- e ^? attr "sID"
    = state $ \s ->
      case (s ^. chapterState, s ^. verseState) of
        (Nothing, Nothing) -> (Right [SegmentChapter $ Start $ Chapter sid], s & chapterState .~ (Just $ Chapter sid))
        (Nothing, Just _) -> (Left $ ChapterWithinVerse s e, s)
        (Just _, _) -> (Left $ NestedChapter s e, s)
    | eName "chapter"
    , Just eid <- e ^? attr "eID"
    = state $ \s ->
      case s ^. chapterState of
        Nothing -> (Left $ UnmatchedEndChapter s e, s)
        Just (Chapter c) -> case c == eid of
          True -> (Right [SegmentChapter $ End $ Chapter eid], s & chapterState .~ Nothing)
          False -> (Left $ MismatchedEndChapter s e, s)
  
    | eName "verse"
    , Just sid <- e ^? attr "sID"
    = state $ \s ->
      case (s ^. chapterState, s ^. verseState) of
        (Nothing, _) -> (Left $ VerseOutsideChapter s e, s)
        (Just _, Nothing) -> (Right [SegmentVerse $ Start $ Verse sid], s & verseState .~ (Just $ Verse sid))
        (Just _, Just _) -> (Left $ NestedVerse s e, s)
    | eName "verse"
    , Just eid <- e ^? attr "eID"
    = state $ \s ->
      case (s ^. chapterState, s ^. verseState) of
        (Nothing, _) -> (Left $ VerseOutsideChapter s e, s)
        (Just _, Nothing) -> (Left $ UnmatchedEndVerse s e, s)
        (Just _, Just (Verse v)) -> case v == eid of
          True -> (Right [SegmentVerse $ End $ Verse eid], s & verseState .~ Nothing)
          False -> (Left $ MismatchedEndVerse s e, s)
  
    | eName "w" = state $ \s ->
      case s of
        MilestoneState (Just _) (Just _) (Just _) -> (Right [SegmentWord $ e ^. text], s)
        MilestoneState _ _ _ -> (Left $ WordOutsideMilestone s e, s)
  
    | otherwise = state $ \s -> (Left $ UnexpectedElement s e, s)
    where
      eName t = elementName e == osisName t
  makeSegment n@(NodeContent c) = state $ \s ->
    case s of
      MilestoneState (Just _) (Just _) (Just _) ->
        case all (\x -> isSpace x || isPunctuation x || x == '1' || x == '2') $ unpack c of
          True -> (Right [Separator c], s)
          False -> (Left $ UnexpectedContentInVerse s n, s)
      MilestoneState _ _ _ ->
        case all isSpace $ unpack c of
          True -> (Right [], s)
          False -> (Left $ ContentOutsideOfMilestone s n, s)
  makeSegment n = state $ \s -> (Left $ UnexpectedNode s n, s)
  
  runMakeSegments :: Element -> MilestoneState -> (Either SBLError [Segment], MilestoneState)
  runMakeSegments e s = result & _1 %~ (fmap concat . sequence)
    where
      result = runState (sequence $ makeSegment <$> e ^. nodes) s
  
  evalMakeSegments :: Element -> MilestoneState -> Either SBLError [Segment]
  evalMakeSegments e s = fmap concat $ sequence $ evalState (sequence $ makeSegment <$> e ^. nodes) s
  
  makeBook :: Element -> Either SBLError Book
  makeBook e = Book <$> id <*> title <*> segments
    where
      id = whenNothing MissingBookOsisID $ e ^? attr "osisID"
      title = whenNothing MissingBookTitle $ e ^? ($) ./ elo "title" . text
      segments = evalMakeSegments e emptyMilestoneState
  
  loadOsis :: Document -> Either SBLError Bible
  loadOsis doc = Bible <$> id <*> title <*> books
    where
      id = whenNothing MissingOsisIDWork $ doc ^? osisText . attr "osisIDWork"
      title = whenNothing MissingOsisTitle $ doc ^? osisText ./ elo "header" ./ elo "work" ./ elo "title" . text
      books = sequence $ makeBook <$> doc ^.. osisText ./ elo "div" . attributeIs "type" "book"
  