-- |
-- Module      :  DobutokO.Sound.ParseList
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A program and a library to create experimental music
-- from a mono audio and a Ukrainian text.

{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.ParseList where

import Data.Char (isSpace)
import qualified Data.Vector as V
import Text.Read (lex,readMaybe)
import Data.Maybe (isNothing,fromJust)

parseTup :: String -> [String]
parseTup xs = map (dropWhile isSpace . fst) (takeWhile (/= ("","")) . iterate (head . lex . snd) $ head (lex xs))

parseTupV :: String -> V.Vector String
parseTupV = V.fromList . parseTup

containsExt :: [String] -> Bool
containsExt = elem ".."

containsExtV :: V.Vector String -> Bool
containsExtV = V.elem ".."

canBePreParseV :: V.Vector String -> Bool
canBePreParseV v = not (V.elem "(" v || V.elem "-" v || V.elem ")" v)

parseV :: V.Vector String -> Maybe [Int]
parseV v
 | V.findIndices (== "..") v == V.singleton 2 && V.length v == 4 =
    if V.unsafeIndex v 0 == "[" && V.unsafeIndex v 3 == "]"
      then let ins1 = readMaybe (V.unsafeIndex v 1)::Maybe Int in
        case ins1 of
          Just ins -> Just [ins..]
          Nothing  -> Nothing
      else Nothing
 | V.findIndices (== "..") v == V.singleton 2 && V.length v == 5 =
    if V.unsafeIndex v 0 == "[" && V.unsafeIndex v 4 == "]"
      then let ins1 = readMaybe (V.unsafeIndex v 1)::Maybe Int
               ins2 = readMaybe (V.unsafeIndex v 3)::Maybe Int in
        case (ins1,ins2) of
          (Just ins01,Just ins02) -> if ins02 >= ins01 then Just [ins01..ins02] else Nothing
          _                       -> Nothing
      else Nothing
 | V.findIndices (== "..") v == V.singleton 4 && V.length v == 6 =
    if V.unsafeIndex v 0 == "[" && V.unsafeIndex v 2 == "," && V.unsafeIndex v 5 == "]"
      then let ins1 = readMaybe (V.unsafeIndex v 1)::Maybe Int
               ins2 = readMaybe (V.unsafeIndex v 3)::Maybe Int in
        case (ins1,ins2) of
          (Just ins01,Just ins02) -> Just [ins01,ins02..]
          _                       -> Nothing
      else Nothing
 | V.findIndices (== "..") v == V.singleton 4 && V.length v == 7 =
    if V.unsafeIndex v 0 == "[" && V.unsafeIndex v 2 == "," && V.unsafeIndex v 6 == "]"
      then let ins1 = readMaybe (V.unsafeIndex v 1)::Maybe Int
               ins2 = readMaybe (V.unsafeIndex v 3)::Maybe Int
               ins3 = readMaybe (V.unsafeIndex v 5)::Maybe Int in
        case (ins1,ins2,ins3) of
          (Just ins01,Just ins02,Just ins03) -> if null [ins01,ins02..ins03] then Nothing else Just [ins01,ins02..ins03]
          _                       -> Nothing
      else Nothing
 | V.unsafeIndex v 0 == "[" && V.unsafeIndex v (V.length v - 1) == "]" && V.length v `rem` 2 == 1 &&
    (V.toList . V.findIndices (== ",") $ v) == [2,4..(V.length v - 2)] =
      let insV1 = V.imap (\i _ -> readMaybe (V.unsafeIndex v (2 * i + 1))::Maybe Int) (V.unsafeSlice 0 (V.length v `quot` 2) v) in
       if V.any isNothing insV1
         then Nothing
         else Just (V.toList . V.mapMaybe id $ insV1)
 | otherwise = Nothing

-- | Parses a 'Strting' being a list of Ints written with Haskell rules, e. g. \"[1..]\", \"[2,4..45]\", \"[3,5,6,7,8,3]\" etc. into a list of 'Int'.
-- If it is not possible or list is empty, returns []. Preceding whitespaces are ignored.
parseStoLInts :: String -> [Int]
parseStoLInts xs
  | canBePreParseV . parseTupV . dropWhile isSpace $ xs =
     if isNothing . parseV $ (parseTupV . dropWhile isSpace $ xs) then [] else fromJust . parseV $ (parseTupV . dropWhile isSpace $ xs)
  | otherwise = []