module Import where
import Data.Char (toLower, isSpace)
import Data.List
import Data.List.Split
import qualified Data.List.NonEmpty as NE
import Types

data ImportType = Def | Open

instance Read ImportType where
  readsPrec :: Int -> ReadS ImportType
readsPrec Int
_ String
input =
    case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
input of
      String
xs | String
"open"       String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Open, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
xs)]
         | String
"def"        String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Def,  Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
xs)]
         | String
"definition" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Def, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
10 String
xs)]
         | Bool
otherwise -> []

parseImportInput :: ImportType -> Bool -> String -> Maybe [Card]
parseImportInput :: ImportType -> Bool -> String -> Maybe [Card]
parseImportInput ImportType
iType Bool
reverse String
input = 
  let listToTuple :: [b] -> Maybe (b, b)
listToTuple [b
q, b
a] = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just ((b, b) -> Maybe (b, b)) -> (b, b) -> Maybe (b, b)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
reverse then (b
q, b
a) else (b
a, b
q)
      listToTuple [b]
_ = Maybe (b, b)
forall a. Maybe a
Nothing
      xs :: Maybe [(String, String)]
xs = (String -> Maybe (String, String))
-> [String] -> Maybe [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([String] -> Maybe (String, String)
forall b. [b] -> Maybe (b, b)
listToTuple ([String] -> Maybe (String, String))
-> (String -> [String]) -> String -> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"\t") (String -> [String]
lines String
input)
      makeOpen :: (String, String) -> Card
makeOpen (String
header, String
body) = String -> Maybe External -> Perforated -> Card
OpenQuestion String
header Maybe External
forall a. Maybe a
Nothing
        (String -> NonEmpty String -> Sentence -> Perforated
P String
"" ([String] -> NonEmpty String
forall a. [a] -> NonEmpty a
NE.fromList ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOneOf String
",/;" String
body))) (String -> Sentence
Normal String
""))

  in case ImportType
iType of
    ImportType
Def  -> ((String, String) -> Card) -> [(String, String)] -> [Card]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
s1, String
s2) -> String -> Maybe External -> String -> Card
Definition String
s1 Maybe External
forall a. Maybe a
Nothing String
s2) ([(String, String)] -> [Card])
-> Maybe [(String, String)] -> Maybe [Card]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(String, String)]
xs
    ImportType
Open -> ((String, String) -> Card) -> [(String, String)] -> [Card]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Card
makeOpen ([(String, String)] -> [Card])
-> Maybe [(String, String)] -> Maybe [Card]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(String, String)]
xs